How do I send a string from one instance of my Delphi program to another?
Solution 1:
Use named Pipes, but I would recommend Russell Libby's named Pipe components. There is a TPipeClient and TPipeServer component.
As of (2013-10-04) Francoise Piette and [email protected] updated this source code to compile with Delphi 7 to XE5 (earlier versions may compile however untested) and put it here: http://www.overbyte.be/frame_index.html?redirTo=/blog_source_code.html
These 2 components make using named pipes incredibly easy, and named pipes are great for inter-process communication (IPC).
His website is here. Look for "Pipes.zip". The description from the source is: // Description : Set of client and server named pipe components for Delphi, as // well a console pipe redirection component.
Also, Russell helped me out on Experts-Exchange with using an older version of this component to work in a console app to send/receive messages over named pipes. This may help as a guide in getting you up and running with using his components. Please note, that in a VCL app or service, you don't need to write your own message loop as I did in this console app.
program CmdClient;
{$APPTYPE CONSOLE}
uses
Windows, Messages, SysUtils, Pipes;
type
TPipeEventHandler = class(TObject)
public
procedure OnPipeSent(Sender: TObject; Pipe: HPIPE; Size: DWORD);
end;
procedure TPipeEventHandler.OnPipeSent(Sender: TObject; Pipe: HPIPE; Size: DWORD);
begin
WriteLn('On Pipe Sent has executed!');
end;
var
lpMsg: TMsg;
WideChars: Array [0..255] of WideChar;
myString: String;
iLength: Integer;
pcHandler: TPipeClient;
peHandler: TPipeEventHandler;
begin
// Create message queue for application
PeekMessage(lpMsg, 0, WM_USER, WM_USER, PM_NOREMOVE);
// Create client pipe handler
pcHandler:=TPipeClient.CreateUnowned;
// Resource protection
try
// Create event handler
peHandler:=TPipeEventHandler.Create;
// Resource protection
try
// Setup clien pipe
pcHandler.PipeName:='myNamedPipe';
pcHandler.ServerName:='.';
pcHandler.OnPipeSent:=peHandler.OnPipeSent;
// Resource protection
try
// Connect
if pcHandler.Connect(5000) then
begin
// Dispatch messages for pipe client
while PeekMessage(lpMsg, 0, 0, 0, PM_REMOVE) do DispatchMessage(lpMsg);
// Setup for send
myString:='the message I am sending';
iLength:=Length(myString) + 1;
StringToWideChar(myString, wideChars, iLength);
// Send pipe message
if pcHandler.Write(wideChars, iLength * 2) then
begin
// Flush the pipe buffers
pcHandler.FlushPipeBuffers;
// Get the message
if GetMessage(lpMsg, pcHandler.WindowHandle, 0, 0) then DispatchMessage(lpMsg);
end;
end
else
// Failed to connect
WriteLn('Failed to connect to ', pcHandler.PipeName);
finally
// Show complete
Write('Complete...');
// Delay
ReadLn;
end;
finally
// Disconnect event handler
pcHandler.OnPipeSent:=nil;
// Free event handler
peHandler.Free;
end;
finally
// Free pipe client
pcHandler.Free;
end;
end.
Solution 2:
I use named pipes for this, it was the easiest one I found. I'll post the code when I get home from work.
Here's an article on how to use it in delphi: http://www.delphi3000.com/articles/article_2918.asp?SK=
There's a million solutions to this by the way, all of them seem to be annoying. Pipes is the best one I've found so far.
Here's the code, sorry about the delay. You should check out the Pipe library mentioned by Mick too. The thing I've done here was a pretty quick experiment. Please note that it was made in Delphi 2009.
unit PetriW.Pipes;
interface
uses
Windows,
Classes,
Forms,
SyncObjs,
SysUtils
;
type
TPBPipeServerReceivedDataEvent = procedure(AData: string) of object;
TPBPipeServer = class
private
type
TPBPipeServerThread = class(TThread)
private
FServer: TPBPipeServer;
protected
public
procedure Execute; override;
property Server: TPBPipeServer read FServer;
end;
private
FOnReceivedData: TPBPipeServerReceivedDataEvent;
FPath: string;
FPipeHandle: THandle;
FShutdownEvent: TEvent;
FThread: TPBPipeServerThread;
protected
public
constructor Create(APath: string);
destructor Destroy; override;
property Path: string read FPath;
property OnReceivedData: TPBPipeServerReceivedDataEvent read FOnReceivedData write FOnReceivedData;
end;
TPBPipeClient = class
private
FPath: string;
protected
public
constructor Create(APath: string);
destructor Destroy; override;
property Path: string read FPath;
procedure SendData(AData: string); overload;
class procedure SendData(APath, AData: string); overload;
end;
implementation
const
PIPE_MESSAGE_SIZE = $20000;
{ TPipeServer }
constructor TPBPipeServer.Create(APath: string);
begin
FPath := APath;
FShutdownEvent := TEvent.Create(nil, True, False, '');
FPipeHandle := CreateNamedPipe(
PWideChar(FPath),
PIPE_ACCESS_DUPLEX or FILE_FLAG_OVERLAPPED,
PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE or PIPE_WAIT,
PIPE_UNLIMITED_INSTANCES,
SizeOf(Integer),
PIPE_MESSAGE_SIZE,
NMPWAIT_USE_DEFAULT_WAIT,
nil
);
if FPipeHandle = INVALID_HANDLE_VALUE then
RaiseLastOSError;
FThread := TPBPipeServerThread.Create(true);
FThread.FreeOnTerminate := false;
FThread.FServer := self;
FThread.Resume;
end;
destructor TPBPipeServer.Destroy;
begin
FShutdownEvent.SetEvent;
FreeAndNil(FThread);
CloseHandle(FPipeHandle);
FreeAndNil(FShutdownEvent);
inherited;
end;
{ TPipeServer.TPipeServerThread }
procedure TPBPipeServer.TPBPipeServerThread.Execute;
var
ConnectEvent, ReadEvent: TEvent;
events: THandleObjectArray;
opconnect, opread: TOverlapped;
Signal: THandleObject;
buffer: TBytes;
bytesRead, error: Cardinal;
begin
inherited;
//SetThreadName('TPBPipeServer.TPBPipeServerThread');
ConnectEvent := TEvent.Create(nil, False, False, '');
try
setlength(events, 2);
events[1] := Server.FShutdownEvent;
FillMemory(@opconnect, SizeOf(TOverlapped), 0);
opconnect.hEvent := ConnectEvent.Handle;
while not Terminated do
begin
ConnectNamedPipe(Server.FPipeHandle, @opconnect);
events[0] := ConnectEvent;
THandleObject.WaitForMultiple(events, INFINITE, False, Signal);
if Signal = ConnectEvent then
try
// successful connect!
ReadEvent := TEvent.Create(nil, True, False, '');
try
FillMemory(@opread, SizeOf(TOverlapped), 0);
opread.hEvent := ReadEvent.Handle;
setlength(buffer, PIPE_MESSAGE_SIZE);
if not ReadFile(Server.FPipeHandle, buffer[0], PIPE_MESSAGE_SIZE, bytesRead, @opread) then
begin
error := GetLastError;
if error = ERROR_IO_PENDING then
begin
if not GetOverlappedResult(Server.FPipeHandle, opread, bytesRead, True) then
error := GetLastError
else
error := ERROR_SUCCESS;
end;
if error = ERROR_BROKEN_PIPE then
// ignore, but discard data
bytesRead := 0
else if error = ERROR_SUCCESS then
// ignore
else
RaiseLastOSError(error);
end;
if (bytesRead > 0) and Assigned(Server.OnReceivedData) then
Server.OnReceivedData(TEncoding.Unicode.GetString(buffer, 0, bytesRead));
// Set result to 1
PInteger(@buffer[0])^ := 1;
if not WriteFile(Server.FPipeHandle, buffer[0], SizeOf(Integer), bytesRead, @opread) then
begin
error := GetLastError;
if error = ERROR_IO_PENDING then
begin
if not GetOverlappedResult(Server.FPipeHandle, opread, bytesRead, True) then
error := GetLastError
else
error := ERROR_SUCCESS;
end;
if error = ERROR_BROKEN_PIPE then
// ignore
else if error = ERROR_SUCCESS then
// ignore
else
RaiseLastOSError(error);
end;
finally
FreeAndNil(ReadEvent);
end;
finally
DisconnectNamedPipe(Server.FPipeHandle);
end
else if Signal = Server.FShutdownEvent then
begin
// server is shutting down!
Terminate;
end;
end;
finally
FreeAndNil(ConnectEvent);
end;
end;
{ TPBPipeClient }
constructor TPBPipeClient.Create(APath: string);
begin
FPath := APath;
end;
destructor TPBPipeClient.Destroy;
begin
inherited;
end;
class procedure TPBPipeClient.SendData(APath, AData: string);
var
bytesRead: Cardinal;
success: Integer;
begin
if not CallNamedPipe(PWideChar(APath), PWideChar(AData), length(AData) * SizeOf(Char), @success, SizeOf(Integer), bytesRead, NMPWAIT_USE_DEFAULT_WAIT) then
RaiseLastOSError;
end;
procedure TPBPipeClient.SendData(AData: string);
var
bytesRead: Cardinal;
success: boolean;
begin
if not CallNamedPipe(PWideChar(FPath), PWideChar(AData), length(AData) * SizeOf(Char), @success, SizeOf(Integer), bytesRead, NMPWAIT_USE_DEFAULT_WAIT) then
RaiseLastOSError;
end;
end.
Here's how I send something:
TPBPipeClient.SendData('\\.\pipe\pipe server E5DE3B9655BE4885ABD5C90196EF0EC5', 'HELLO');
Here's how I read something:
procedure TfoMain.FormCreate(Sender: TObject);
begin
PipeServer := TPBPipeServer.Create('\\.\pipe\pipe server E5DE3B9655BE4885ABD5C90196EF0EC5');
PipeServer.OnReceivedData := PipeDataReceived;
end;
procedure TfoMain.PipeDataReceived(AData: string);
begin
if AData = 'HELLO' then
// do something, but note that you're not in the main thread, you're in the pipe server thread
end;
Solution 3:
For very short messages, WM_COPYDATA is probably the easiest. Other than that, there is PetriW's suggestion of named pipes, or sockets.