Форум: "Начинающим";
Текущий архив: 2006.12.24;
Скачать: [xml.tar.bz2];
ВнизСтранное поведение TTcpServer Найти похожие ветки
← →
Это я (2006-12-08 09:35) [0]
procedure TForm1.tcServerAccept(Sender: TObject; ClientSocket: TCustomIpClient);
var Cmd, Tmp: ShortString; Buf: TTempData; DS: Extended;
begin
Log("Получен запрос на соединение от "+ClientSocket.RemoteHost+":"+ClientSocket.RemotePort);
ClientSocket.Sendln("+OK 200 Database daemon ready");
if not Auth(ClientSocket) then begin
ClientSocket.Sendln("-ERR Authetication failed");
Log("Попытка входа заблокирована: "+ClientSocket.RemoteHost);
ClientSocket.Disconnect;
Exit;
end else begin
ClientSocket.SendLn("+OK 200 Nice to meet you here!");
Log("Выполнен вход... ["+ClientSocket.RemoteHost+"]");
while Cmd<>"QUIT" do begin
Cmd := Trim(AnsiUpperCase(ClientSocket.ReceiveLn));
// -----------------------------------------------------------------------
if (Copy(Cmd, 1, 4)="STAT") then begin // COMMAND STAT
ClientSocket.Sendln(STAT(Cmd));
end;
// -----------------------------------------------------------------------
if (Copy(Cmd, 1, 4)="RETR") then begin // COMMAND RETR
Buf := RETR(Cmd); Ds := 0;
try
Ds := ClientSocket.SendBuf(Buf, SizeOf(Buf));
finally
ClientSocket.SendLn(iif(Ds>0, "+OK File transferred",
"-ERR File transfer error"));
end;
end;
// -----------------------------------------------------------------------
if (Copy(Cmd, 1, 3)="GET") then begin // COMMAND GET [NUM]
Tmp := Trim(Copy(Cmd, 5, Length(Cmd)));
Buf := GET(Tmp); Ds := 0;
try
Ds := ClientSocket.SendBuf(Buf, SizeOf(Buf));
finally
ClientSocket.SendLn(iif(Ds>0, "+OK File transferred",
"-ERR File transfer error"));
end;
end;
// -----------------------------------------------------------------------
if (Trim(cmd)<>"") then
Log(Clientsocket.RemoteHost+": "+cmd);
end;
ClientSocket.Sendln("+OK 200 Database daemon closing connection");
Log("Выполнен выход... ["+ClientSocket.RemoteHost+"]");
ClientSocket.Disconnect;
Exit;
end;
end;
После отправки команды RETR file.dat 0 955 он отдаёт данные и всё нормально
Стоит отправить любую команду во второй раз - вешает проц на 100% загрузку, хотя данные и отдаёт.
В чём может быть проблема?
← →
Сергей М. © (2006-12-08 10:02) [1]
> Это я
Вижу что ты)
А это я)
Сервер блокирующий ?
p.s.
Вопос следовало задать в "Сетях".
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2006.12.24;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.057 c