Autor Beitrag
webbi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 142

Win XP Pro SP2, Debian GNU/Linux 2.6
D5 Pro, D7 Pro, BDS2006, Kylix3, MS-VS 2005
BeitragVerfasst: Sa 19.05.07 19:20 
Hallo!

Habe das mal versucht aber mit einem Stream will's nicht so richtig... Stings zu übertragen lief perfekt...

Macht das überhaupt Sinn, oder gibt es bessere Möglichkeiten?

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
type
  TDataPackage = class (TObject)
  private
  protected
  public
    Data : TMemoryStream;
    Command : String;
  end;

  TServerThread = class(TThread)
  private
  FCount: Integer;
  FPipe: THandle;
    { Private-Deklarationen }
  protected
    procedure Execute; override;
  public
    destructor Destroy;
  end;

implementation

{ TServerThread }
destructor TServerThread.Destroy;
begin
  if DisconnectNamedPipe(FPipe) then CloseHandle(FPipe);
  inherited Destroy;
end;

procedure TServerThread.Execute;
var
  fConnected, fSuccess: LongBool;
  dRequest, dReply: TDataPackage;
  lb: byte absolute dRequest;
  dwThreadID, cbBytesRead, cbReplyBytes, cbWritten: DWord;
const
  PipeName :PChar = '\\.\pipe\DataPipe'#0 ;

begin
  { Plazieren Sie den Thread code hier }
  FCount:= 0;
  while true do begin
    //PipeErzeugung
    FPipe := CreateNamedPipe(PipeName, PIPE_ACCESS_DUPLEX,
     PIPE_TYPE_Message or PIPE_READMODE_Byte or PIPE_WAIT,
     PIPE_UNLIMITED_INSTANCES, 225255, NMPWAIT_USE_DEFAULT_WAIT, nil);
    if (FPipe <> INVALID_HANDLE_VALUE) then
      //Warten auf Clientzugriff
      fConnected := ConnectNamedPipe(FPipe, nil);
      if (fConnected) then begin
        dReply := TDataPackage.Create;
        dReply.Data := TMemoryStream.Create;
        dRequest := TDataPackage.Create;
        dRequest.Data := TMemoryStream.Create;

        inc(FCount);
        //Empfang Clientanfrage
        fSuccess := ReadFile(FPipe, dRequest, sizeof(dRequest),
         cbBytesRead, Nil);
              dRequest.Data.SaveToFile('C:\Test.xxx');
        //Auswertung der Clientanfrage
        if (Copy(dRequest.Command, 1, Length('OPEN'))='OPEN'then
        begin
          dReply.Command:='do Open';
          dRequest.Data.SaveToFile('C:\Test.xxx');
        end;
        //Antwort zum Client
        fSuccess := WriteFile(FPipe, dReply, sizeof(dReply),
         cbWritten, nil);
        //Verbindungsabbau
        FlushFileBuffers(FPipe);
        DisconnectNamedPipe(FPipe);
        CloseHandle(FPipe);
      end;
  end;
end;

nach dem ReadFile ist dRequest.Data NIL...

Client:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
var send, recv : TDataPackage;
    re   : Dword;
    pipe : String;

begin
  pipe := '\\localhost\pipe\DataPipe';
  send := TDataPackage.Create;
  send.Data := TMemoryStream.Create;
  recv := TDataPackage.Create;
  recv.Data := TMemoryStream.Create;
  send.Command := 'OPEN';
  if OpenDialog1.Execute then
    send.Data.LoadFromFile(OpenDialog1.FileName);
  if not CallNamedPipe(PChar(pipe),
    @send,  // address of write buffer
    sizeof(send),  // size, in bytes, of write buffer
    @recv,  // address of read buffer
    sizeof(recv),  // size, in bytes, of read buffer
    re,  // address of number of bytes read
    3000   // time-out time, in milliseconds
   )then showmessage('Kein Connect zum server')
      else showmessage(recv.Command);


danke schon mal

Moderiert von user profile iconraziel: Code- durch Delphi-Tags ersetzt

_________________
Programmieren ist der Wettkampf zwischen Programmierer
die immer noch einfachere Programme schreiben und Anwender die immer noch dümmer werden...