¿Cómo envío una cadena desde una instancia de mi programa Delphi a otra?
dde message-passing (8)
¿Cuál es la mejor y más fácil manera de enviar una cadena desde una instancia de mi programa a otra instancia de mi programa? El programa receptor debe ejecutar un procedimiento, utilizando la cadena recibida como parámetro.
Empecé a leer sobre DDE pero me confundí. ¿Qué otras opciones tengo, y cuál es la forma más fácil de implementar esto?
Para mensajes muy cortos, WM_COPYDATA es probablemente el más fácil. Aparte de eso, existe la sugerencia de PetriW de tuberías con nombre o enchufes.
Utilizo tubos con nombre para esto, fue el más fácil que encontré. Publicaré el código cuando llegue a casa del trabajo.
Aquí hay un artículo sobre cómo usarlo en Delphi: http://www.delphi3000.com/articles/article_2918.asp?SK=
Hay un millón de soluciones para esto, por cierto, todas parecen ser molestas. Pipes es el mejor que he encontrado hasta ahora.
Aquí está el código, perdón por la demora. Debería verificar la biblioteca de Pipe mencionada por Mick también. Lo que hice aquí fue un experimento bastante rápido. Tenga en cuenta que fue hecho en 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.
Así es como envío algo:
TPBPipeClient.SendData(''//./pipe/pipe server E5DE3B9655BE4885ABD5C90196EF0EC5'', ''HELLO'');
Así es como leo algo:
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;
Ver JclAppInstances en el JCL .
Yo uso InterAppComm y es muy bueno.
Envía datos entre dos o más aplicaciones. Puede enviar cadenas, enteros y otros tipos de datos.
Verifique Cromis.IPC , internamente utiliza canalizaciones con nombre, pero proporciona una API mucho más fácil y es compatible con las versiones recientes de Delphi.
Eche un vistazo a ZeroMQ. Si tiene los pensamientos detrás de la arquitectura, puede cambiar drásticamente su forma de pensar. Por lo que tuve un recorrido, tienen bibliotecas para muchos lenguajes de programación, incluyendo Delphi. Pero no tuve la oportunidad de probarlo.
Aquí está el puerto Delphi de la biblioteca.
Use tuberías con nombre, pero recomendaría los componentes de tubería nombrados por Russell Libby. Hay un componente TPipeClient y TPipeServer.
A partir de (2013-10-04) Francoise Piette y [email protected] actualizaron este código fuente para compilar Delphi 7 a XE5 (las versiones anteriores pueden compilarse sin embargo) y lo pusieron aquí: http: //www.overbyte .be / frame_index.html? redirTo = / blog_source_code.html
Estos 2 componentes hacen que el uso de las tuberías con nombre sea increíblemente fácil, y las tuberías con nombre son excelentes para la comunicación entre procesos (IPC).
Su sitio web está aquí . Busque "Pipes.zip". La descripción de la fuente es: // Descripción: Conjunto de componentes de canal con nombre de cliente y servidor para Delphi, como // bien un componente de redirección de canal de consola.
Además, Russell me ayudó en Experts-Exchange con el uso de una versión anterior de este componente para trabajar en una aplicación de consola para enviar / recibir mensajes por conductos específicos. Esto puede ayudar como una guía para ponerlo en funcionamiento con el uso de sus componentes. Tenga en cuenta que en una aplicación o servicio VCL, no necesita escribir su propio bucle de mensajes como lo hice en esta aplicación de consola.
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.
Sugiero TMappedFile, más eficiente que los pipes nombrados.