X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/c04d5150e9097138a24534447acb8aec17acab19..e9fd84c2a9f04b8d9c1bc79d70c33c8d22d85e26:/lcore.pas?ds=sidebyside diff --git a/lcore.pas b/lcore.pas index 99e6339..1a2f93c 100755 --- a/lcore.pas +++ b/lcore.pas @@ -26,11 +26,11 @@ interface {$ifdef VER1_0} linux, {$else} - baseunix,unix,unixutil, + baseunix,unix,unixutil,sockets, {$endif} fd_utils, {$endif} - classes,pgtypes,bfifo; + classes,pgtypes,bfifo,ltimevalstuff; procedure processtasks; @@ -73,8 +73,9 @@ interface TSendData = procedure (Sender: TObject; BytesSent: Integer) of object; tlcomponent = class(tcomponent) + private + procedure releasetaskhandler(wparam,lparam:longint); public - released:boolean; procedure release; virtual; destructor destroy; override; end; @@ -94,8 +95,6 @@ interface onsenddata : tsenddata ; ondatasent : tsocketevent ; //connected : boolean ; - nextasin : tlasio ; - prevasin : tlasio ; recvq : tfifo; OnBgException : TBgExceptionEvent ; @@ -107,7 +106,7 @@ interface lasterror:integer; destroying:boolean; recvbufsize:integer; - function receivestr:string; virtual; + function receivestr:tbufferstring; virtual; procedure close; procedure abort; procedure internalclose(error:word); virtual; @@ -120,8 +119,8 @@ interface procedure dup(invalue:longint); function sendflush : integer; - procedure sendstr(const str : string);virtual; - procedure putstringinsendbuffer(const newstring : string); + procedure sendstr(const str : tbufferstring);virtual; + procedure putstringinsendbuffer(const newstring : tbufferstring); function send(data:pointer;len:integer):integer;virtual; procedure putdatainsendbuffer(data:pointer;len:integer); virtual; procedure deletebuffereddata; @@ -155,12 +154,6 @@ interface var timerwrapperinterface : ttimerwrapperinterface; type - {$ifdef win32} - ttimeval = record - tv_sec : longint; - tv_usec : longint; - end; - {$endif} tltimer=class(tlcomponent) protected @@ -227,7 +220,6 @@ procedure messageloop; procedure exitmessageloop; var - firstasin : tlasio ; firsttimer : tltimer ; firsttask , lasttask , currenttask : tltask ; @@ -262,35 +254,39 @@ implementation {$ifndef win32} {$include unixstuff.inc} {$endif} -{$include ltimevalstuff.inc} {!!! added sleep call -beware} procedure sleep(i:integer); +{$ifdef win32} +begin + windows.sleep(i); +{$else} var tv:ttimeval; begin - {$ifdef win32} - windows.sleep(i); - {$else} - tv.tv_sec := i div 1000; - tv.tv_usec := (i mod 1000) * 1000; - select(0,nil,nil,nil,@tv); - {$endif} + tv.tv_sec := i div 1000; + tv.tv_usec := (i mod 1000) * 1000; + select(0,nil,nil,nil,@tv); +{$endif} end; + destructor tlcomponent.destroy; begin disconnecttasks(self); inherited destroy; end; - +procedure tlcomponent.releasetaskhandler(wparam,lparam:longint); +begin + free; +end; procedure tlcomponent.release; begin - released := true; + addtask(releasetaskhandler,self,0,0); end; procedure tlasio.release; @@ -343,26 +339,12 @@ begin state := wsclosed; fdhandlein := -1; fdhandleout := -1; - nextasin := firstasin; - prevasin := nil; - if assigned(nextasin) then nextasin.prevasin := self; - firstasin := self; - - released := false; end; destructor tlasio.destroy; begin destroying := true; if state <> wsclosed then close; - if prevasin <> nil then begin - prevasin.nextasin := nextasin; - end else begin - firstasin := nextasin; - end; - if nextasin <> nil then begin - nextasin.prevasin := prevasin; - end; recvq.free; sendq.free; inherited destroy; @@ -405,6 +387,9 @@ end; procedure tlasio.internalclose(error:word); begin if (state<>wsclosed) and (state<>wsinvalidstate) then begin + // -2 is a special indication that we should just exist silently + // (used for connect failure handling when socket creation fails) + if (fdhandlein = -2) and (fdhandleout = -2) then exit; if (fdhandlein < 0) or (fdhandleout < 0) then raise exception.create('internalclose called with invalid fd handles'); eventcore.rmasterclr(fdhandlein);//fd_clr(fdhandlein,fdsrmaster); eventcore.wmasterclr(fdhandleout);//fd_clr(fdhandleout,fdswmaster); @@ -459,13 +444,13 @@ begin end; end; -procedure tlasio.sendstr(const str : string); +procedure tlasio.sendstr(const str : tbufferstring); begin putstringinsendbuffer(str); sendflush; end; -procedure tlasio.putstringinsendbuffer(const newstring : string); +procedure tlasio.putstringinsendbuffer(const newstring : tbufferstring); begin if newstring <> '' then putdatainsendbuffer(@newstring[1],length(newstring)); end; @@ -495,7 +480,10 @@ var // fdstestr : fdset; // fdstestw : fdset; begin - if state <> wsconnected then exit; + if state <> wsconnected then begin + result := -1; + exit; + end; lensent := sendq.get(data,packetbasesize*2); if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0; @@ -573,7 +561,16 @@ begin internalclose(0); end else begin - internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif}); + {$ifdef win32} + if getlasterror=WSAEWOULDBLOCK then begin + //the asynchronous nature of windows messages means we sometimes + //get here with the buffer full + //so do nothing in that case + end else + {$endif} + begin + internalclose({$ifdef win32}getlasterror{$else}linuxerror{$endif}); + end end; end; @@ -740,8 +737,6 @@ begin end; interval := 1000; enabled := true; - released := false; - end; destructor tltimer.destroy; @@ -892,7 +887,6 @@ end; begin - firstasin := nil; firsttask := nil;