begin process at 2010 02 10 12:42:22
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Exécution

 > PROGRAMME DE CANAL NOMMÉ

PROGRAMME DE CANAL NOMMÉ


 Description

Cliquez pour voir la capture en taille normale
Petit programme qui permet de faire passer un message d'un exécutable serveur à un exécutable client, les 2 étant indépendants.

Source

  • 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.


 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources du même auteur

Source avec Zip Source avec une capture UTILISATION DES THREADS

 Sources de la même categorie

Source avec Zip GÉNÉRATEUR DE JET DE DÉS par koriteki
Source avec Zip Source avec une capture LES FIBERS : DES THREADS NON PRÉEMPTÉS PAR LE SYSTÈME par Caribensila
Source avec Zip Source avec une capture UAC (USER ACCOUNT CONTROL) - EXÉCUTER UNE APPLICATION EN TAN... par ni69
BLOQUER LE TASKMGR SANS CLÉ DE REGISTRE par craftsystem
Source avec Zip UTILISER LES MESSAGES WINDOWS POUR GERER LE NOMBRE D'INSTANC... par lotfi213_b19

Commentaires et avis

Commentaire de DCA_BIGBOSS le 28/05/2006 12:39:49

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é!

 Ajouter un commentaire




Nos sponsors


Sondage...

CalendriCode

Février 2010
LMMJVSD
1234567
891011121314
15161718192021
22232425262728

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,827 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales