服务器端代码:
unit Unit1; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls; const
WM_MYMSG=WM_USER+; 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[..] 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,都会让客户端程序报 错误-管道的另一端上无任何进程。
//在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,,); if DisconnectNamedPipe(pipeHandle)=FALSE then
begin
ShowMessage(format('DisconnectNamedPipe failed with error %d',[GetLastError()]));
Application.Destroy;
end; CloseHandle(pipeHandle);
Result:=; end; constructor TForm1.Create(AOwner: TComponent);
begin
inherited;
pipeHandle:= CreateNamedPipe('\\.\Pipe\Jim',PIPE_ACCESS_DUPLEX,
PIPE_TYPE_BYTE or PIPE_READMODE_BYTE,,,,,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,,@fun,Ptr(form1.Handle),,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,); 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.