Delphi 简单命名管道在两个进程间通讯

 

服务器端代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

const
  WM_MYMSG=WM_USER+1024;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
  private
    { Private declarations }
  public
    constructor Create(AOwner: TComponent); override;
    procedure display(var msg:TMessage);message WM_MYMSG;
    { Public declarations }
  end;

var
  Form1: TForm1;


implementation

var
  pipeHandle:HWND;
  byteRead:DWORD;
  buffer:array[0..255] of char;
  threadId:Cardinal;
  threadHandle:HWND;

{$R *.dfm}

{ TForm1 }

function fun(p:Pointer):DWORD;stdcall;
begin
  if ConnectNamedPipe(pipeHandle,nil)=FALSE then
  begin
    ShowMessage(format('ConnectNamedPipe failed with error %d',[GetLastError()]));
    Application.Destroy;
  end;

  //注意，下面的 ReadFile中，其buffer只能用字符数组
  //无论是string,或者pchar，都会让客户端程序报 233错误-管道的另一端上无任何进程。
  //在msdn中 ReadFile中的buffer是个LPVOID，delphi中则是一个var（引用）参数
  //这个问题目前暂时无解决办法，是一个值得深入研究的话题。

  if ReadFile(pipeHandle,buffer,sizeof(buffer),byteRead,nil)=FALSE then
  begin
    ShowMessage(format('ReadFile failed with error %d',[GetLastError()]));
    Application.Destroy;
  end;

  SendMessage(integer(p),WM_MYMSG,1,1);

  if DisconnectNamedPipe(pipeHandle)=FALSE then
  begin
    ShowMessage(format('DisconnectNamedPipe failed with error %d',[GetLastError()]));
    Application.Destroy;
  end;

  CloseHandle(pipeHandle);
  Result:=0;

end;

constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;
  pipeHandle:= CreateNamedPipe('\\.\Pipe\Jim',PIPE_ACCESS_DUPLEX,
    PIPE_TYPE_BYTE or PIPE_READMODE_BYTE,1,0,0,1000,nil);
  if pipeHandle=INVALID_HANDLE_VALUE then
  begin
    ShowMessage(format('CreateNamePipe failed with error %d',[GetLastError()]));
    Application.Destroy;
  end;
  memo1.Clear;
  memo1.Lines.Add('Server is now running');

  threadHandle:=createThread(nil,0,@fun,Ptr(form1.Handle),0,threadId);


end;


procedure TForm1.display(var msg: TMessage);
begin
  memo1.Text:=buffer;
end;

end.

客户端代码：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    constructor Create(AOwner: TComponent); override;

    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

var
  pipeHandle:HWND;
  bytesWrite:DWORD;
  pipeNameStr:string;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin

  if WaitNamedPipe(pchar(pipeNameStr),NMPWAIT_WAIT_FOREVER)=FALSE then
  begin
    ShowMessage(format('WaitNamedPipe faile with error %d',[GetLastError()]));
    exit;
  end;

  pipeHandle:= CreateFile(pchar(pipeNameStr),GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_WRITE,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL,0);

  if pipeHandle=INVALID_HANDLE_VALUE then
  begin
    ShowMessage(format('CreateFile faile with error %d',[GetLastError()]));
    exit;
  end;

  if WriteFile(pipeHandle,pchar(memo1.text)^,length(memo1.text),bytesWrite,nil)=
    FALSE then
  begin
    ShowMessage(format('WriteFile faile with error %d',[GetLastError()]));
    exit;
  end;

  ShowMessage(format('write %d Bytes',[bytesWrite]));
  CloseHandle(pipeHandle);
end;

constructor TForm1.Create(AOwner: TComponent);
begin
  inherited;
  memo1.Clear;
  memo1.Text:='猪悟能到此一游，通过命名管道！hello';
  pipeNameStr:='\\.\Pipe\Jim';
end;

end.