Rede - enviando mensagens winapi

// Enviando mensagens para terminais Win2000 usando a NETAPI

// Basta usar como abaixo um objeto criado logo a seguir

uses netsend;

var NS : TNetSend;

procedure TForm1.Button1Click(Sender: TObject);

begin

  NS.SendMessage('M02','vou pular pela janela');

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

  NS := TNetSend.Create;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  NS.Free;

end;

// ----------------------------------------------------------------------

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(const 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

    Retvar := string(PChar(Buffer))

  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(const 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.