在Delphi中使用命名管道进行进程间通信
2011-11-07 16:05:35| 分类: Delphi源码 | 标签:delphi 进程通信 命名管道 |字号 订阅
说明:这段代码修改自网络中有问题的代码,已经在32位win7 +D7调试通过。
实现了在Server端做任何更改,Client端都通过时间触发器获取到修改的内容。
注意:尚未实现线程安全,请谨慎使用。
Server端(主动提供信息处):
实现了在Server端做任何更改,Client端都通过时间触发器获取到修改的内容。
注意:尚未实现线程安全,请谨慎使用。
Server端(主动提供信息处):
unit uServer;
interface
uses
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
mmo1: TMemo;
btnServer: TButton;
procedure btnServerClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
mmo1: TMemo;
btnServer: TButton;
procedure btnServerClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btnServerClick(Sender: TObject);
const
pipename:string= '\\.\pipe\dengke';
var
SPipeHandle:THandle;
Se:TSecurityAttributes;
WriteBuffer:DWORD;
Buffer:pchar;
begin
implementation
{$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= 0 then
raise Exception.Create( 'Create pipe Failed ');
try
if not ConnectNamedPipe(SPipeHandle,nil) then
begin
CloseHandle(SPipeHandle);
Raise Exception.Create(IntToStr(GetLastError)+ 'fail con ');
end;
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= 0 then
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;
end.
Buffer:=Pchar(mmo1.Text);
WriteFile(SPipeHandle,Buffer[0],512,WriteBuffer,nil);
finally
DisConnectNamedPipe(SPipeHandle);
CloseHandle(SPipeHandle);
end;
end;
end.
Client端(被动获取信息处):
unit uClient;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm2 = class(TForm)
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
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_SHA
RE_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 > 0 then
mmo1.Text:=Buffer;
end;
end;
end;
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 > 0 then
mmo1.Text:=Buffer;
end;
end;
end;
procedure TForm2.tmr1Timer(Sender: TObject);
begin
btnClientClick(nil);
end;
end.
版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198,我们将在24小时内删除。
发表评论