Indy IdHttpServer - mache Threads beenden sich nicht- 98% CP

[DataCool]

Hi Leute,

ich konnte mein Problem selber lösen, trotzdem vielen Dank an alle die versucht haben zu helfen.

Ich habe das Problem mit der Holzhammer Methode gelöst

Ich haben meinem WebServer einen TIdThreadMgrPool hinzugefügt, das ist eine Komponente über die ich auf alle aktiven Threads zugreifen kann.

Jetzt habe ich mir zusätzlich folgende Klasse erzeugt :

Code:

   THttpThreadInfo = class
      private
         fCreateTime : TDateTime;
      protected
      public
         property CreateTime : TDateTime read fCreateTime write fCreateTime;
   end;

Diese Klasse dient dazu, jeden Thread mit einem Erzeugungs-Zeitstempel zu versehen.

Jetzt bin ich bei der Methode OnConnect des WebServers hingegangen :

Code:

procedure TfrmMain.IdHTTPSvrConnect(AThread: TIdPeerThread);
Var  ThdInf  : THttpThreadInfo;
begin
   ThdInf := THttpThreadInfo.Create;
   ThdInf.CreateTime := now;
   AThread.Data := ThdInf;
         // Eintrag in meinem Logfile erzeugen ; Level 2
   logf.log('OnConnect Thread: '+inttostr(AThread.ThreadID),2);
end;

Jetzt habe ich einen Timer erzeugt der jede Sekunde folgende macht :

Code:

procedure TfrmMain.Tim_ThreadsTimer(Sender: TObject);
var i : Longint;
      tmpList : TList;
      tmpThd  : TIdPeerThread;
      ThdInf  : THttpThreadInfo;
begin
   lb_Threads.items.BeginUpdate;
   lb_Threads.items.Clear;
   tmpList := IdThreadMgrDefHttp.ActiveThreads.LockList;
   try
      for i:= 0 to tmpList.Count - 1 do begin
         if tmpList[i] <> nil then begin
            tmpThd := TIdPeerThread(tmplist[i]);
            if tmpThd.Data <> Nil then begin
               try
                  ThdInf := THttpThreadInfo(tmpThd.Data);
                  // läuft der Thread schon lange als 4 Sek. ?
                  if ThdInf.CreateTime < (now - 4/24/60/60) then begin
                     logf.log('Thread: '+inttostr(tmpThd.ThreadID)+' ist im Nirvana...',1);
                     lb_Threads.items.Add('Thread Nr:'+inttostr(tmpThd.ThreadID)+'Status: Nirvana... auf Index: '+inttostr(i));
                     //IdThreadMgrDefHttp.ReleaseThread(tmpThd);
                     tmpThd.Connection.DisconnectSocket;
                     //Wichtig, hier nicht terminate aufrufen geht sonst nicht !!
                  end
                  else
                     lb_Threads.items.Add('Thread Nr:'+inttostr(tmpThd.ThreadID)+'Status: running auf Index: '+inttostr(i));
               except
                  logf.log('Konnte Thread-Info nicht auslesen',1);
                  //tmpThd.Terminate;
               end;
            end;
            //else
               //tmpThd.Terminate;
         end
         else
            lb_Threads.Items.Add('Nil Thread auf Index: '+inttostr(i));
      end;
   finally
      IdThreadMgrDefHttp.ActiveThreads.UnlockList;
      lb_Threads.items.EndUpdate;
   end;
end;

Durch die "Zwangstrennung" der Threads im "Nirvana" wird wieder das Ereignis OnDisconnect des WebServers ausgelöst :

Code:

procedure TfrmMain.IdHTTPSvrDisconnect(AThread: TIdPeerThread);
Var ThdInf  : THttpThreadInfo;
begin
   logf.log('OnDisconnect Thread: '+inttostr(AThread.ThreadID),2);
   if AThread.Data <> Nil then begin
      try
         ThdInf := THttpThreadInfo(AThread.Data);
      except
         ThdInf := Nil;
      end;
      if ThdInf <> Nil then begin
         ThdInf.free;
                           // !!! Wichtig, das Data-Objekt des Threads auf Nil setzen, sonst will der Thread den Speicher selber mit FreeAndNil freigeben, weil da ja noch ein Zeiger drin steht
         AThread.Data := nil;
      end;
   end;
end;

Im Kommentar habe ich ja schon erwähnt, das man das Data-Objekt unbedingt auf Nil setzen, muss damit der Thread den Speicher nicht versucht freizugeben.
Zuerst habe ich den Speicher meine ThreadInfo-Klasse nicht selber frei gegeben, weil ich dachte das das der Thread tut :

Code:

procedure TIdThread.Cleanup;
begin
  FreeAndNil(FData);
end;

Komischerweise habe ich dann ein "Memory-Leck" !!
Kamm mir jemand sagen warum ?

Gruß Data