Programme de canal nommé

Télécharger le projet
Commenter

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.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (pinderlot)