Почему потоки TIdTCPServer не отключаются?

← →
Aleksandr (2002-03-22 13:58) [0]

У меня две программы, одна из которых имеет компоненту TIdCTPClient, а другая - TIdTCPServer. Насколько я понимаю схему их работы, у сервера работа с получением/отсылкой инфы должна происходить в методе Execute(AThread : TIdPerThread). Назначил ее, и два метода - OnConnect и на OnDisconnect, в которых только происходит запись в лог, что кто-то приконнектился и отконнектился. Но через некоторое время работы программой-сервером у меня съедается все ЦПУ, а в логе идет информация только такая: Connected, Connected, Connected... То есть все время подключение происходит, а вот отключения - нет. В теле Execute все так:

procedure TRsWebServer.FOnExecute(AThread: TIdPeerThread);
//потомок TIdTCPServer
var
aFileName : string;
AuID : integer;
aFileSize : integer;
M : TDosMemoryStream;
s : string;
UType : TUpdateType;
begin
try
try
M:=TDosMemoryStream.Create;
AThread.FreeOnTerminate:=true;
AFileName:=AThread.Connection.Readln;
AThread.Connection.Writeln(rsFileName);
aFileSize:=StrToIntDef(AThread.Connection.ReadLn,-1);
AThread.Connection.Writeln(rsFileSize);
AThread.Connection.ReadStream(M,AFileSize);
M.Seek(0,soFromBeginning);
if M.Size>0 then begin
s:=ExtractFileName(AFileName);
s:=System.Copy(S,1,Pos(".",S)-1);
aUID:=StrToInt("$"+S);
AddLog(" Обработка "+AFileName);
with TDBUpdateProcessor.CreateOnStream(aUID,M) do begin
LogIDChar := "U";
FreeOnTerminate:=false;
UpdateType:=utWebUpdate;
WaitFor;
UType:=UpdateType;
Free
end;
if UType=utError then begin
AThread.Connection.Writeln(RSUpdError);
AddLog(AFileName+"

← →
Digitman (2002-03-22 14:39) [1]

Вот) не поленился я развернуть этот самый хваленый Indy.

Та-а-к , читаем хэлп на СОБЫТИЕ (не метид !!!) OnExecute :

OnExecute receives AThread as a parameter, representing the TIdPeerThread thread that will be started.

Заметь - только еще Будет стартован (аосле завершения обработки события), а не уже стартовал. Есть ведь разница ?

← →
Aleksandr (2002-03-22 14:45) [2]

Млин... нифига не понимаю... в их же демках все события происходят в методе Execute!

← →
Digitman (2002-03-22 14:50) [3]

да не метод это ! событие !

← →
Aleksandr (2002-03-22 15:02) [4]

