Indy-TCP-Server aufsetzen und Dateien versenden

[CalganX]

Hagen hat hier eine sehr schöne Anleitung gepostet, wie man mit den Indy-Komponenten einen TCP-Server aufsetzt und diesen dann zum Versenden von Dateien über das Netzwerk verwendet:


Zuerst bauen wir den Server und erklären dabei das benutzte Protokoll.
Als erstes definieren wir was als wichtigstes und erstes in das projekt integeriert werden soll. Wir beschränken uns erstmal auf das Notwendigste, also keine Progressbar und nur Upload von Dateien vom Clienten aus den Server.

Erzeuge neues Project und nenne es Server. Auf's Hauptformular bringste einen INDY TCP/IP Server drauf. Bei diesem stellste folgendes ein:

Delphi-Quellcode:

.Bindings := 0.0.0.0:7000;
.DefaultPort := 7000;
.ReuseSockects := rsTrue;
.Active := True;

Zusätzlich ein TMemo mit Namen Memo1 und folgenden Eigenschaften:

Delphi-Quellcode:

.Font := 'Courier New';
.Align := alClient;
.Lines := '';
.WordWrap := False;
.Scrollbars := ssBoth;

Nun im OI in das Ereigniss .OnExecute ein Doppelklick. Wir landen im Sourceeditor und coden NUR diese eine Execute Methode, denn mehr benötigen wir erstmal garnicht.

Damit klarer wird was wir möchten definieren wir aber erstmal unser Protokoll.
Jede Kommunikation beginnt mit einem Kommando-Byte, somit stehen uns maximal 256 verschiedene Kommandos zur Verfügung. Per Definition legen wir folgende Kommandos fest:

0 = NULL, heist keine Aktion und dient als Dummy Message um eventuell connections am leben zu erhalten
1 = LOGIN, der Client sendet dieses Kommando IMMER als erstes, über dieses Kommando identifiziert sich ein Client und die Clientsoftware. Ein Server antwortet NUR auf eine solches korrektes Client Login. D.h. dieses Kommando MUSS das erste sein was der Server empfängt. Falls dies nicht der Fall ist trennt der Server sofort die Conection.
3 = ERROR, Fehlerpacket
4 = LOGOUT, der Client trennt die verbindung
5 = UPLOAD, der Client sendet eine Datei, direkt nach dem Kommando-Byte folgen der dateiheader und die eigentliche Datei

Der Server hat auf jedes Kommando mit einem Echo-Kommando zu bestätigen. D.h. wenn der Client das Kommando=1=LOGIN sendet antwortet der Server ebenfalls mit Kommando=1=LOGIN bei Erfolg oder er antwortet mit Kommand=3=ERROR und trennt die Verbindung.

Genauer werden wir erstmal das Protokoll nicht beschreiben, die Sourcen sollten es erklären. Nun der Code in OnExecute() sollte so aussehen:

Delphi-Quellcode:

var
  LastSessionID: Integer = 1;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  SessionID: Integer;

  procedure DoLog(const Msg: String);
  var
    S: String;
    I: Integer;
  begin
    S := Format('%s-%0.6d: %s', [FormatDateTime('YYMMDD HHNNSS ZZZ', Now), SessionID, Msg]);
    for I := 1 to Length(S) do
      if S[I] in [#10,#13] then S[I] := ' ';
  // da Memo1.Lines.Add() intern über SendMessage() arbeitet sollte dies Threadsafe sein.
    Memo1.Lines.Add(S);
  end;

  function ReadByte: Byte;
  begin
    AThread.Connection.ReadBuffer(Result, SizeOf(Result));
  end;

  function ReadLong: Cardinal;

    function SwapLong(Value: Cardinal): Cardinal;
    // konvertiert Big Endian zu Little Endian
    // im INet ist es üblich ALLE Daten in Big Endian zu übertragen
    asm
      BSWAP EAX
    end;

  begin
    AThread.Connection.ReadBuffer(Result, SizeOf(Result));
    Result := SwapLong(Result);
  end;

  function ReadString: String;
  begin
    SetLength(Result, ReadByte);
    AThread.Connection.ReadBuffer(Result[1], Length(Result));
  end;

  procedure WriteByte(Value: Byte);
  begin
    AThread.Connection.WriteBuffer(Value, SizeOf(Value));
  end;

  procedure WriteString(const Value: ShortString);
  begin
    WriteByte(Length(Value));
    AThread.Connection.WriteBuffer(Value[1], Length(Value));
  end;

var
  FileName: String;
  FileSize: Cardinal;
  FileStream: TStream;
begin
  SessionID := LastSessionID;
  Inc(LastSessionID);

  try
    DoLog(Format('Client connect at IP ', [AThread.Connection.Socket.Binding.PeerIP]));
    if (ReadByte = 1) and (ReadString = 'MyUpload 1.0') then // LOGIN
    begin
// Client hat sich korrekt identifiziert sende Bestätigung und warte auf Kommandos
      WriteByte(1);
      while True do
        case ReadByte of
          0: begin // NULL
               WriteByte(0);
             end;
          2: begin // LOGOUT
               DoLog('Client logout');
               Break;
             end;
          3: begin // ERROR
               DoLog(Format('Client error %d, %s', [ReadByte, ReadString]));
               Break;      // Fehler fürht IMMER zum Abbau der Verbindung
             end;
          4: begin  // UPLOAD
               FileName := ExtractFilePath(ParamStr(0)) + 'Upload\' + ReadString;
               FileSize := ReadLong;
               DoLog(Format('Client upload %5d, %s', [FileSize, FileName]));
               try
                 FileStream := TFileStream.Create(FileName, fmCreate);
                 try
                   AThread.Connection.ReadStream(FileStream, FileSize);
                 finally
                   FileStream.Free;
                 end;
                 WriteByte(4);
               except
                 on E: Exception do
                 begin
                   WriteByte(3);  // ERROR
                   WriteByte(1);
                   WriteString(E.Message);
                   Break;
                 end;
               end;
             end;
        else
          begin // Invalid Code;
            DoLog('Client sends unknown command, terminate');
            WriteByte(3);
            WriteByte(0); // Errorcode
            WriteString('unknown kommand');
            Sleep(1);
            Break;
          end;
        end;
    end; // falsches/fehlendens Client-Login, trenne einfach die Verbindung, Server ist im Stealth mode
  finally
    DoLog('Client terminated');
    try
      Sleep(1);
      AThread.Connection.Disconnect;
    except
    end;
  end;
end;

Fertig ist der Server. Er sollte KEINERLEI Progressbars besitzen, da Server normalerweise unsichtbar im Hintergund laufen sollten.


Nun ein zweites neues Projekt für den Clienten erzeugen. Auf das Formular ein TidTCPClient mit Namen 'TCP' daruf und Eigenschaften:

Delphi-Quellcode:

.Host := 'localhost';
.Port := 7000;
.ReadTimeout := 5000;

Zusätzlich noch einen TButton, TLabel, TProgressbar und TOpenDialog drauf.
Im OnClick von Button1 steht dann folgendes:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);

  procedure WriteByte(Value: Byte);
  begin
    TCP.WriteBuffer(Value, SizeOf(Value));
  end;

  procedure WriteLong(Value: Cardinal);

    function SwapLong(Value: Cardinal): Cardinal;
    asm
       BSWAP EAX
    end;

  begin
    Value := SwapLong(Value);
    TCP.WriteBuffer(Value, SizeOf(Value));
  end;

  procedure WriteString(const Value: String);
  begin
    WriteByte(Length(Value));
    TCP.WriteBuffer(Value[1], Length(Value));
  end;

  function ReadByte: Byte;
  begin
    TCP.ReadBuffer(Result, SizeOf(Result));
  end;

  function ReadString: String;
  begin
    SetLength(Result, ReadByte);
    TCP.ReadBuffer(Result[1], Length(Result));
  end;

