Einzelnen Beitrag anzeigen

DualCoreCpu
(Gast)

n/a Beiträge
 
#1

Senden an Named Pipe klappt nicht! Warum? [erledigt]

  Alt 6. Feb 2010, 17:39
Hallo,

Ich experimentiere soeben mit Named Pipes.

Leider klappt die Datenübertragung nicht und ich habe keine Ahnung, wo ich meinen Fehler suchen müsste. Wer kann mir helfen.

Hier erst mal mein Quelltext:

Delphi-Quellcode:
//Hier erst mal der Pipe-Server, den ich später mit Kommandos steuern will.
program PipedProcess;

uses
  Sysutils,
  {$ifdef WIN32}
  Windows
  {$else}
   {$ifdef LINUX}
    libc, linux
   {$endif}
   
  {$endif}
  ;

{$APPTYPE CONSOLE}

const
  BytePipe = PIPE_TYPE_BYTE or PIPE_READMODE_BYTE;
  MessagePipe = PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE;

  ONE_INSTANCE = 1;
  MAX_INSTANCE = PIPE_UNLIMITED_INSTANCES;

  PIPE_NAME = '\\.\pipe\testpipe';

type
  PInputBuffer = ^TInputBuffer;
  TInputBuffer = record
    Signature: String[7];
    Value: Longint;
  end;

var
  Hpipe: THandle;
  lpPipeName: PChar;
  OpenMode: DWord;
  PipeMode: DWord;
  MaxInstances: DWord;
  OutBufSize: DWord;
  InpBufSize: DWord;
  Buffer: TInputBuffer;
  BufferPtr: PInputBuffer;
  Readed: Boolean;
  WasReaded: DWord;
  Written: DWord;
  AOverlapped: POverlapped;

begin
  MaxInstances := 1;
  Readed := false;
  HPipe := CreateNamedPipe('\\.\pipe\testpipe',
     PIPE_ACCESS_DUPLEX {or FILE_FLAG_OVERLAPPED},
      PIPE_TYPE_BYTE or PIPE_READMODE_BYTE or PIPE_WAIT,
      1, //max instances of this pipe
     SizeOf(Buffer),
     SizeOf(Buffer),
      0, //if 0 -> 50ms else X ms
     nil
    );
  Getmem(AOverlapped, Sizeof(_OVERLAPPED));
  FillChar(AOverlapped^, Sizeof(_OVERLAPPED), $00);

  ConnectNamedPipe(HPipe, AOverlapped);

  Getmem(Bufferptr, Sizeof(Buffer));
  BufferPtr^.Signature := '';
  BufferPtr.Value := 0;
  repeat
    {if not readed then} ReadFile(HPipe, Buffer, Sizeof(Buffer), WasReaded, nil); //nil statt AOverlapped
    BufferPtr := @Buffer;
    Readed := true;
    case Buffer.Value of
     1: begin
          WriteFile(HPipe, BufferPtr, Sizeof(Buffer), Written, nil); //nil statt AOverlapped
          write(BufferPtr^.Value); Write(' '); Write(BufferPtr^.Signature); Write(' ');
        end;
     2: Readed := false;
     3: ;
    end;
  until Buffer.Signature = '1234567';
  Freemem(Bufferptr, Sizeof(Buffer));
  Freemem(AOverlapped, Sizeof(_OVERLAPPED));
  CloseHandle(HPipe);
end.
//=============================================================================================
//=============================================================================================

//Und hier der Pipe-Client, von dem aus die Steuerung erfolgt:

unit CodeTemplates;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

const
  BytePipe = PIPE_TYPE_BYTE or PIPE_READMODE_BYTE;
  MessagePipe = PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE;

  ONE_INSTANCE = 1;
  MAX_INSTANCE = PIPE_UNLIMITED_INSTANCES;

  PIPE_NAME = '\\.\pipe\testpipe';

type
  PInputBuffer = ^TInputBuffer;
  TInputBuffer = record
    Signature: String[7];
    Value: Longint;
  end;

  TPipeForm = class(TForm)
    edCmd: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    edValue: TEdit;
    btnTransfer: TButton;
    Label3: TLabel;
    lblReceive: TLabel;
    lblValue: TLabel;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnTransferClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  PipeForm: TPipeForm;
  HPipe: THandle;
  lpPipeName: PChar;
  OpenMode: DWord;
  PipeMode: DWord;
  MaxInstances: DWord;
  OutBufSize: DWord;
  InpBufSize: DWord;
  Buffer: TInputBuffer;
  BufferPtr: PInputBuffer;
  Readed: Boolean;
  WasReaded: DWord;
  Written: DWord;
  AOverlapped: POverlapped;

implementation

{$R *.dfm}


procedure TPipeForm.FormDestroy(Sender: TObject);
begin

  Freemem(AOverlapped, Sizeof(_OVERLAPPED));
end;

procedure TPipeForm.FormCreate(Sender: TObject);
var
   FSA : SECURITY_ATTRIBUTES;
   FSD : SECURITY_DESCRIPTOR;
begin
  InitializeSecurityDescriptor(@FSD, SECURITY_DESCRIPTOR_REVISION);
  SetSecurityDescriptorDacl(@FSD, True, nil, False);
  FSA.lpSecurityDescriptor := @FSD;
  FSA.nLength := sizeof(SECURITY_ATTRIBUTES);
  FSA.bInheritHandle := True;
  HPipe := CreateFile(PChar('\\.\pipe\testpipe'),
                     GENERIC_READ or GENERIC_WRITE,
                     0,
                     @FSA,
                     OPEN_EXISTING,
                     0,
                     0);

  Getmem(AOverlapped, Sizeof(_OVERLAPPED));
  FillChar(AOverlapped^, Sizeof(_OVERLAPPED), $00);

end;

procedure TPipeForm.btnTransferClick(Sender: TObject);
var receive: Boolean; dw,dr: DWord;
begin
  Buffer.Signature := edCmd.Text;
  Buffer.Value := StrToInt(edValue.Text);
  receive := (Buffer.Value = 1);


  WriteFile(HPipe, Buffer, SizeOf(Buffer), dw, nil);

  if receive then
  begin
    ReadFile(HPipe, Buffer, SizeOf(Buffer), dr, nil);
  end;
  lblReceive.Caption := Buffer.Signature;
  lblValue.Caption := IntToStr(Buffer.Value);
end;

end.
In einer späteren praktischen Anwendung würde ich den Pipeserver vom Client aus vorher starten.
Hier habe ich ihn vor Start meines Pipeclients gestartet. Ich habe darauf vertraut, das der Name der Pipe irgendwo in Windows eingetragen ist und so auch gefunden wird.

Ich will die hier entwickelte Lösung später, wenn alles nach Wunsch läuft, für die Kommunikation von Programmen verschiedener Programmiersprachen oder Sprachdialekte verwenden, weshalb ich mich dabei bewusst auf das Windows API beschränke, in der Hoffnung, so die portabelste Lösung innerhalb der Windows Plattform für die unterschiedlichen Programmiersprachen zu erhalten.

Was muss ich hier anders machen, damit die Kommunikattion gelingt. Mein Server sollte wenigstens, wenn ich den Wert 1 übegebe, eine 1 auf der Windows Console ausgeben.

Wie kann ich später die Console unsichtbar machen. Die brauche ich ausschließlich für den Test und die Entwicklung meiner Lösung.
  Mit Zitat antworten Zitat