在Delphi中使用命名管道进行进程间通信

在Delphi中使用命名管道进行进程间通信

2011-11-07 16:05:35| 分类：Delphi源码 | 标签：delphi 进程通信命名管道|字号订阅说明：这段代码修改自网络中有问题的代码，已经在32位win7 +D7调试通过。

实现了在Server端做任何更改，Client端都通过时间触发器获取到修改的内容。

注意：尚未实现线程安全，请谨慎使用。

Server端（主动提供信息处）：

{$R *.dfm}

procedure TForm1.btnServerClick(Sender:TObject);

const

pipename:string='\\.\pipe\dengke';

var

SPipeHandle:THandle;

Se:TSecurityAttributes;

WriteBuffer:DWORD;

Buffer:pchar;

begin

Se.nLength:=Sizeof(TSecurityAttributes);

Se.lpSecurityDescriptor:=nil;

Se.bInheritHandle:=True;

SPipeHandle:=CreateNamedPipe(pchar(pipename),PIPE_ACCESS_DUPLEX OR FILE_FLAG_WRITE_THROUGH,

PIPE_TYPE_BYTE or PIPE_WAIT,

2,512,512,1000,@Se);

if SPipeHandle=0then

raise Exception.Create('Create pipe Failed ');

try

if not ConnectNamedPipe(SPipeHandle,nil)then

begin

CloseHandle(SPipeHandle);

Raise Exception.Create(IntToStr(GetLastError)+'fail con ');

end;

Buffer:=StrAlloc(512);

Buffer:=Pchar(mmo1.Text);

WriteFile(SPipeHandle,Buffer[0],512,WriteBuffer,nil);

finally

DisConnectNamedPipe(SPipeHandle);

CloseHandle(SPipeHandle);

end;

end;

Client端（被动获取信息处）：

unit uClient;

interface

uses

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

type

TForm2=class(TForm)

btnClient:TButton;

mmo1:TMemo;

tmr1:TTimer;

procedure btnClientClick(Sender:TObject);

procedure tmr1Timer(Sender:TObject);

private

{Private declarations }

public

{Public declarations }

end;

var

Form2:TForm2;

implementation

{$R *.dfm}

procedure TForm2.btnClientClick(Sender:TObject);

const

PipeName:string='\\.\pipe\dengke';

var

Buffer:array[0..511] of char;

ReadSize:DWORD;

hh:Thandle;

begin

//if not WaitNamedPipe(pchar(PipeName),NMPWAIT_USE_DEFAULT_WAIT) then if WaitNamedPipe(pchar(PipeName),NMPWAIT_WAIT_FOREVER)then

begin

hh:=CreateFile(pchar(pipename), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or

FILE_SHARE_WRITE,NiL,OPEN_EXISTING,FILE_ATTRIBUTE_ARCHIVE or FILE_FLAG_WRITE_THROUGH,0);

if hh=INVALID_HANDLE_VALUE then

showmessage('error createfile ')

else

begin

readsize:=0;

fillchar(buffer,512,0);

readfile(hh,buffer,512,readsize,nil);

if readsize >0then

mmo1.Text:=Buffer;

end;

end;

end;

procedure TForm2.tmr1Timer(Sender:TObject);

begin

btnClientClick(nil);

end;

end.