var
  I: Integer;
  SendSize,FileSize: Integer;
  FileName: String;
  FileStream: TStream;
begin
  if OpenDialog1.InitialDir = '' then
    OpenDialog1.InitialDir := ExtractFilePath(ParamStr(0));
  if OpenDialog1.Execute then
  try
    try
      TCP.Connect;
      WriteByte(1);
      WriteString('MyUpload 1.0');
      case ReadByte of
        1: begin
             for I := 0 to OpenDialog1.Files.Count -1 do
             try
               FileName := OpenDialog1.Files[I];
               FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
               try
                 FileSize := FileStream.Size;

                 WriteByte(4);
                 WriteString(ExtractFileName(FileName));
                 WriteLong(FileSize);

                 Label1.Caption := Format('sende %s', [Filename]);
                 Label1.Update;
                 ProgressBar1.Min := 0;
                 ProgressBar1.Max := FileSize;
                 ProgressBar1.Position := 0;

                 while FileSize > 0 do
                 begin
                   SendSize := FileSize;
                   if SendSize > 1024 then SendSize := 1024;
                   Dec(FileSize, SendSize);
                   TCP.WriteStream(FileStream, False, False, SendSize);
                   ProgressBar1.Position := ProgressBar1.Position + SendSize;
                 end;
               finally
                 FileStream.Free;
               end;
               case ReadByte of
                 3: begin // fehler
                      ShowMessage(Format('Fehler %5d, %s', [ReadByte, ReadString]));
                      Break;
                    end;
                 4: ; // alles Ok
               end;
             except
               on E: Exception do
                 ShowMessage(E.Message);
             end;
             WriteByte(2);
           end;
        3: begin
             ShowMessage(Format('Error %d, %s', [ReadByte, ReadString]));
           end;
      else
        ShowMessage('Invalid Responsecode');     
      end;
    finally
      TCP.Disconnect;
    end;
  except
    on E: Exception do
      ShowMessage(E.Message);
  end;
end;

[totti14]

Zitat von RWarnecke:

Hallo,

mit der Antwort komme ich leider nicht weiter. Ich finde nicht das passende ReadStream oder WriteStream von Indy 9 für Indy 10. Ich stochere da irgendwie im Nebel rum. Kann mir jemand es bitte erklären, was ich zu tun habe ?

Hi,
AThread ist jetzt AContext.

Code:

procedure TFrm.SrvExecute(AContext: TIdContext);
Var
  buf : TIdBytes;
begin
  // Prüfen ob Daten für die Verbindung vorhanden sind, dabei wird Status der Verbindung ebenfalls überprüft
  // AContext.Connection.IOHandler.CheckForDataOnSource(20);
  // Wenn keine Daten vorhanden dann raus hier
  if AContext.Connection.IOHandler.InputBufferIsEmpty then
    begin   
      SleepEx(1, true);
      Exit;
    end;
  // sonst Daten verarbeiten
  with AContext.Connection.IOHandler do
  begin
    InputBuffer.ExtractToBytes(buffer, len, false);
    Write(buf,len);
    usw... 
  end;

end;

Gruß
miparo

[bernhard_LA]

INDY 10 TCP Server DEMO auf source forge verfügbar

[ByTheTime]

Ist das ganze noch aktuell?