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

50 | 问答知识库用户 |浏览281次
收藏|2014/05/17 22:00
如题

满意回答

2014/05/18 09:34

说明:这段代码修改自网络中有问题的代码,已经在32位win7 +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= '\.pipedengke';
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= '\.pipedengke';
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   > 0     then
        mmo1.Text:=Buffer;
    end;
  end;
end;

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

end.

热心网友

其他回答(0)
0人关注该问题
待解决问题



+1
 加载中...