Stream mit Indys versenden

[jfheins]

Ich habe schon viel versucht, aber ich komme einfach nicht weiter ...

Wie kann ich mit TIdTCPServer und TIdTCPClient einen Stream korrekt versenden ???

Mein letzter Versuch:

Delphi-Quellcode:

procedure showstream (Stream: TStream);
var
 MsgRecord: TMsgRecord;
begin
 Stream.Position := 0;
 FillMsgRecordFromStream (Stream, Msgrecord);
 form1.Memo1.Text := form1.Memo1.Text + 'Command: ' + inttostr(ord(MsgRecord.Command)) + #13#10 + 'SendBy: ' + MsgRecord.SendBy + #13#10 + 'Message:' + #13#10 + MsgRecord.Msg + #13#10#13#10;
 Stream.Position := 0;
end;

Delphi-Quellcode:

procedure FillMsgRecordFromStream (Stream: TStream; var MsgRecord: TMsgRecord);
var
 Len: LongInt;
begin
  Stream.Read (MsgRecord.Command, SizeOf (MsgRecord.Command));
  Stream.Read (MsgRecord.SendBy, SizeOf (MsgRecord.SendBy));
  Stream.Read (MsgRecord.FontColor, SizeOf (MsgRecord.FontColor));

  Stream.Read (Len, SizeOf (Len));
  SetLength (MsgRecord.FontName, Len);
  Stream.Read (PChar (MsgRecord.FontName)^, Len);

  Stream.Read (MsgRecord.FontSize, SizeOf (MsgRecord.FontSize));
  Stream.Read (MsgRecord.FontStyle, SizeOf (MsgRecord.FontStyle));

  Stream.Read (Len, SizeOf (Len));
  SetLength (MsgRecord.Msg, Len);
  Stream.Read (PChar (MsgRecord.Msg)^, Len);
end;

Delphi-Quellcode:

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
 Stream2: TStream;
begin
 Stream2 := TStringStream.Create;
 Memo1.Lines.Add('Reading ...');
try
 stream2.Position := 0;
 AThread.Connection.ReadStream(Stream2);
 Memo1.Lines.Add('Done. Processing ...');
except
 Memo1.Lines.Add('Failed. Processing ...');
end;
 showstream (stream2);
 Memo1.Lines.Add('Done.');
 Stream2.Free;
end;

Zum versenden:

Delphi-Quellcode:

procedure TForm1.Button8Click(Sender: TObject);
var
 MsgRecord: TMsgRecord;
 Stream2: tStream;
begin
  MsgRecord.Command := TXT;
  MsgRecord.SendBy := 'Julius';

  MsgRecord.FontColor := FontDialog1.Font.Color;
  MsgRecord.FontName := FontDialog1.Font.Name;
  MsgRecord.FontSize := FontDialog1.Font.Size;
  MsgRecord.FontStyle := FontDialog1.Font.Style;

  MsgRecord.Msg := Edit1.Text;

  stream2 := TStringStream.Create;

  fillstreamfrommsgrecord (Msgrecord, stream2);

  Stream2.Position := 0;

  IDTCPClient1.WriteStream (stream2, TRUE, TRUE, 0);

  stream2.Position := 0;

  showstream (stream2);

  stream2.Free;
end;

Mit

Delphi-Quellcode:

procedure FillStreamFromMsgRecord (MsgRecord: TMsgRecord; var Stream: TStream);
var
 Len: LongInt;
begin
  Stream.Write (MsgRecord.Command, SizeOf (MsgRecord.Command));
  Stream.Write (MsgRecord.SendBy, SizeOf (MsgRecord.SendBy));
  Stream.Write (MsgRecord.FontColor, SizeOf (MsgRecord.FontColor));

  Len := Length (MsgRecord.FontName);
  Stream.Write(Len, SizeOf (Len));
  Stream.Write (PChar (MsgRecord.FontName)^, Len);

  Stream.Write (MsgRecord.FontSize, SizeOf (MsgRecord.FontSize));
  Stream.Write (MsgRecord.FontStyle, SizeOf (MsgRecord.FontStyle));

  Len := Length (MsgRecord.Msg);
  Stream.Write(Len, SizeOf (Len));
  Stream.Write (PChar (MsgRecord.Msg)^, Len);
end;

Er verhält sich äuserst merkwürdig:
:arrow: Beim connect vom Client wird beim Server OnExecute ausgelöst, si bleibt bei dem ReadStream einfach stehen (hört auf. Reagiert noch, alles danach wird nicht mehr beachtet.)
:arrow: Beim Senden von Daten wird das vorherige Ereignis abgearbeitet (wiedereinstieg nach readstream mit korrekten daten) und das jetzt eingetretene bleibt wiederum bei readstream stehen.

Es wäre toll, wenn mir jemand ein Beispiel posten könnte,
in dem konkret ein vorhandener Stream mit den Indy-TCPs versendet wird.

[jfheins]

***PUSH***

[jfheins]

In den Logs (showstream macht immer einen Logeintrag) steht:

Server:

Zitat:

Incoming Connect
Reading ...
Done. Processing ...
Command: 3
SendBy: Julius
Message:


Done.
Reading ...
Done. Processing ...
Command: 3
SendBy: Julius
Message:
Hallo Welt

Done.
Reading ...

Client:

Zitat:

Connecting ...
Command: 3
SendBy: Julius
Message:


Command: 3
SendBy: Julius
Message:
Hallo Welt

Kann mir denn keiner Helfen ??? :cry:

[jfheins]

*PUSH-Button dringend brauche ...*

[skyware]

versuchs doch mal so...

clientseitig (FTCPConnection: TIdTCPClient)

Delphi-Quellcode:

    with FTCPConnection do
    begin
      //Daten an Server übermitteln
      xSendStream := TStringStream.Create(xDataString);
      try
        OpenWriteBuffer;
        try
          WriteStream(xSendStream, true, true);
        finally
          CloseWriteBuffer;
        end;
      finally
        xSendStream.Free;
      end;

      //Antwort von Server auslesen
      xReadStream := TStringStream.Create('');
      try
        xSize := ReadInteger;
        ReadStream(xReadStream, xSize, true);
        xReadStream.Seek(0, soFromBeginning);
        AReceiveVariant := xReadStream.DataString;
      finally
        xReadStream.Free;
      end;
    end;

serverseitig:

Delphi-Quellcode:

{ TMainFormTCP.OnTCPServerClientExecute:
-------------------------------------------------------------------------------}
procedure TMainFormTCP.OnTCPServerClientExecute(AThread: TIdPeerThread);
var
  xReadString   : Variant;
  xSendStream   : TStringStream;
  xStringStream : TStringStream;
  xSize         : integer;
begin
  with AThread.Connection do
  begin
    try
      //Antwort von Client auslesen
      xStringStream := TStringStream.Create('');
      try
        xSize := ReadInteger;
        ReadStream(xStringStream, xSize);
        xReadString := xStringStream.DataString;
      finally
        xStringStream.Free;
      end;

      if (xReadString <> '') then
      begin
        //etwas anstellen mit xReadString
        
        //Resultat an Client übermitteln
        xSendStream := TStringStream.Create(xReadString);
        try
          OpenWriteBuffer;
          try
            WriteStream(xSendStream, true, true);
          finally
            CloseWriteBuffer;
          end;
        finally
          xSendStream.Free;
        end;
      end;
    finally
      Disconnect;
    end;
  end;
end;

hoffe du kannst davon was gebrauchen?