TSendData = procedure (Sender: TObject; BytesSent: Integer) of object;\r
\r
tlcomponent = class(tcomponent)\r
+ private
+ procedure releasetaskhandler(wparam,lparam:longint);
public\r
- released:boolean;\r
procedure release; virtual;\r
destructor destroy; override;\r
end;\r
onsenddata : tsenddata ;\r
ondatasent : tsocketevent ;\r
//connected : boolean ;\r
- nextasin : tlasio ;\r
- prevasin : tlasio ;\r
\r
recvq : tfifo;\r
OnBgException : TBgExceptionEvent ;\r
procedure exitmessageloop;\r
\r
var\r
- firstasin : tlasio ;\r
firsttimer : tltimer ;\r
firsttask , lasttask , currenttask : tltask ;\r
\r
inherited destroy;\r
end;\r
\r
-\r
+procedure tlcomponent.releasetaskhandler(wparam,lparam:longint);
+begin
+ free;
+end;
\r
\r
procedure tlcomponent.release;\r
begin\r
- released := true;\r
+ addtask(releasetaskhandler,self,0,0);
end;\r
\r
procedure tlasio.release;\r
state := wsclosed;\r
fdhandlein := -1;\r
fdhandleout := -1;\r
- nextasin := firstasin;\r
- prevasin := nil;\r
- if assigned(nextasin) then nextasin.prevasin := self;\r
- firstasin := self;\r
-\r
- released := false;\r
end;\r
\r
destructor tlasio.destroy;\r
begin\r
destroying := true;\r
if state <> wsclosed then close;\r
- if prevasin <> nil then begin\r
- prevasin.nextasin := nextasin;\r
- end else begin\r
- firstasin := nextasin;\r
- end;\r
- if nextasin <> nil then begin\r
- nextasin.prevasin := prevasin;\r
- end;\r
recvq.free;\r
sendq.free;\r
inherited destroy;\r
end;\r
interval := 1000;\r
enabled := true;\r
- released := false;\r
-\r
end;\r
\r
destructor tltimer.destroy;\r
\r
\r
begin\r
- firstasin := nil;\r
firsttask := nil;\r
\r
\r
end;\r
temptimer := currenttimer;\r
currenttimer := currenttimer.nexttimer;\r
- if temptimer.released then temptimer.free;\r
end;\r
end;\r
\r
end;\r
end;\r
\r
- if asinreleaseflag then begin\r
- asinreleaseflag := false;\r
- currentsocket := firstasin;\r
- while assigned(currentsocket) do begin\r
- tempsocket := currentsocket;\r
- currentsocket := currentsocket.nextasin;\r
- if tempsocket.released then begin\r
- tempsocket.free;\r
- end;\r
- end;\r
- end;\r
{\r
!!! issues:\r
- sockets which are released may not be freed because theyre never processed by the loop\r
repeat\r
\r
//the message loop will exit if all lasio's and ltimer's and lsignal's are destroyed\r
- if (not assigned(firstasin)) and (not assigned(firsttimer)) {$ifndef nosignal} and (not assigned(firstsignal)){$endif} then exit;\r
- {fd_zero(FDSR);\r
- fd_zero(FDSW);\r
- currentsocket := firstasin;\r
- if not assigned(currentsocket) then exit; //the message loop will exit if all lsockets are destroyed\r
-\r
- repeat\r
- if (not currentsocket.released) and (currentsocket.state<>wsclosed) then fd_set(currentsocket.fdhandlein,fdsr);\r
- if (not currentsocket.released) and (currentsocket.state=wsconnecting) then fd_set(currentsocket.fdhandleout,fdsw);\r
- if currentsocket is tlsocket then begin\r
- if (not currentsocket.released) and (currentsocket.state=wsconnected) and(tlsocket(currentsocket).sendq <> '') then fd_set(currentsocket.fdhandleout,fdsw);\r
- end;\r
- tempsocket := currentsocket;\r
- currentsocket := currentsocket.nextasin;\r
- if tempsocket.released then begin\r
- tempsocket.free;\r
- end;\r
- until not assigned(currentsocket);\r
- }\r
processtasks;\r
//currenttask := nil;\r
{beware}\r
procedure dnsrequestdone(sender:tobject;error : word);\r
procedure sessionclosed(sender:tobject;error : word);\r
end;\r
+ treleasetest=class(tlcomponent)
+ destructor destroy; override;
+ end;
var\r
listensocket : tlsocket;\r
serversocket : tlsocket;\r
procedure tsc.timehandler(sender:tobject);\r
begin\r
//writeln('got timer event');\r
-end;\r
+end;
+
+destructor treleasetest.destroy;
+begin
+ writeln('releasetest.destroy called');
+ inherited destroy;
+end;
+\r
procedure tsc.sessionclosed(sender:tobject;error : word);\r
begin\r
Writeln('session closed with error ',error);\r
ipbin : tbinip;\r
dummy : integer;\r
iplist : tbiniplist;\r
+ releasetest : treleasetest;
begin\r
lcoreinit;\r
+ releasetest := treleasetest.create(nil);
+ releasetest.release;
+
ipbin := forwardlookup('invalid.domain',5);\r
writeln(ipbintostr(ipbin));\r
\r