从我的程序的一个实例发送字符串到我的程序的另一个实例的最佳和最简单的方法是什么？接收程序必须使用接收的字符串作为参数来执行过程.
我开始阅读DDE,但我感到困惑.我还有其他选择,实现这个的最简单方法是什么？
使用命名管道,但我会推荐Russell Libby的命名管道组件.有一个TPipeClient和TPipeServer组件.
截至(2013-10-04)Francoise Piette和arno.garrels@gmx.de更新了这个源代码,用Delphi 7编译成XE5(早期版本可以编译但未经测试)并将其放在此处: http://www.overbyte .BE/frame_index.html？redirTo =/blog_source_code.html
这两个组件使命名管道非常容易使用,命名管道非常适合进程间通信(IPC).
他的网站在这里.寻找"Pipes.zip".源代码的描述是://描述:Delphi的客户端和服务器命名管道组件集合,以及//控制台管道重定向组件.
此外,Russell帮助我在Experts-Exchange上使用该组件的旧版本在控制台应用程序中工作,以通过命名管道发送/接收消息.这可能有助于您使用他的组件启动和运行.请注意,在VCL应用程序或服务中,您不需要像在此控制台应用程序中那样编写自己的消息循环.
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.
我为此使用命名管道,这是我发现的最简单的管道.我下班回家后会发布代码.
这是一篇关于如何在delphi中使用它的文章:http://www.delphi3000.com/articles/article_2918.asp？ SC =
顺便提一下,有一百万种解决方案,所有这些解决方案似乎都很烦人.管道是迄今为止我发现的最好的管道.
这是代码,对延迟感到抱歉.您应该查看Mick提到的管道库.我在这里做的事情是一个非常快速的实验.请注意,它是在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.
这是我发送的东西:
TPBPipeClient.SendData('\\.\pipe\pipe server E5DE3B9655BE4885ABD5C90196EF0EC5', 'HELLO');
这是我读的东西:
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;
对于非常短的消息,WM_COPYDATA可能是最简单的.除此之外,PetriW建议使用命名管道或插座.
见JclAppInstances在JCL.
京公网安备 11010802040832号 | 京ICP备19059560号-6 