TClientSocket в неблокирующем режиме

← →
vfb (2006-05-26 08:02) [0]

Доброе утро!

Третий день пытаюсь понять, где я неправ. Посмотрите, пожалуйста, направьте на путь истинный :)

Я сделал маленький класс - наследник TClientSocket, который использую для загрузки данных. Но почему-то после события onDisconnect приложение начинает требовать 70-90% процессорного времени, при этом откуда-то берутся два потока (понятно, что это потоки TClientSocket-а, но почему они не "убиваются" - непонятно).

Вот несколько упрощенный класс:

unit libTCP;

interface

uses
Classes, Windows, Messages, SysUtils, ScktComp, Forms, Dialogs, StdCtrls, Sockets, StrUtils;

Const
WM_SOCKS_CONNECTING = WM_USER+10;
WM_SOCKS_CONNECTED = WM_USER+11;
WM_SOCKS_DISCONNECTED = WM_USER+12;
WM_SOCKS_ERROR = WM_USER+13;
WM_SOCKS_SENDING = WM_USER+14;
WM_SOCKS_RECIEVING = WM_USER+15;

type
TSocksEvent = procedure (Sender: TObject) of object;
TSocksEvent2 = procedure (Sender: TObject; str: string) of object;

TSocks = class(TClientSocket)
private
FOnComplete: TSocksEvent;
FForString : TSocksEvent2;
encoded_request: string;
bytes_left_to_send: integer;
public
FCommand : string;
Answer : ^string;
MsgHandler : THandle;
LogLabel : TLabel;
MemoLog : TMemo;
property onComplete : TSocksEvent read FOnComplete write FOnComplete;
property onString : TSocksEvent2 read FForString write FForString;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Execute;
procedure _onRead(Sender: TObject; Socket: TCustomWinSocket);
procedure _onWrite(Sender: TObject; Socket: TCustomWinSocket);
procedure _onConnecting(Sender: TObject; Socket: TCustomWinSocket);
procedure _onConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure _onDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure _onError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent : TErrorEvent; var ErrorCode: Integer);
end;

implementation

destructor TSocks.Destroy;
Begin
inherited destroy;
end;

constructor TSocks.Create(AOwner: TComponent);
Begin
inherited Create(AOwner);
MsgHandler := 0;
Answer := nil;
FCommand := "";
self.ClientType := ctNonBlocking;
self.onConnecting := _onConnecting;
self.onConnect := _onConnect;
self.onDisconnect := _onDisconnect;
self.onRead := _onRead;
self.onWrite := _onWrite;
self.onError := _onError;
end;

procedure TSocks.Execute;
Begin
encoded_request:= FCommand;
bytes_left_to_send := length(encoded_request);

Self.Open;
repeat Application.ProcessMessages until Self.Active;
end;

procedure TSocks._OnWrite(Sender: TObject; Socket: TCustomWinSocket);
Var sb: integer;
Begin
if bytes_left_to_send > 0 then Begin
sb := Socket.SendText(RightStr(encoded_request, bytes_left_to_send));
bytes_left_to_send := bytes_left_to_send - sb;
end;
end;

procedure TSocks._onRead(Sender: TObject; Socket: TCustomWinSocket);
Var str : string;
npos : integer;
i : integer;
Begin
if MemoLog <> nil then MemoLog.Lines.Add("Recieved "+IntToStr(Socket.ReceiveLength)+" bytes");
if Socket.ReceiveLength > 0 then begin
str := Socket.ReceiveText;
//Decode answer using the private Fkey
Answer^ := Answer^ + str;
end;
end;

procedure TSocks._onConnecting(Sender: TObject; Socket: TCustomWinSocket);
Begin
if MsgHandler > 0 then PostMessage(MsgHandler, WM_SOCKS_CONNECTING, 0, 0);
if MemoLog <> nil then MemoLog.Lines.Add("Connecting...");
end;

procedure TSocks._onConnect(Sender: TObject; Socket: TCustomWinSocket);
Begin
if MsgHandler > 0 then PostMessage(MsgHandler, WM_SOCKS_CONNECTED, 0, 0);
if MemoLog <> nil then MemoLog.Lines.Add("Connected");
end;

procedure TSocks._onDisconnect(Sender: TObject; Socket: TCustomWinSocket);
Var str: string;
Begin
if Socket.ReceiveLength > 0 then begin
str := Socket.ReceiveText;
//
Answer^ := Answer^ + str;
if MemoLog <> nil then MemoLog.Lines.Add("Data recieved before disconnect");
end else
if MemoLog <> nil then MemoLog.Lines.Add("NO Data left before disconnect");

Self.Close;
if MsgHandler > 0 then PostMessage(MsgHandler, WM_SOCKS_DISCONNECTED, 0, 0);
if Assigned(FOnComplete) then FOnComplete(Sender);
end;

procedure TSocks._onError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent : TErrorEvent; var ErrorCode: Integer);
Begin
if MsgHandler > 0 then PostMessage(MsgHandler, WM_SOCKS_ERROR, 0, 0);
if Assigned(FOnComplete) then FOnComplete(Sender);
if MemoLog <> nil then MemoLog.Lines.Add("Error");
end;

end.

Всё это работает в DLL (в ней кроме этого класса - класс формы приложения + требуемый функционал). Но насколько я (не) понимаю, дело совсем даже не в DLL.

← →
Сергей М. © (2006-05-26 08:19) [1]

Убери self.Close

И вообще во всех методах своего класса убери self - ни к чему он

← →
vfb (2006-05-26 08:24) [2]

Убрал (а Close поставил вообще от безысходности).
Но конечно, это ничего не поменяло.
Я могу и вызов показать, но думаю что и так максимально понятно :)

← →
Сергей М. © (2006-05-26 08:40) [3]

> могу и вызов показать

Покажи...

← →
vfb (2006-05-26 13:21) [4]

Var tcp := TSocks;
server_answer: string;
...
begin
lvUsers.Items.Clear;
tcp.FCommand := "GET USERLIST";
tcp.Answer := @server_answer;
tcp.Host := "freebsd.domain";
tcp.Port := 7712;
tcp.onComplete := RequestComplete; // procedure TfrmUsers.RequestComplete(Sender: TObject);
tcp.onString := NewUserString; // procedure TfrmUsers.NewUserString(Sender: TObject; str: string);
tcp.MemoLog:=Memo1;
tcp.Tag := 0;
tcp.Execute;
end;

← →
vfb (2006-05-26 13:24) [5]

Да, к слову
tcp := TSocks.Create(nil) стоит в функции изициализации библиотеки (вместе с созданием формы), а

procedure TfrmUsers.RequestComplete(Sender: TObject);
Begin
can_close:=true;
// tm.Enabled:=false;
end;

Что показывает отладчик ?

← →
vfb (2006-05-26 18:13) [7]

На самом деле, он показывает, что Process is not accessible.
Вижу только Thread status - что три потока Runnable
И все три в ntdll.KiFastSystemCallRet

Правда, если честно, исторически сложилось, что я с gdb привык общаться. А тут для меня почти всё - темный лес.

> vfb (26.05.06 18:13) [7]

Про отладочные точки останова хоть что-нибудь слышал ?

TClientSocket в неблокирующем режиме Найти похожие ветки