X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..85ef2ce64f0cc31a063fccea69fdcc7281d51548:/lcore.pas diff --git a/lcore.pas b/lcore.pas index 900bc96..da0fd66 100755 --- a/lcore.pas +++ b/lcore.pas @@ -35,7 +35,11 @@ interface const - receivebufsize=1460; + packetbasesize = 1460; + receivebufsize=packetbasesize*8; + + var + absoloutemaxs:integer=0; type {$ifdef ver1_0} @@ -96,6 +100,7 @@ interface onfdwrite : procedure (Sender: TObject; Error: word) of object; //added for bewarehttpd lasterror:integer; destroying:boolean; + recvbufsize:integer; function receivestr:string; virtual; procedure close; procedure abort; @@ -117,7 +122,7 @@ interface //procedure messageloop; function Receive(Buf:Pointer;BufSize:integer):integer; virtual; - procedure flush;virtual;{$ifdef win32} abstract;{$endif} + procedure flush;virtual; procedure dodatasent(wparam,lparam:longint); procedure doreceiveloop(wparam,lparam:longint); procedure sinkdata(sender:tobject;error:word); @@ -326,6 +331,7 @@ end; constructor tlasio.create; begin inherited create(AOwner); + if not assigned(eventcore) then raise exception.create('no event core'); sendq := tfifo.create; recvq := tfifo.create; state := wsclosed; @@ -351,8 +357,8 @@ begin if nextasin <> nil then begin nextasin.prevasin := prevasin; end; - recvq.destroy; - sendq.destroy; + recvq.free; + sendq.free; inherited destroy; end; @@ -392,7 +398,7 @@ end; procedure tlasio.internalclose(error:word); begin - if state<>wsclosed then begin + if (state<>wsclosed) and (state<>wsinvalidstate) then begin 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); @@ -419,7 +425,7 @@ begin if assigned(onsessionclosed) then if not destroying then onsessionclosed(self,error); end; - sendq.del(maxlongint); + if assigned(sendq) then sendq.del(maxlongint); end; @@ -485,7 +491,7 @@ var begin if state <> wsconnected then exit; - lensent := sendq.get(data,2920); + lensent := sendq.get(data,packetbasesize*2); if assigned(data) then result := myfdwrite(fdhandleout,data^,lensent) else result := 0; if result = -1 then lensent := 0 else lensent := result; @@ -548,6 +554,7 @@ procedure tlasio.handlefdtrigger(readtrigger,writetrigger:boolean); var sendflushresult : integer; tempbuf:array[0..receivebufsize-1] of byte; + a:integer; begin if (state=wsconnected) and writetrigger then begin //writeln('write trigger'); @@ -574,7 +581,9 @@ begin writtenthiscycle := false; if (state =wsconnected) and readtrigger then begin if recvq.size=0 then begin - numread := myfdread(fdhandlein,tempbuf,sizeof(tempbuf)); + a := recvbufsize; + if (a <= 0) or (a > sizeof(tempbuf)) then a := sizeof(tempbuf); + numread := myfdread(fdhandlein,tempbuf,a); if (numread=0) and (not mustrefreshfds) then begin {if i remember correctly numread=0 is caused by eof if this isn't dealt with then you get a cpu eating infinite loop @@ -609,19 +618,20 @@ begin end; end; -{$ifndef win32} - procedure tlasio.flush; - var - fds : fdset; - begin - fd_zero(fds); - fd_set(fdhandleout,fds); - while sendq.size>0 do begin - select(fdhandleout+1,nil,@fds,nil,nil); - if sendflush <= 0 then exit; - end; - end; +procedure tlasio.flush; +{$ifdef win32} +type fdset = tfdset; {$endif} +var + fds : fdset; +begin + fd_zero(fds); + fd_set(fdhandleout,fds); + while sendq.size>0 do begin + select(fdhandleout+1,nil,@fds,nil,nil); + if sendflush <= 0 then exit; + end; +end; procedure tlasio.dodatasent(wparam,lparam:longint); begin