Млин... а что же тогда метод %(...

← →
SerVS - S (2002-03-22 15:04) [5]

Попробуй это убрать это:
AThread.Connection.Disconnect;
AThread.Terminate с сервера, пусть разрыв происходит от клиента. Я не увидел у тебя ничего вроде M.Destroy, сейчас нет времени, если до понедельника потерпит то напишу как оно работает у меня, и пример кину.

← →
Digitman (2002-03-22 15:15) [6]

Это метод твоего собственного объекта TRsWebServer, вызов которого ты назначил в качестве реакции на событие TIdTCPServer.OnExecute. А в хэлпе к TIdTCPServer.OnExecute четко обозначено - в момент возбуждения этого события (читай : и вплоть до окончания процедуры его обработки, если таковая назначена тобой - а в кач-ве таковой ты назначил метод TRsWebServer.FOnExecute) транспортный поток соединения еще не стартовал, и ожидать, что он будет терминирован в этой процедуре вызовом AThread.Terminate - бессмысленно.

Это - раз.
А второе - и, пожалуй, более важное - где написано, что тело TIdPeerThread.Execute вообще реагирует на флаг Terminated ? Ткни меня, бестолкового, носом в документацию либо в исходник TIdPeerThread (исх-ков у меня, к сож., нет в дан.момент)

← →
Aleksandr (2002-03-22 15:28) [7]

2 SerVS - S:
Потерпит, буду очень признателен :(

2 Digitman:
Пример из Indy Demo:

type
TfrmMain = class(TForm)
IdTCPServer: TIdTCPServer;
btnStart: TButton;
btnExit: TButton;
procedure btnExitClick(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure IdTCPServerExecute(AThread: TIdPeerThread);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

{$R *.DFM}

procedure TfrmMain.btnExitClick(Sender: TObject);
begin
if IdTCPServer.active then IdTCPServer.active := false;
application.terminate;
end;

procedure TfrmMain.btnStartClick(Sender: TObject);
begin
IdTCPServer.active := not IdTCPServer.active;

if btnStart.caption = "Start" then btnStart.caption := "Stop"
else if btnStart.caption = "Stop" then btnStart.caption := "Start";

end;

procedure TfrmMain.IdTCPServerExecute(AThread: TIdPeerThread);
var
MyRec : MyRecord;
begin
AThread.connection.ReadBuffer(MyRec,SizeOf(MyRec));
AThread.connection.WriteBuffer(MyRec,SizeOf(MyRec),true);
end;

end.

← →
Digitman (2002-03-22 15:55) [8]

в общем так.

нашел я исходники, сориентировался, что там к чему.
вот что получается

1. Обработчик OnExecute выполняется в контексте клиентского транспортного потока. Терминировать его (логически, не физически) нужно (необходимо и достаточно) просто вызовом
AThread.Connection.Disconnect;

AThread.Terminate применять нельзя - это прерогатива менеджера тр.потоков, который кэширует их и сам решает, когда физ-ки терминировать тот или иной тр.поток.

2. Смотри код TDBUpdateProcessor.Execute - оч. и оч. вероятно, что и утечки и некорректное терминирование (его же) происходит именно там.

← →
Aleksandr (2002-03-22 16:15) [9]

Спасибо за разъяснение. Код DBUpdateProcessor.Execute:

procedure TDBUpdateProcessor.Execute;
var ...
procedure DoUpdates;
//подготовить таблицу
//запустить поток извлечения записей из стрима и их внесения в таблицу
//дождаться окончания
//стрим убивается по мере извлечения
end;
begin
Sleep(0);
if (FName = "") AND (FStream=nil) then
Exit;
try
try
if GetUserInfo(UserInfo.ID, UserInfo) then begin
IsATIFreeUser:=IsATIUser(UserInfo.ID) and (DaysInterval(UserInfo.LastDate, Date) > KillUserDDate);
ProcessUpdates
end
else
Log( lmError, "TDBUpdateProcessor.Execute:

← →
Digitman (2002-03-22 16:31) [10]

>>"А если и там, то что, WaitFor просто будет вешать Execute TIdTCPServer?"

Да. Но - это же проверяется элементарно ! Ты вот до сих пор не сказал. успешно ли WaitFor завершается

← →
Aleksandr (2002-03-22 16:59) [11]

Ой... А как это проверяется?

← →
Digitman (2002-03-22 17:47) [12]

элементарно. поставь на строчке
UType:=UpdateType;
брейкпойнт и запусти свой сервер в отладочном режиме.

если WaitFor успешно выполнится, на этой строчке рано или поздно произойдет останов

← →
SerVS - S (2002-03-23 12:40) [13]

Даже раньше чем обещал ;)
Ты пример из инди, приведенный тобой же, внимательно смотрел?
Они ничего не делают с поток кроме чтения/записи, никаких терминейтов и прочего.
Как это выглядит у меня:
procedure TDM.TCPServerExecute(AThread: TIdPeerThread);
var
RecvBuffer: string;
begin
RecvBuffer := AThread.Connection.CurrentReadBuffer;
if Length(RecvBuffer) > 0 then begin
ServerExecute(AThread, RecvBuffer);
end
end;
Где ServerExecute имеет вид:
procedure ServerExecute(AThread: TIdPeerThread; RecvBuffer: String);
var ...
begin
HeaderSize := SizeOf(StreamHeader);
OutBuffer := "";
if Length(RecvBuffer) >= HeaderSize then begin
StreamHeader := ReadHeader
end
else Exit;
case StreamHeader.Command of
HALLO: begin
...
end; // HALLO
AUTH: begin
...
end; // AUTH
...
SCR: begin
...
end; // SCR
end;
if OutBuffer <> "" then begin
AThread.Connection.WriteBuffer(OutBuffer[1],
Length(OutBuffer));
OutBuffer := "";
end;
end;
Отлично работает, проверял под вин98, вин2к
А дисконект должен исходить от клиента (я уже писал про это).

Почему потоки TIdTCPServer не отключаются? Найти похожие ветки