Delphi中使用命名管道进行进程间通信 
2011-11-07 16:05:35|  分类: Delphi源码 标签:delphi  进程通信  命名管道  |字号 订阅
说明:这段代码修改自网络中有问题的代码,已经在32win7 +D7调试通过。
实现了在Server端做任何更改,Client端都通过时间触发器获取到修改的内容。
注意:尚未实现线程安全,请谨慎使用。

Server端(主动提供信息处):

unit uServer;

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
  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
  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;
      Buffer:=StrAlloc(512);
      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)
    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_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;


procedure TForm2.tmr1Timer(Sender: TObject);
begin
  btnClientClick(nil);
end;

end.

版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198,我们将在24小时内删除。