如何在我的Delphi程序的不同实例之间发送字符串？

Question

什么是从程序的一个实例发送字符串到另一个实例的最佳和最简单的方法？接收程序必须执行一个过程，使用接收到的字符串作为参数。

我开始了解DDE，但我感到困惑。我还有哪些选项，并且实现这个功能最简单的方法是什么？

- Arthur

---

@Arthur：我编辑了你的问题，使其更易于分类和以后搜索。SO 不仅是为了让你快速解决问题，还可以创建一个可搜索的知识库，就像维基一样。 - mghie

在实例之间传输信息使用注册表有什么问题吗？或者这会对性能产生太大的影响吗？ - Optavius

Answer 1

使用命名管道，但我建议使用Russell Libby的命名管道组件。有一个TPipeClient和TPipeServer组件。

截至（2013-10-04），Francoise Piette和[e-mail]更新了此源代码，以便在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.

- Mick

---

这个库看起来很有趣，我得仔细阅读一下。 :) - PetriW

我认为链接已经失效，因为我无法访问它。 - Andrea Raimondi

@Andrea Raimondi，您可以在此处查看pipes.pas文件http://r3code.livejournal.com/117012.html - Little Helper

Answer 2

我使用命名管道来实现这个，发现它是最简单的解决方法。等我下班后会发布代码。

这是一篇关于如何在Delphi中使用它的文章：http://www.delphi3000.com/articles/article_2918.asp?SK=

顺便提一下，有成千上万种解决方案，但它们似乎都很烦人，而管道是我目前发现的最好的解决方法。

这是代码，对于延迟我感到抱歉。你也应该查看Mick提到的Pipe库。这里我做了一个相当快速的实验，请注意它是在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;

- PetriW

---

感谢您添加这个例子。它有助于澄清。 - Mick

Delphi3000的文章链接已经失效。 - gabr

Answer 3

对于非常短的消息，WM_COPYDATA 可能是最简单的方法。除此之外，还有 PetriW 提出的命名管道或套接字。

- Craig Stuntz

---

使用WM_COPYDATA确实很容易，但是问题始终是如何获得要发送消息的窗口句柄。这似乎是更困难的部分。 - mghie

Answer 4

请参阅JclAppInstances，该内容与JCL有关。

- TOndrej

---

我正在尝试做这件事。这似乎赢得了某种“晦涩难懂”的奖项。TJclSwapFileMapping...我现在正在尝试这个。 - Warren P

这是一种标准的进程间通信方式：基于系统分页文件的内存映射文件（使用INVALID_HANDLE_VALUE调用CreateFileMapping）。可用于将命令行传递给其他实例。 - Ondrej Kelle

我想我总是把自己看作某种晦涩难懂的仲裁者。:-) 交换文件作为进程间通信技术。:-) 哇塞。 - Warren P

在我看来，这是标准的做法，记录在MSDN中，通常用于需要多个进程共享内存而不创建临时文件的情况。 - Ondrej Kelle

Answer 5

看看ZeroMQ。如果你理解了它的架构思想，它可能会大大改变你的思考方式。据我所知，他们有许多编程语言的库，包括Delphi。但我还没有尝试过。

这是ZeroMQ的网站：http://www.zeromq.org 这是该库的Delphi版本：https://github.com/bvarga/delphizmq

- Ali Avcı

Answer 6

我建议使用TMappedFile - 比命名管道更有效。

- Vector

Answer 7

请检查Cromis.IPC，它在内部使用命名管道，但提供了更简单的API，并且与最新版本的Delphi兼容。

- Edwin Yip

Answer 8

我使用InterAppComm，它非常好用。

它可以在两个或多个应用程序之间发送数据。它可以发送字符串、整数和其他数据类型。

- AliReza