unit1.~pas

DELPHI与其它进程通信

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Memo2: TMemo;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    tps:TPipeServer;
    procedure PDMEvent(sender: TObject; Data:RErpMsg);

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
implementation



{$R *.dfm}
   function  SendMsg2Server( Msg: String): String;
    var send : string;  
        recv : string[255];  
        d    : Byte absolute recv;  
        re   : DWord;  
        pipe : String;
     begin
        recv := '未找到连接';
       pipe :='\\.\pipe\MyPipe';
       send := pchar(Msg) ;


       if CallNamedPipe(PChar(pipe),
         @send[1],                // address of write buffer
         length(send),            // size, in bytes, of write buffer
         @recv[1],                // address of read buffer
         sizeof(recv),            // size, in bytes, of read buffer
         re,                      // address of number of bytes read
         3000                     // time-out time, in milliseconds
        ) then begin
        d := re;
       end;
       Result := recv;
    end;

procedure TForm1.Button1Click(Sender: TObject);
var
  rec:string;
begin

 try
   rec:= SendMsg2Server(edit1.Text);
 except

 end;
 self.Memo1.Lines.Add(rec) ;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
 nid:THandle;
 err:DWORD;
 fConnected:boolean;
begin
  try
    nid:= CreateNamedPipe( '\\.\pipe\MyPipe2',
                                  PIPE_ACCESS_DUPLEX,
                                  PIPE_TYPE_Message or PIPE_READMODE_Byte or PIPE_WAIT,
                                  PIPE_UNLIMITED_INSTANCES, 225, 255,
                                  3000, NIL);
    if(nid <> INVALID_HANDLE_VALUE)then
          fConnected := ConnectNamedPipe(nid, nil);
   // if nid =null then raise exception.Create('不能创建管道');
    if not fconnected then raise exception.Create('不能创建管道');
   if fconnected then
   begin
     err:=getlasterror;
     if err<> ERROR_PIPE_CONNECTED then
       raise exception.Create('启动失败'+inttostr(err));
   end;

  except
    on e:exception do
    begin
     showmessage(e.Message);
    end;
  end;
end;
procedure TForm1.PDMEvent(sender:TObject;Data:RErpMsg );
begin
  self.Memo2.Lines.Append('收到数据:'+data.Msg);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
  try
    tps:=TPipeServer.CreatePipeServer('', 'MyPipe1',true);
    tps.OnPDMEvent:= self.PDMEvent;
  except
    on e:exception do
    begin
      showmessage(e.Message);
    end;
  end;

end;

procedure TForm1.Button5Click(Sender: TObject);
var
  tpc:TpipeClient;
begin
  tpc:=TpipeClient.Create('','MyPipe1');
  self.Memo1.Lines.Append(tpc.SendString(self.Edit1.Text));
end;

procedure TForm1.Button6Click(Sender: TObject);
begin

  self.tps.ShutDownServer;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  showmessage(inttostr(length(edit1.Text)));
end;

end.