RSS订阅 | 匿名投稿
您的位置:网站首页 > 进程 > 正文

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

作者:admin 来源:未知 日期:2010/5/9 14:17:32 人气: 标签:

服务器端代码:
----------------------------------------------------------------------------------------------------------------

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.


读完这篇文章后,您心情如何?
0
0
0
0
0
0
0
0
本文网址: