PROGRAMME DE CANAL NOMMÉ

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.

Télécharger le zip