multithreading - Delphi threads hanging after many executions -


i have 1 multi-thread application needs post data via idhttp, http hosts... number of hosts varies , put them inside 1 txt file read tstringlist. it's around 5k hosts daily. ok, after 3 days running, more or less, , around 15k hosts checked, threads start hanging @ point of code, , program becomes slow, start checking 1 host per 10 minutes... goes far, , stay 1 week running nicely, after same problem: looks of threads start hanging... don't know problem, because run 100 threads, , said, after 15k or more hosts start becoming slow...

here's entire source code (sorry posting entire, think it's better more less)

type   mythread = class(tthread)   strict private     url, formpostdata1, formpostdata2: string;     idata1, idata2: integer;     procedure terminateproc(sender: tobject);     procedure addposted;     procedure addstatus;     function pickadata: bool;     function checkhost: bool;     function dopostdata(const formpostdata1: string; const formpostdata2: string): bool;   protected     constructor create(const hostline: string);     procedure execute; override;   end;  var   form1: tform1;   hostsfile, data1, data2: tstringlist;   ihost, ithreads, ipanels: integer;   mycritical: tcriticalsection;  implementation  function mythread.checkhost: bool; var   http: tidhttp;   code: string; begin   result:= false;   http:= tidhttp.create(nil);   http.iohandler:= tidssliohandlersocketopenssl.create(http);   http.request.useragent:= 'mozilla/5.0 (compatible, msie 11, windows nt 6.3; trident/7.0; rv:11.0) gecko';   http.handleredirects:= true;   try     try       code:= http.get(url);       if(pos('t2serversform', code) <> 0)         result:= true;     except       result:= false;     end;       http.free;   end; end;  function mythread.pickadata: bool; begin   result:= false;   if (idata2 = data2.count)     begin       inc(idata1);       idata2:= 0;     end;   if idata1 < data1.count     begin       if idata2 < data2.count         begin           formpostdata2:= data2.strings[idata2];           inc(idata2);         end;       formpostdata1:= data1.strings[idata1];       result:= true;     end; end;  function mythread.dopostdata(const formpostdata1: string; const formpostdata2: string): bool; var   http: tidhttp;   params: tstringlist;   response: string; begin   result:= false;   http:= tidhttp.create(nil);   http.request.useragent := 'mozilla/5.0 (compatible, msie 11, windows nt 6.3; trident/7.0; rv:11.0) gecko';   http.request.contenttype := 'application/x-www-form-urlencoded';   params:= tstringlist.create;   try     params.add('logintype=explicit');     params.add('medium='+formpostdata1);     params.add('high='+formpostdata2);     try       response:= http.post(copy(url, 1, pos('?', url) - 1), params);       if http.responsecode = 200         result:= true;     except       if (http.responsecode = 302)         begin           if(pos('invalid', http.response.rawheaders.values['location']) = 0)             result:= true;         end       else         result:= true;     end;       http.free;     params.free;   end; end;  procedure mythread.addposted; begin   form1.memo1.lines.add('posted: ' + url + ':' + formpostdata1 + ':' + formpostdata2) end;  procedure mythread.addstatus; begin   inc(ipanels);   form1.statusbar1.panels[1].text:= 'hosts panels: ' + inttostr(ipanels); end;  procedure maincontrol; var   hostline: string; begin   try     mycritical.acquire;     dec(ithreads);     while(ihost <= hostsfile.count - 1) , (ithreads < 100)     begin       hostline:= hostsfile.strings[ihost];       inc(ithreads);       inc(ihost);       mythread.create(hostline);     end;     form1.statusbar1.panels[0].text:= 'hosts checked: ' + inttostr(ihost);     if(ihost = hostsfile.count - 1)     begin       form1.memo1.lines.add(#13#10'--------------------------------------------');       form1.memo1.lines.add('finished!!');     end;       mycritical.release;   end; end;  {$r *.dfm}  constructor mythread.create(const hostline: string); begin   inherited create(false);   onterminate:= terminateproc;   url:= 'http://' + hostline + '/servlan/controller.php?action=wait_for';   idata2:= 0;   idata1:= 0; end;  procedure mythread.execute; begin   if(checkhost = true)   begin     synchronize(addstatus);     while not terminated , pickadata     begin       try         if(dopostdata(formpostdata1, formpostdata2)  = true)           begin             idata1:= data1.count;             synchronize(addposted);           end;       except         terminate;       end;     end;     terminate;   end; end;  procedure mythread.terminateproc(sender: tobject); begin   maincontrol; end;  procedure tform1.formcreate(sender: tobject); begin   if (fileexists('data2.txt') = false) or (fileexists('data1.txt') = false)     begin       button1.enabled:= false;       memo1.lines.add('data2.txt / data1.txt not found!!');     end; end;  procedure tform1.button1click(sender: tobject); var   opendialog : topendialog; begin   try     hostsfile:= tstringlist.create;     opendialog := topendialog.create(nil);     opendialog.initialdir := getcurrentdir;     opendialog.options := [offilemustexist];     opendialog.filter := 'text file|*.txt';     if opendialog.execute     begin      hostsfile.loadfromfile(opendialog.filename);      button2.enabled:= true;      button1.enabled:= false;     end;       opendialog.free;   end; end;  procedure tform1.button2click(sender: tobject); begin   button2.enabled:= false;   data1:= tstringlist.create;   data1.loadfromfile('data1.txt');   data2:= tstringlist.create;   data2.loadfromfile('data2.txt');   mycritical:= tcriticalsection.create;   ihost:= 0;   ithreads:= 0;   maincontrol; end; 

imo, thread getting trapped inside mythread.execute while loop. there no guarantee once inside loop exit (because dopostdata() method depends on external response). way, bet that, 1 one, each thread getting stuck in there until few (or none) remain working.

you should add log capabilities mythread.execute() sure not dying somewhere... can add fail safe exit condition there (e.g. if (triescount > 1 zillion times) exit).

also, consider better design keep threads running time , provide new work them, instead of creating/destroying threads, i.e. create 100 threads in beginning , destroy them @ end of program execution. requires significant changes code.


Comments