Einzelnen Beitrag anzeigen

jonny

Registriert seit: 15. Dez 2003
235 Beiträge
 
Delphi 7 Enterprise
 
#6

Re: Warum kann ich keine Form im Execute-Rutine des TCP Crea

  Alt 26. Jan 2004, 14:35
So hier ist die OnExecute:

Code:
procedure TfrmMain.TCPServerExecute(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, MSGSize: Cardinal;
  FileStream: TStream;
  MSGStream: TStream;
  I, Accept: Integer;
  User, DMIN, IP: String;
  Files: TStringList;
  Description, SizeOfFiles: String;
  GetMSG, GetFileRequest, GetAnswerOfFileRequest, GetURL: Boolean;
begin
  SessionID := LastSessionID;
  Inc(LastSessionID);

  GetMSG:=False;
  GetFileRequest:=False;
  GetAnswerOfFileRequest:=False;
  GetURL:=False;
  Accept:=0;

  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
               DMIN:=ReadString;
               User:=ReadString;
               IP:=ReadString;

               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;
          5: begin // MESSAGE
               DMIN:=ReadString;
               User:=ReadString;
               IP:=ReadString;

               MSGSize := ReadLong;
               try
                 MSGStream := TMemoryStream.Create;
                 try
                   AThread.Connection.ReadStream(MSGStream, MSGSize);
                 finally
                   GetMSG:=True;
                 end;
                 WriteByte(5);
               except
                 on E: Exception do
                 begin
                   WriteByte(3); // ERROR
                   WriteByte(1);
                   WriteString(E.Message);
                   Break;
                 end;
               end;
             end;
          6: begin // URL
               DMIN:=ReadString;
               User:=ReadString;
               IP:=ReadString;

               ReadString;
               ReadString;
               
               GetURL:=True;
               WriteByte(6);
             end;
          7: begin // ASK FOR UPLOAD
               DMIN:=ReadString;
               User:=ReadString;
               IP:=ReadString;

               try
                 Files:=TStringList.Create;
                 Files.Clear;
                 try
                   For I:=0 To ReadLong - 1 Do
                   begin
                     Files.Add(ReadString);
                   end;
                   Description:=ReadString;
                   SizeOfFiles:=ReadString;
                 finally
                   GetFileRequest:=True;
                 end;
                 WriteByte(7);
               except
                 on E: Exception do
                 begin
                   WriteByte(3); // ERROR
                   WriteByte(1);
                   WriteString(E.Message);
                   Break;
                 end;
               end;
             end;
          8: begin // ACCEPT OR DISACCEPT THE UPLOAD
               DMIN:=ReadString;
               User:=ReadString;
               IP:=ReadString;

               Accept:=ReadByte;

               WriteByte(8);

               GetAnswerOfFileRequest:=True;
             end;
          9: begin // STATUSCHECK
               DMIN:=ReadString;
               User:=ReadString;
               IP:=ReadString;

               WriteString(sStatus);

               WriteByte(9);
             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;

  If GetMSG Then
  begin
    ShowMessage(User, DMIN, IP, MSGStream);
    MSGStream.Free;
  end
  else If GetFileRequest Then
  begin
    GetFileFrom(User, IP, DMIN, Description, SizeOfFiles, Files);
    Files.Free;
  end
  else If GetAnswerOfFileRequest Then
  begin
    AcceptSendFile(User, DMIN, IP, Accept);
  end
  else If GetURL Then
  begin
    //
  end;

end;
  Mit Zitat antworten Zitat