0/5 (1 avis)
Vue 8 171 fois - Téléchargée 551 fois
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.
28 mai 2006 à 12:39
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.