Title: Win 2000/NT Net Send Class (Win 95/98 friendly)
Question: The article "Sending Messages as the Microsoft NT command, net send" by Chris Viklund prompted me to look at the Net functions a little more closely. The first problem being that trying to run on a 95/98 machine will fail at program startup complaining about the DLL which it cannot link to. My solution was to create a TNetSend class which will attempt to load the DLL at creation time, if it fails (Win 95/98) then any calls to SendMessage will simply return false and no application crash occurs.
I have played around with the other functions declared by Chris, but cannot actually get them to do anything useful. ie.
TFGetNameEnum = function(ServerName : PWideChar;Level : integer;
var Buffer : Pointer; PrefMaxLen : integer;
var EntriesRead,TotalEntries,ResumeHandle : integer) : integer;
stdcall;
TFNameAdd = function(ServerName,MsgName : PWideChar) : integer;
stdcall;
TFNameDel = function(ServerName,MsgName : PWideChar) : integer;
stdcall;
The class currently has 1 method
function SendMessage(ToName,NetMessage : string;
ServerName : string = '') : boolean;
ServerName is NullStr by default (LOCAL SERVER), I have not managed to use it with any servername except '' as ADMIN privileges are required for remote servers.
Example
var NS : TNetSend;
procedure ?????
begin
NS := TNetSend.Create;
...
end;
procedure ?????
begin
NS.SendMessage('mikeh','Testing Net Send');
NS.SendMessage('harryj','Home Time at 6.00');
...
end;
procedure ?????
begin
NS.Free;
...
end;
I Have included the expanded version I have been playing with as well, but not having much joy in getting any results (Privileges ????), maybe someone out there can debug and expand on them.
Answer:
// Simplified Class (single method only)unit NetSend;
interface
uses Windows,Classes;
type
// DLL Prototype declaration
TFSendMessage = function(ServerName,MsgName,FromName : PWideChar;
Buf : Pointer; BufLen : integer) : integer;
stdcall;
// TNetSend Class
TNetSend = class(TObject)
private
FLibHandle : THandle;
FSendMessage : TFSendMessage;
public
constructor Create;
destructor Destroy; override;
function SendMessage(ToName,NetMessage : string;
ServerName : string = '') : boolean;
end;
// -----------------------------------------------------------------------------
implementation
// ================================================
// Supplementarty functions
// ================================================
function GetLogonName : string;
var Buffer : string;
Retvar : string;
ASize : dword;
begin
RetVar := '';
SetLength(Buffer,50);
Asize := length(Buffer);
if GetUserName(PChar(Buffer),ASize) then begin
Retvar := string(PChar(Buffer));
end
else
Retvar := '';
Result := RetVar;
end;
function ComputerName : string;
var Name : PChar;
WName : string;
Size : DWORD;
begin
Size := MAX_COMPUTERNAME_LENGTH + 1;
GetMem(Name,Size);
GetComputerName(Name,Size);
WName := string(Name);
FreeMem(Name);
Result := WName;
end;
// ================================================
// Dynamically attempt to load library
// ================================================
constructor TNetSend.Create;
begin
FLibHandle := LoadLibrary('NETAPI32.DLL');
if FLibHandle 0 then
@FSendMessage := GetProcAddress(FLibHandle,'NetMessageBufferSend');
end;
destructor TNetSend.Destroy;
begin
inherited Destroy;
if FLibHandle 0 then FreeLibrary(FLibHandle);
end;
// =============================================================
// Send a message to a user/application name
// ServerName is '' by default and equates to LOCAL COMPUTER
// Admin privilige is required to send from a remote server
// ==============================================================
function TNetSend.SendMessage(ToName,NetMessage : string;
ServerName : string = '') : boolean;
var MsgBuff : PWideChar;
Size,NewSize : integer;
User,MyName,SName : array [0..127] of WideChar;
RetVar : boolean;
begin
RetVar := false;
if @FSendMessage nil then begin
Size := length(NetMessage);
StringToWideChar(ServerName,SName,SizeOf(SName) div 2);
StringToWideChar(ToName,User,SizeOf(User) div 2);
StringToWideChar(GetLogonName+'@'+ComputerName,MyName,
SizeOf(MyName) div 2);
NewSize := Size * 2;
MsgBuff := VirtualAlloc(nil,Size,MEM_COMMIT,PAGE_READWRITE);
MultiByteToWideChar(CP_ACP,0,PChar(NetMessage),Size,
MsgBuff,NewSize);
RetVar := (FSendMessage(SName,User,MyName,MsgBuff,
lStrLenW(MsgBuff) * SizeOf(PWideChar)) = 0);
VirtualFree(MsgBuff,0,MEM_RELEASE);
end;
Result := RetVar;
end;
end.
// =============================================================================
// Additional functionality - ANYONE HELP OR EXPAND HERE PLEASE ???
// =============================================================================
unit NetSend;
interface
uses Windows,Classes;
type
// DLL Prototype declarations
TFSendMessage = function(ServerName,MsgName,FromName : PWideChar;
Buf : Pointer; BufLen : integer) : integer;
stdcall;
TFGetNameEnum = function(ServerName : PWideChar;Level : integer;
var Buffer : Pointer; PrefMaxLen : integer;
var EntriesRead,TotalEntries,ResumeHandle : integer) : integer;
stdcall;
TFNameAdd = function(ServerName,MsgName : PWideChar) : integer;
stdcall;
TFNameDel = function(ServerName,MsgName : PWideChar) : integer;
stdcall;
// TNetSend Class
TNetSend = class(TObject)
private
FLibHandle : THandle;
FSendMessage : TFSendMessage;
FGetNameEnum : TFGetNameEnum;
FNameAdd : TFNameAdd;
FNameDel : TFNameDel;
public
constructor Create;
destructor Destroy; override;
procedure DelMsgName(MsgName : string;
ServerName : string = '');
procedure AddMsgName(MsgName : string;
ServerName : string = '');
procedure GetReceipients(ToNames : TStrings;
ServerName : string = '');
function SendMessage(ToName,NetMessage : string;
ServerName : string = '') : boolean;
end;
// -----------------------------------------------------------------------------
implementation
const BUF_SIZE = 10;
type
MSG_INFO = record
MsgName : PWideChar
end;
// Methods
constructor TNetSend.Create;
begin
FLibHandle := LoadLibrary('NETAPI32.DLL');
if FLibHandle 0 then begin
@FSendMessage := GetProcAddress(FLibHandle,'NetMessageBufferSend');
@FGetNameEnum := GetProcAddress(FLibHandle,'NetMessageNameEnum');
@FNameAdd := GetProcAddress(FLibHandle,'NetMessageNameNameAdd');
@FNameDel := GetProcAddress(FLibHandle,'NetMessageNameNameDel');
end;
end;
destructor TNetSend.Destroy;
begin
inherited Destroy;
if FLibHandle 0 then FreeLibrary(FLibHandle);
end;
// =============================================================
// Send a message to a user/application name
// ServerName is '' by default and equates to LOCAL COMPUTER
// Admin privilige is required to send from a remote server
// ==============================================================
function TNetSend.SendMessage(ToName,NetMessage : string;
ServerName : string = '') : boolean;
var MsgBuff : PWideChar;
Size,NewSize : integer;
User,MyName,SName : array [0..127] of WideChar;
RetVar : boolean;
begin
RetVar := false;
if @FSendMessage nil then begin
Size := length(NetMessage);
StringToWideChar(ServerName,SName,SizeOf(SName) div 2);
StringToWideChar(ToName,User,SizeOf(User) div 2);
StringToWideChar(GetLogonName+'@'+ComputerName,MyName,
SizeOf(MyName) div 2);
NewSize := Size * 2;
MsgBuff := VirtualAlloc(nil,Size,MEM_COMMIT,PAGE_READWRITE);
MultiByteToWideChar(CP_ACP,0,PChar(NetMessage),Size,MsgBuff,NewSize);
RetVar := (FSendMessage(SName,User,MyName,MsgBuff,
lStrLenW(MsgBuff) * SizeOf(PWideChar)) = 0);
VirtualFree(MsgBuff,0,MEM_RELEASE);
end;
Result := RetVar;
end;
// ====================================================================
// Return list of msg names (only returns myself on local computer ?)
// other server names I get a blank list ??
// ====================================================================
procedure TNetSend.GetReceipients(ToNames : TStrings;
ServerName : string = '');
const LEN = 20;
var InfPtr : pointer;
InfArr : array [1..BUF_SIZE] of MSG_INFO;
EntriesRead,TotalEntries,ResumeHandle : integer;
SName : array [0..127] of WideChar;
i : integer;
begin
ToNames.Clear;
if @FGetNameEnum nil then begin
EntriesRead := 0;
TotalEntries := 0;
ResumeHandle := 0;
StringToWideChar(ServerName,SName,SizeOf(SName) div 2);
InfPtr := VirtualAlloc(nil,SizeOf(MSG_INFO_ARR),MEM_COMMIT,PAGE_READWRITE);
FGetNameEnum(SName,0,InfPtr,LEN,EntriesRead,TotalEntries,ResumeHandle);
if EntriesRead 0 then begin
move(InfPtr^,InfArr[1],SizeOf(MSG_INFO_ARR));
for i := 1 to EntriesRead do ToNames.Add(InfArr[i].MsgName);
end;
VirtualFree(InfPtr,0,MEM_RELEASE);
end;
end;
procedure TNetSend.AddMsgName(MsgName : string;
ServerName : string = '');
var UName,SName : array [0..127] of WideChar;
begin
if @FNameAdd nil then begin
StringToWideChar(MsgName,UName,SizeOf(UName) div 2);
StringToWideChar(ServerName,SName,SizeOf(SName) div 2);
FNameAdd(SName,UName);
end;
end;
procedure TNetSend.DelMsgName(MsgName : string;
ServerName : string = '');
var UName,SName : array [0..127] of WideChar;
begin
if @FNameDel nil then begin
StringToWideChar(MsgName,UName,SizeOf(UName) div 2);
StringToWideChar(ServerName,SName,SizeOf(SName) div 2);
FNameDel(SName,UName);
end;
end;
end.