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;