Andrew Brunner escribió:
2009/3/20 Liyuán García Caballero <[email protected]>:
Check my Thread code:
procedure Tcheckonline.Execute;
begin
sock.HTTPTunnelTimeout := 10000;
query.FileName:=vpathdb;
query.SQL:='SELECT * FROM computer WHERE name='''+vhost+''';';
query.Open;
if query.FieldByName('proxy').Value then
begin
if query.FieldByName('proxy_type').AsString = 'HTTP' then
begin
sock.HTTPTunnelIP := query.FieldByName('proxy_host').AsString;
sock.HTTPTunnelPort := query.FieldByName('proxy_port').AsString;
sock.HTTPTunnelUser := query.FieldByName('proxy_user').AsString;
sock.HTTPTunnelPass := query.FieldByName('proxy_pass').AsString;
sock.Connect(query.FieldByName('ip').AsString+
':'+query.FieldByName('port').AsString,'0');
end;
end else
sock.Connect(query.FieldByName('ip').AsString,query.FieldByName('port').AsString);
sock.SendString('noop;' + #10);
if parse_proto('noop',sock.RecvPacket(500)) = 'ok' then
begin
vimg:=1;
Synchronize(@putstatus);
end else
begin
vimg:=0;
Synchronize(@putstatus);
end;
// Comments... You shouldn't terminate and free items here. Let
execute run its course... // The on destruction, the resources should
be reclaimed there.
// See Destructor below.
end;
procedure Tcheckonline.putstatus;
begin
fprincipal.tvnode.Items[fprincipal.tvnode.Items.FindNodeWithText(vhost).Index].SelectedIndex:=vimg;
fprincipal.tvnode.Items[fprincipal.tvnode.Items.FindNodeWithText(vhost).Index].ImageIndex:=vimg;
end;
function Tcheckonline.parse_proto(command, data: String): String;
var
str : String;
ini, fin : Integer;
begin
ini := Pos(command,data);
fin := Pos('=',data);
str := copy(data,ini,fin-ini);
if str = command then
Begin
ini := Pos('=',data)+1;
fin := Pos(';',data);
str := copy(data,ini,fin-ini);
Result := str;
end
end;
constructor Tcheckonline.create(CreateSuspended: Boolean; ahost, apathdb:
String);
begin
sock:= TTCPBlockSocket.Create;
query := TSqlite3Dataset.Create(nil);
vpathdb:=apathdb;
vhost := ahost;
FreeOnTerminate:=True;
inherited Create(CreateSuspended);
end;
destructor TCheckOnline.Destroy;
begin
sock.Free;
query.Free;
inherited Destroy;
end;
The same behavior, memory continues to grow
:-(
--
Firma
Lic. Liyuán García Caballero
Especialista
B en Ciencias Informáticas
Excelencia en Software
Desoft Ciego de Ávila.
Calle 2 y Joaquín de
Agüero. Ciego de Ávila. Cuba.
 [email protected]
[email protected]
 Ubuntu
Linux |
_______________________________________________
Lazarus mailing list
[email protected]
http://www.lazarus.freepascal.org/mailman/listinfo/lazarus
