In the test, the server
Five clients <1000 for each client> are opened for testing.
The memory is not much. The size of the data packet sent from the client is about 4096 + 88 bytes.
Test echo test thread
procedure TfrmMain.btnEchoTesterClick(Sender: TObject);var lvEchoTester:TEchoTester; i:Integer;begin for I := 1 to StrToInt(edtCount.Text) do begin lvEchoTester := TEchoTester.Create; lvEchoTester.TcpClient.Host := '127.0.0.1'; lvEchoTester.TcpClient.Port := StrToInt(edtPort.Text); lvEchoTester.Resume; FTesterList.Add(lvEchoTester); end;end;
Echotester thread
Unit identifier; interfaceuses classes, idtcpclient, sysutils, ujsonstreamobject, idglobal, superobject, windows; Type techotester = Class (tthread) Private attributes: identifier; function Createobject: tjsonstreamobject; Procedure echowork (pvobject: tjsonstreamobject); Public constructor create; destructor destroy; override; Procedure execute; override; property tcpclient: writable read ftcpclient; end; required comobj, role; constructor techotester. create; begin inherited create (true); ftcpclient: = tidtcpclient. create (NiL); end; destructor techotester. destroy; begin ftcpclient. free; inherited destroy; end; function techotester. createobject: tjsonstreamobject; var lvstream: tmemorystream; lvdata: string; begin result: = tjsonstreamobject. create; result. JSON: = So (); result. JSON. I ['cmdindex ']: = 1000; // echo data test result. JSON. s ['data']: = 'test sending and packaging data'; result. JSON. s ['key']: = createclassid; lvstream: = tmemorystream. create; setlength (lvdata, 1024*4); fillchar (lvdata [1], 1024*4, ord ('1'); lvstream. writebuffer (lvdata [1], length (lvdata); result. setstream (lvstream); end; Procedure techotester. echowork (pvobject: tjsonstreamobject); var lvstream, lvpackstream: tmemorystream; lvdata: string; lvbuffer: tidbytes; L, J, X: integer; begin lvpackstream: = tmemorystream. create; try tjsonstreamcoder. encode (pvobject, lvpackstream); setlength (lvbuffer, lvpackstream. size); lvpackstream. position: = 0; lvpackstream. readbuffer (lvbuffer [0], lvpackstream. size); ftcpclient. socket. write (lvbuffer); L: = ftcpclient. socket. readlongint (false); j: = ftcpclient. socket. readlongint (false); // JSON data setlength (lvbuffer, L); ftcpclient. socket. readbytes (lvbuffer, L, false); setlength (lvdata, L); zeromemory (@ lvdata [1], L); copymemory (@ lvdata [1], @ lvbuffer [0], L); pvobject. JSON: = So (lvdata); setlength (lvbuffer, J); ftcpclient. socket. readbytes (lvbuffer, J, false); pvobject. stream. size: = 0; pvobject. stream. write (lvbuffer [0], J); setlength (lvbuffer, pvobject. stream. size); pvobject. stream. position: = 0; pvobject. stream. readbuffer (lvbuffer [0], pvobject. stream. size); setlength (lvbuffer, 0); finally lvpackstream. free; end; {techotester} procedure techotester. execute; var lvjsonobject: tjsonstreamobject; begin ftcpclient. connect; lvjsonobject: = Createobject; try while (not self. terminated) Do begin try echowork (lvjsonobject); begin t end; ftcpclient. disconnect; finally lvjsonobject. free; end.
This optimized the code to solve the memory leakage problem. Fastmm is used. If there is no fastmm, comment it out.
This article should be the last one to take study notes.
Finally, upload the demo.
Delphi-iocp performance test