伺服器端程式碼:
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.