Programme de canal nommé

Soyez le premier à donner votre avis sur cette source.

Vue 7 746 fois - Téléchargée 488 fois

Description

Petit programme qui permet de faire passer un message d'un exécutable serveur à un exécutable client, les 2 étant indépendants.

Source / Exemple :


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.

Codes Sources

A voir également

Ajouter un commentaire

Commentaire

Messages postés
5
Date d'inscription
jeudi 9 octobre 2003
Statut
Membre
Dernière intervention
28 mai 2006

Merci pour ton chouet code :-)

Je commençais à perdre la tête avec mes essais de named pipe :P
Enfin grâce à toi je suis soulagé!

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.