- 2 fichiers .pas:
-
- unit ClientFrm;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls;
-
- type
- TForm1 = class(TForm)
- Edit1: TEdit;
- btnConnect: TButton;
- btnLit: TButton;
- btnFerme: TButton;
- procedure btnConnectClick(Sender: TObject);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure btnLitClick(Sender: TObject);
- procedure btnFermeClick(Sender: TObject);
- private
- { Déclarations privées }
- public
- { Déclarations publiques }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.DFM}
-
- var
- hPipe : THandle;
-
-
- procedure TForm1.btnConnectClick(Sender: TObject);
- begin
- if not WaitNamedPipe('\\.\pipe\MonPipe', NMPWAIT_USE_DEFAULT_WAIT) then
- raise Exception.Create('Le canal n''existe pas');
-
- hPipe:=CreateFile('\\.\pipe\MonPipe',
- GENERIC_READ or GENERIC_WRITE,
- FILE_SHARE_READ or FILE_SHARE_WRITE,
- nil,
- OPEN_EXISTING,
- FILE_ATTRIBUTE_NORMAL,
- 0);
-
- if hPipe=$FFFFFFFF then
- raise Exception.Create('Impossible de se connecter au canal');
-
- btnConnect.enabled:=false;
- btnLit.enabled:=true;
- end;
-
- procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
- begin
- CloseHandle(hPipe);
- end;
-
- procedure TForm1.btnLitClick(Sender: TObject);
- var
- msg : array[0..512] of char;
- nReads : integer;
- nSize, nAvailable, nLeft : dword;
- begin
- if PeekNamedPipe(hPipe, @msg, sizeof(msg), @nSize, @nAvailable, @nLeft) then begin
- if ReadFile(hPipe, msg, nSize, nReads, nil) then begin
- msg[nReads]:=#0;
- Edit1.text:=StrPas(msg);
- end;
- end
- else
- ShowMessage('Erreur en lecture');
- end;
-
- procedure TForm1.btnFermeClick(Sender: TObject);
- begin
- close
- end;
-
- end.
-
-
- -----------------------------------------------------------------------------------------------
- unit ServeurFrm;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls;
-
- type
- TForm1 = class(TForm)
- GroupBox1: TGroupBox;
- btnOpen: TButton;
- Label2: TLabel;
- Edit2: TEdit;
- btnSend: TButton;
- Button1: TButton;
- Label3: TLabel;
- procedure btnOpenClick(Sender: TObject);
- procedure btnSendClick(Sender: TObject);
- procedure Button1Click(Sender: TObject);
- private
- { Déclarations privées }
- public
- { Déclarations publiques }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.DFM}
-
- var
- hPipe : THandle;
-
-
- procedure TForm1.btnOpenClick(Sender: TObject);
- begin
- hPipe:=CreateNamedPipe('\\.\pipe\MonPipe',
- PIPE_ACCESS_DUPLEX,
- PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE,
- PIPE_UNLIMITED_INSTANCES,
- 0,
- 0,
- INFINITE,
- nil);
-
-
- if hPipe=INVALID_HANDLE_VALUE then
- raise Exception.Create('Echec lors de la création du canal nommé');
-
- btnSend.Enabled:=true;
- end;
-
- procedure TForm1.btnSendClick(Sender: TObject);
- var
- nWrite : dword;
- data : array[0..255] of char;
- begin
- strPCopy(data, Edit2.text);
-
- if not WriteFile(hPipe, data, strlen(data), nWrite, nil)
- then
- raise Exception.Create('Ecriture erronée');
- end;
-
- procedure TForm1.Button1Click(Sender: TObject);
- begin
- close
- end;
-
- end.
2 fichiers .pas:
unit ClientFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
btnConnect: TButton;
btnLit: TButton;
btnFerme: TButton;
procedure btnConnectClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnLitClick(Sender: TObject);
procedure btnFermeClick(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
hPipe : THandle;
procedure TForm1.btnConnectClick(Sender: TObject);
begin
if not WaitNamedPipe('\\.\pipe\MonPipe', NMPWAIT_USE_DEFAULT_WAIT) then
raise Exception.Create('Le canal n''existe pas');
hPipe:=CreateFile('\\.\pipe\MonPipe',
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if hPipe=$FFFFFFFF then
raise Exception.Create('Impossible de se connecter au canal');
btnConnect.enabled:=false;
btnLit.enabled:=true;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseHandle(hPipe);
end;
procedure TForm1.btnLitClick(Sender: TObject);
var
msg : array[0..512] of char;
nReads : integer;
nSize, nAvailable, nLeft : dword;
begin
if PeekNamedPipe(hPipe, @msg, sizeof(msg), @nSize, @nAvailable, @nLeft) then begin
if ReadFile(hPipe, msg, nSize, nReads, nil) then begin
msg[nReads]:=#0;
Edit1.text:=StrPas(msg);
end;
end
else
ShowMessage('Erreur en lecture');
end;
procedure TForm1.btnFermeClick(Sender: TObject);
begin
close
end;
end.
-----------------------------------------------------------------------------------------------
unit ServeurFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
btnOpen: TButton;
Label2: TLabel;
Edit2: TEdit;
btnSend: TButton;
Button1: TButton;
Label3: TLabel;
procedure btnOpenClick(Sender: TObject);
procedure btnSendClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
hPipe : THandle;
procedure TForm1.btnOpenClick(Sender: TObject);
begin
hPipe:=CreateNamedPipe('\\.\pipe\MonPipe',
PIPE_ACCESS_DUPLEX,
PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE,
PIPE_UNLIMITED_INSTANCES,
0,
0,
INFINITE,
nil);
if hPipe=INVALID_HANDLE_VALUE then
raise Exception.Create('Echec lors de la création du canal nommé');
btnSend.Enabled:=true;
end;
procedure TForm1.btnSendClick(Sender: TObject);
var
nWrite : dword;
data : array[0..255] of char;
begin
strPCopy(data, Edit2.text);
if not WriteFile(hPipe, data, strlen(data), nWrite, nil)
then
raise Exception.Create('Ecriture erronée');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
close
end;
end.