Potrzebna pomoc przy szukaniu memleaka

0

Witam

Potrzebuję pomocy w znalezieniu memleaka oraz powodu dlaczego watki nie zawsze się zamykają (nie wykluczam, że jedno może mieć ścisły związek z drugim).
Programik pisany na szybko - pozwala ściągać tapety na HTC HD2 z serwisu zedge.
Dodałem do niego wątki tylko dlatego, że ze stron na zedge nie da się wyciągnąć pełnej nazwy pliku - ostatnie 3 cyfry z nazwy trzeba "sprawdzic" metodą prób i błędów. A bez wątków ta operacja trwała wieki (~100 tapet przez noc).

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, StdCtrls, Gauges, StrUtils,
  IdAntiFreezeBase, IdAntiFreeze;

type
  rekordTapety = record
    id : cardinal;
    link : string; //jesli plik nie pobrany to jest to link do miniatury, jesli pobrany to link prowadzi bezposrednio do tapety
    sciagniete : boolean;
  end;
  TForm1 = class(TForm)
    postepOgolny: TGauge;
    postepHttp: TGauge;
    przyciskZamknij: TButton;
    przyciskPobierz: TButton;
    IdAntiFreeze1: TIdAntiFreeze;
    procedure odczytajPlikDanych;
    procedure zapiszPlikDanych;
    procedure przyciskZamknijClick(Sender: TObject);
    procedure przyciskZatrzymajClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure przyciskPobierzClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  watekPobieraniaTapet = Class(TThread)
  private
    httpWorkCount : int64; //zmienna wykorzystywana do synchronizacji z watkiem glownym
    procedure httpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure httpWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    procedure httpWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  protected
    procedure Execute; override;
    procedure SYNC_httpWork;
    procedure SYNC_httpWorkBegin;
    procedure SYNC_httpWorkEnd;
  public
    numerWatku : integer;
    liczbaProbPobraniaTapety : integer;
    linkDoTapety : string;
    tenWatekSciagaTapete : integer; //stan sciagania tapety: 0 - nie sciagana; 1 - sciagana; 2 - sciagnieta
    watekZawieszony : boolean; //zmienna uzywana tylko do wielokrotnego wykorzystywania watkow
  End;

const
  LICZBA_WATKOW_POBIERANIA_TAPET = 50; //1000 podzielone przez ta liczbe MUSI dac wynik bez reszty
  PRIORYTET_WATKOW = tpHigher;
  TYTUL_GLOWNEGO_OKNA = 'Zedge HTC HD2 Wallpapers Downloader by Szafran';

var
  Form1: TForm1;
  sciezkaProgramu : string;
  sciezkaPlikuDanych : string;
  tapety : array of rekordTapety;
  zatrzymajPrace : boolean; //zmienna sygnalizujaca nacisniecie przycisku zatrzymaj przez uzytkownika
  liczbaProbPobraniaTapety : integer; //watki beda dodawac po 1 przy kazdym przejsciu

implementation

{$R *.dfm}

procedure TForm1.odczytajPlikDanych;
var
  mS : TMemoryStream;
  i : integer;
  dlugosc : dword;

begin
  if FileExists(sciezkaPlikuDanych) then
    begin
      mS := TMemoryStream.Create;
      mS.LoadFromFile(sciezkaPlikuDanych);
      mS.Seek(0, soFromBeginning);
      mS.Read(i, sizeof(integer));
      SetLength(tapety, i);
      for i := 0 to Length(tapety) - 1 do
        begin
          mS.Read(tapety[i].id, sizeof(cardinal));
          mS.Read(dlugosc, sizeof(dword));
          SetLength(tapety[i].link, dlugosc);
          mS.Read(tapety[i].link[1], dlugosc * sizeof(char));
          mS.Read(tapety[i].sciagniete, sizeof(boolean));
        end;
      FreeAndNil(mS);
    end;
end;

procedure TForm1.zapiszPlikDanych;
var
  i : integer;
  mS : TMemoryStream;
  dlugosc : dword;

begin
  mS := TMemoryStream.Create;
  i := Length(tapety);
  mS.Write(i, sizeof(integer));
  for i := 0 to Length(tapety) - 1 do
    begin
      mS.Write(tapety[i].id, sizeof(cardinal));
      dlugosc := Length(tapety[i].link);
      mS.Write(dlugosc, sizeof(dword));
      mS.Write(tapety[i].link[1], dlugosc * sizeof(char));
      mS.Write(tapety[i].sciagniete, sizeof(boolean));
    end;
  mS.SaveToFile(sciezkaPlikuDanych);
  FreeAndNil(mS);
end;

procedure TForm1.FormShow(Sender: TObject);
var
  tmp : string;
  AppSysMenu: THandle;

begin
  //wylaczanie mozliwosci zamkniecia okna przez X
  AppSysMenu := GetSystemMenu(Handle, False);
  EnableMenuItem(AppSysMenu, SC_CLOSE, MF_BYCOMMAND or MF_DISABLED);

  //inicjalizacja
  przyciskPobierz.SetFocus;
  sciezkaProgramu := ExtractFilePath(Application.ExeName);
  SetLength(tapety, 0);
  Form1.Caption := TYTUL_GLOWNEGO_OKNA;

  //odczyt pliku z danymi
  tmp := Copy(ExtractFileName(Application.ExeName), 1, Pos('.' , ExtractFileName(Application.ExeName)) - 1);
  sciezkaPlikuDanych := sciezkaProgramu + tmp + '.dat';
  odczytajPlikDanych;
end;

procedure TForm1.przyciskZamknijClick(Sender: TObject);
var
  tmp : string;

begin
  //zmiana nazwy starego pliku z danymi
  tmp := Copy(sciezkaPlikuDanych, 1, Pos('.', sciezkaPlikuDanych) - 1) + '.bak';
  if FileExists(sciezkaPlikuDanych) then
    begin
      DeleteFile(tmp);
      RenameFile(sciezkaPlikuDanych, tmp);
    end;
  tmp := '';

  //zamykanie aplikacji
  Application.Terminate;
end;

procedure TForm1.przyciskZatrzymajClick(Sender: TObject);
begin
  Form1.Caption := TYTUL_GLOWNEGO_OKNA;
  przyciskZamknij.Enabled := False;
  przyciskZamknij.Update;
  Sleep(5);
  Application.ProcessMessages;
  zatrzymajPrace := True;
  Application.ProcessMessages;
end;

procedure TForm1.przyciskPobierzClick(Sender: TObject);
var
  adresStrony, strona, tmp : string;
  i, j, k, x, y, z, liczbaPowtorzen, maxLiczbaStron, liczbaTapetDoPobrania : integer;
  temp : rekordTapety;
  tapetaIstnieje, blad : boolean;
  dlugosc : dword;
  http : TIdHTTP;
  wyszukiwaniePlikow : TSearchRec;
  mS : TMemoryStream;
  watkiPobieraniaTapet : array[1..LICZBA_WATKOW_POBIERANIA_TAPET] of watekPobieraniaTapet;


begin
  //inicjalizacja
  przyciskPobierz.Caption := 'Pobieram...';
  przyciskPobierz.Enabled := False;
  przyciskZamknij.Caption := 'Zatrzymaj';
  przyciskZamknij.OnClick := przyciskZatrzymajClick;
  przyciskPobierz.Update;
  przyciskZamknij.Update;
  Sleep(5);
  Application.ProcessMessages;
  zatrzymajPrace := False;
  liczbaPowtorzen := 0;
  liczbaTapetDoPobrania := 0;
  maxLiczbaStron := 500; //tyle stron tylko podaje serwer - dalsze sa powtorzeniami pierwszej strony
  postepHttp.Progress := 0;
  postepHttp.MaxValue := maxLiczbaStron;
  Sleep(5);
  Application.ProcessMessages;
  Sleep(5);
  Application.ProcessMessages;
  Sleep(5);
  Application.ProcessMessages;

  //zliczanie tapet, ktore nie zostaly jeszcze pobrane
  for i := 0 to Length(tapety) - 1 do
    if not(tapety[i].sciagniete) then
      liczbaTapetDoPobrania := liczbaTapetDoPobrania + 1; //tylko tyle jest potrzebne zeby wiedziec czy jakies tapety sa do sciagniecia

  //aktualizacja okna
  Sleep(5);
  Application.ProcessMessages;

  //pobieranie linkow do plikow
  if ((Length(tapety) div 12) < 500) then //sprawdzenie czy baza tapet zostala odczytana chociaz jeden pelny raz
    i := (Length(tapety) div 12) - 3
  else
    i := 0;
  if (i > 499) then i := 499;
  http := TIdHTTP.Create(Form1);
  http.HandleRedirects := True;
  http.Request.UserAgent := 'Mozilla/5.0 (Windows; U; Windows NT 6.1; pl; rv:1.9.2.10) Gecko/20100914 Firefox/3.6.10';
  http.Request.Referer := 'http://www.zedge.net/';
  http.OnWork := nil;
  http.OnWorkBegin := nil;
  http.OnWorkEnd := nil;
  while ((i <= maxLiczbaStron) AND (liczbaPowtorzen <= 50)) do //50 tapet pod rzad musi byc identycznych, zeby przerwac pobieranie
    begin
      if ((i = 0) AND (liczbaTapetDoPobrania > 0)) then Break; //w przypadku gdy zaczynamy od poczatku, a sa jakies tapety do pobrania to przechodzimy od razu do pobierania tapet
      if (i < 0) then i := 0;
      i := i + 1;
      postepHttp.Progress := i - 1;
      postepHttp.Update;
      if (i > maxLiczbaStron) then
        postepOgolny.Text := 'Pobieranie listy plików - strona: ' + inttostr(maxLiczbaStron) + ' / ' + inttostr(maxLiczbaStron)
      else
        postepOgolny.Text := 'Pobieranie listy plików - strona: ' + inttostr(i) + ' / ' + inttostr(maxLiczbaStron);
      adresStrony := 'http://www.zedge.net/wallpapers/3499/htc-hd2-wallpapers/14-3-' + inttostr(i) + '/';
      strona := '';
      try
        try
          strona := Trim(http.Get(adresStrony));
        finally
          http.Disconnect;
        end;
      except
        i := i - 1;
        Continue;
      end;
      //aktualizacja okna
      Sleep(5);
      Application.ProcessMessages;

      //usuwanie zbednego konca strony
      Delete(strona, Pos('footer black">', strona), (Length(strona) - (Pos('footer black">', strona) - 13)));

      //wyciaganie linkow do stron z plikami
      repeat
        //usuniecie pozostalosci po obecnej tapecie
        Delete(strona, 1, (Pos('boxwallpapers">', strona) + 14));

        //pobieranie linku do miniatury
        Delete(strona, 1, Pos('<img', strona));
        Delete(strona, 1, Pos('src="', strona) + 4);
        temp.link := Trim(Copy(strona, 1, Pos('-t.jpg', strona) - 1));

        //pobieranie id tapety
        tmp := temp.link;
        Delete(strona, 1, Pos('/1-', strona) + 2);
        try
          temp.id := strtoint(Trim(Copy(strona, 1, Pos('-', strona) - 1)));
        except
          i := i - 1;
          Break;
        end;

        //sprawdzenie czy tapety juz nie ma w bazie
        tapetaIstnieje := False;
        for j := 0 to Length(tapety) - 1 do
          begin
            if (tapety[j].id = temp.id) then
              begin
                tapetaIstnieje := True;
                Break;
              end;
          end;

        //aktualizacja okna
        Sleep(5);
        Application.ProcessMessages;

        //jesli nie ma takiej tapety w bazie to ja dodajemy
        if not(tapetaIstnieje) then
          begin
            SetLength(tapety, Length(tapety) + 1);
            tapety[Length(tapety) - 1].id := temp.id;
            tapety[Length(tapety) - 1].link := temp.link;
            tapety[Length(tapety) - 1].sciagniete := False;
          end;
      until not(ContainsText(strona, 'boxwallpapers">'));

      if ((Length(tapety) div 12) < 500) then liczbaPowtorzen := 0; //zerowanie przy niepelnej bazie tapet
      if (zatrzymajPrace) then Break;
    end;
  try
    FreeAndNil(http);
  except;
  end;

  //pobieranie plikow z tapetami
  postepOgolny.Progress := 0;
  postepOgolny.MaxValue := liczbaTapetDoPobrania;
  //tworzenie watkow
  if not(zatrzymajPrace) then
    begin
      for i := 1 to LICZBA_WATKOW_POBIERANIA_TAPET do
        begin
          watkiPobieraniaTapet[i] := watekPobieraniaTapet.Create(True);
          watkiPobieraniaTapet[i].numerWatku := i;
          watkiPobieraniaTapet[i].watekZawieszony := True;
          watkiPobieraniaTapet[i].Priority := PRIORYTET_WATKOW;
          watkiPobieraniaTapet[i].FreeOnTerminate := True;
          watkiPobieraniaTapet[i].Resume;
          Application.ProcessMessages;
        end;
      for i := 0 to Length(tapety) - 1 do
        begin
          repeat
            blad := False; //zmienna pozwoli powtorzyc przeszukiwanie linkow, jesli serwer sie zapcha i program przeskoczy do nastepnego pliku

            if (zatrzymajPrace) then Break;
            Application.ProcessMessages;

            //jesli tapeta jest juz pobrana to kontynuujemy do nastepnej
            if (tapety[i].sciagniete) then Continue;

            //sprawdzenie czy plik w bazie nie zostal juz wczesniej sciagniety
            //oraz usuwanie pustych plikow, ktore czasami sie zapisuja
            tmp := tapety[i].link;
            while (ContainsText(tmp, '/')) do
              Delete(tmp, 1, Pos('/', tmp));
            if (ContainsText(tmp, 'jpg')) then
              begin
                tmp := sciezkaProgramu + 'Tapety\' + tmp;
                if (FindFirst(tmp, faAnyFile and not(faDirectory), wyszukiwaniePlikow) = 0) then
                  begin
                    if (wyszukiwaniePlikow.Size = 0) then
                      DeleteFile(tmp)
                    else
                      begin
                        tapety[i].sciagniete := True;
                        liczbaTapetDoPobrania := liczbaTapetDoPobrania - 1;
                        FindClose(wyszukiwaniePlikow);
                        Break;
                      end;
                  end;
              end
            else
              begin
                tmp := sciezkaProgramu + 'Tapety\' + tmp + '*.*';
                if (FindFirst(tmp, faAnyFile and not(faDirectory), wyszukiwaniePlikow) = 0) then
                  begin
                    if (wyszukiwaniePlikow.Size = 0) then
                      DeleteFile(sciezkaProgramu + 'Tapety\' + wyszukiwaniePlikow.Name)
                    else
                      begin
                        tapety[i].link := tapety[i].link + Copy(wyszukiwaniePlikow.Name, Length(wyszukiwaniePlikow.Name) - 6);
                        tapety[i].sciagniete := True;
                        liczbaTapetDoPobrania := liczbaTapetDoPobrania - 1;
                        FindClose(wyszukiwaniePlikow);
                        Continue;
                      end;
                  end;
              end;
            FindClose(wyszukiwaniePlikow);
            tmp := '';

            //sprawdzanie czy miniatura tapety istnieje na serwerze - jesli nie to tapeta zostala usunieta
            http := TIdHTTP.Create(Self);
            http.HandleRedirects := True;
            http.Request.UserAgent := 'Mozilla/5.0 (Windows; U; Windows NT 6.1; pl; rv:1.9.2.10) Gecko/20100914 Firefox/3.6.10';
            http.Request.Referer := 'http://www.zedge.net/';
            http.OnWork := nil;
            http.OnWorkBegin := nil;
            http.OnWorkEnd := nil;
            repeat
              Application.ProcessMessages;
              tmp := tapety[i].link + '-t.jpg';
              tapetaIstnieje := True;
              mS := TMemoryStream.Create;
              try
                http.Get(tmp, mS);
                http.Disconnect;
              except
                on E : Exception do
                  if (ContainsText(E.Message, '404')) then //tapeta nie istnieje !
                    begin
                      tapetaIstnieje := False;

                      //usuniecie tapety z listy linkow
                      for j := i to Length(tapety) - 1 do
                        begin
                          tapety[j].id := tapety[j + 1].id;
                          tapety[j].link := tapety[j + 1].link;
                          tapety[j].sciagniete := tapety[j + 1].sciagniete;
                        end;
                      SetLength(tapety, Length(tapety) - 1);
                      liczbaTapetDoPobrania := liczbaTapetDoPobrania - 1;

                      Continue;
                    end;
              end;
              FreeAndNil(mS);
              Application.ProcessMessages;
            until tapetaIstnieje;
            FreeAndNil(http);

            //aktualizacja paska postepu
            if not(tapety[i].sciagniete) then
              postepOgolny.Progress := postepOgolny.Progress + 1;
            postepOgolny.Text := 'Pobieranie tapet: ' + inttostr(postepOgolny.Progress) + ' / ' + inttostr(liczbaTapetDoPobrania) + '  (%d%%)';
            postepOgolny.Update;
            Application.ProcessMessages;

            if (zatrzymajPrace) then Break;

            //zerowanie watkow przed ponownym wykorzystaniem
            for j := 1 to LICZBA_WATKOW_POBIERANIA_TAPET do
              begin
                watkiPobieraniaTapet[j].liczbaProbPobraniaTapety := 0;
                watkiPobieraniaTapet[j].linkDoTapety := tapety[i].link;
                watkiPobieraniaTapet[j].tenWatekSciagaTapete := 0;
                watkiPobieraniaTapet[j].watekZawieszony := False;
                Application.ProcessMessages;
              end;

            //interakcja z watkami
            postepHttp.MinValue := 0;
            postepHttp.Progress := 0;
            postepHttp.MaxValue := 1000;
            z := 0;
            repeat
              //pasek postepu
              k := 0; //liczba wyprobowanych adresow
              for j := 1 to LICZBA_WATKOW_POBIERANIA_TAPET do
                k := k + watkiPobieraniaTapet[j].liczbaProbPobraniaTapety;
              if (postepHttp.MaxValue = 1000) then
                postepHttp.Text := 'Próba pobrania: ' + inttostr(k);

              //zapobieganie nieskonczonemu zapetleniu
              if (k > 5000) then
                begin
                  for j := 1 to LICZBA_WATKOW_POBIERANIA_TAPET do
                    watkiPobieraniaTapet[j].watekZawieszony := True;
                  Application.ProcessMessages;
                  blad := False;
                  Break;
                end;

              Sleep(50);
              Application.ProcessMessages;

              //sprawdzenie czy jest jakis watek pobierajacy tapete
              //jesli tak to zawieszamy reszte watkow
              k := 0; //identyfikator watku sciagajacego tapete
              for j := 1 to LICZBA_WATKOW_POBIERANIA_TAPET do
                if (watkiPobieraniaTapet[j].tenWatekSciagaTapete > 0) then
                  begin
                    k := j;
                    for z := 1 to LICZBA_WATKOW_POBIERANIA_TAPET do
                      if (z <> j) then
                        watkiPobieraniaTapet[z].watekZawieszony := True;
                    Break;
                  end;

              z := 0; //licznik pozwalajacy okreslic czy jakies watki jeszcze pracuja
              for j := 1 to LICZBA_WATKOW_POBIERANIA_TAPET do
                if (not(watkiPobieraniaTapet[j].watekZawieszony) OR (watkiPobieraniaTapet[j].tenWatekSciagaTapete = 1)) then
                  z := z + 1;

              if (k > 0) then
                begin
                  tapety[i].link := watkiPobieraniaTapet[k].linkDoTapety;
                  if (ContainsText(tapety[i].link, 'jpg')) then //tutaj sie upewniamy, ze plik zostal sciagniety
                    begin
                      tapety[i].sciagniete := True;
                      blad := False;
                    end
                  else
                    blad := True;
                end;
            until (z = 0);
          until not(blad);
        end;

      //uwalnianie pamieci watkow
      for i := 1 to LICZBA_WATKOW_POBIERANIA_TAPET do
        begin
          try
            watkiPobieraniaTapet[i].Terminate;
          except;
          end;
          Application.ProcessMessages;
        end;
    end;

  //finalizacja
  przyciskPobierz.Caption := 'Pobierz';
  przyciskPobierz.Enabled := True;
  przyciskZamknij.Caption := 'Zamknij';
  przyciskZamknij.OnClick := przyciskZamknijClick;
  przyciskZamknij.Enabled := True;
  przyciskPobierz.Update;
  przyciskZamknij.Update;
  Application.ProcessMessages;
end;

procedure watekPobieraniaTapet.Execute;
var
  http : TIdHTTP;
  i, j, z : integer;
  tmp : string;
  mS : TMemoryStream;

begin
  http := nil;
  mS := nil;
  while not(Terminated) do //glowna petla pozwalajaca wielokrotnie wykorzystywac watek
    begin
      if (watekZawieszony) then
        begin
          Sleep(1000);
          Continue;
        end
      else
        begin
          mS := TMemoryStream.Create;
          http := TIdHTTP.Create(nil);
          http.HandleRedirects := True;
          http.RedirectMaximum := 50;
          http.Request.UserAgent := 'Mozilla/5.0 (Windows; U; Windows NT 6.1; pl; rv:1.9.2.10) Gecko/20100914 Firefox/3.6.10';
          http.Request.Referer := 'http://www.zedge.net/';
          http.OnWork := httpWork;
          http.OnWorkBegin := httpWorkBegin;
          http.OnWorkEnd := httpWorkEnd;
        end;

      //obliczenie przedzialu z ktorego watek ma sprawdzic linki
      z := 1000 div LICZBA_WATKOW_POBIERANIA_TAPET;
      j := (numerWatku - 1) * z;

      for i := j to j + (z - 1) do
        begin
          if ((zatrzymajPrace) OR (Terminated)) then
            begin
              watekZawieszony := True;
              FreeAndNil(mS);
              FreeAndNil(http);
              Terminate;
              Exit;
            end;

          liczbaProbPobraniaTapety := liczbaProbPobraniaTapety + 1;

          //tworzenie probnego linku do sprawdzenia
          tmp := linkDoTapety;
          if (i < 100) then
            begin
              if (i < 10) then
                tmp := tmp + '00' + inttostr(i) + '.jpg'
              else
                tmp := tmp + '0' + inttostr(i) + '.jpg';
            end
          else
            tmp := tmp + inttostr(i) + '.jpg';

          //proba pobrania pliku
          try
            http.Get(tmp, mS);
            http.Disconnect;
          except
            on E : Exception do
              begin
                if (ContainsText(E.Message, '404')) then
                  begin
                    Sleep(200);
                    mS.Clear;
                    Continue;
                  end
                else
                  Sleep(200);
              end;
          end;

          //zapis prawidlowego linku do pliku
          linkDoTapety := tmp;

          Break;
        end;

      if (zatrzymajPrace) then
        begin
          watekZawieszony := True;
          tenWatekSciagaTapete := 0;
          FreeAndNil(mS);
          FreeAndNil(http);
          Terminate;
          Exit;
        end;

      if (mS.Size < 10240) then
        begin
          mS.Clear;
          Continue;
        end;

      //zapis tapety
      if (mS.Size > 10240) then //tapeta powinna miec rozmiar > 10kB
        begin
          if not(DirectoryExists(sciezkaProgramu + 'Tapety')) then
            CreateDir(sciezkaProgramu + 'Tapety');
          while (ContainsText(tmp, '/')) do
            Delete(tmp, 1, Pos('/', tmp));
          mS.SaveToFile(sciezkaProgramu + 'Tapety\' + tmp);
          mS.Clear;
          tenWatekSciagaTapete := 2;
        end;

      FreeAndNil(mS);
      FreeAndNil(http);
      watekZawieszony := True;
    end;
end;

procedure watekPobieraniaTapet.httpWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
  httpWorkCount := AWorkCount;
  Synchronize(SYNC_httpWork);
  httpWorkCount := 0;
end;

procedure watekPobieraniaTapet.SYNC_httpWork;
var
  Pom1, Pom2, Pom3, Pom4 : string;

begin
  if (tenWatekSciagaTapete > 0) then //reakcja tylko jesli ten watek sciaga tapete
    begin
      Pom1 := inttostr(httpWorkCount div 1024);
      Pom2 := inttostr(httpWorkCount mod 1024);
      Pom3 := inttostr(Form1.postepHttp.MaxValue div 1024);
      Pom4 := inttostr(Form1.postepHttp.MaxValue mod 1024);
        if length(Pom2) > 2 then SetLength(Pom2, 2);
        if length(Pom4) > 2 then SetLength(Pom4, 2);
        if length(Pom2) = 1 then Pom2 := Pom2 + '0';
        if length(Pom4) = 1 then Pom4 := Pom4 + '0';
        if length(Pom2) = 0 then Pom2 := '00';
        if length(Pom4) = 0 then Pom4 := '00';
      Form1.postepHttp.Progress := httpWorkCount;
      Form1.postepHttp.Text := 'Pobrano: ' + Pom1 + ',' + Pom2 + 'kB z ' + Pom3 + ',' + Pom4 + 'kB  (%d%%)';
      Form1.postepHttp.Update;
      Application.ProcessMessages;
    end;
end;

procedure watekPobieraniaTapet.httpWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  httpWorkCount := AWorkCountMAX;
  Synchronize(SYNC_httpWorkBegin);
  httpWorkCount := 0;
end;

procedure watekPobieraniaTapet.SYNC_httpWorkBegin;
begin
  if (httpWorkCount > 10240) then //reakcja tylko jesli sciagniete informacje beda mialy > 10kB
    begin
      tenWatekSciagaTapete := 1;
      Form1.postepHttp.MinValue := 0;
      Form1.postepHttp.Progress := 0;
      Form1.postepHttp.MaxValue := httpWorkCount;
      Form1.postepHttp.Update;
      Application.ProcessMessages;
    end;
end;

procedure watekPobieraniaTapet.httpWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  Synchronize(SYNC_httpWorkEnd);
end;

procedure watekPobieraniaTapet.SYNC_httpWorkEnd;
begin
  if (tenWatekSciagaTapete > 0) then //reakcja tylko w czasie gdy pozostale worki zmienia ta wartosc
    begin
      Form1.postepHttp.Progress := Form1.postepHttp.MaxValue;
      Form1.postepHttp.Update;
      Application.ProcessMessages;
    end;
end;

initialization

finalization
  Form1.zapiszPlikDanych;

end.

Dodam, że prog kompilowany na Delphi 2009 z Indy 10.
Ogólnie rzecz biorąc to 1000 prób dla każdego pliku powinno starczyć, ale limit sprawdzania jest ustawiony na 5000 bo albo serwer czasami się zapycha, albo Indy nie wyrabia i niektóre wątki muszą chodzić kilka razy - a i tak nie ma gwarancji, że daną tapetę pobierze.

0

O matko wszystkiego co dobre i czyste!
Nie byłem w stanie przebrnąć przez ten twór.

Po pierwsze - trzymaj się konwencji nazewnictwa. Czyli Nazwy typów rozpoczynamy literą T.
Po drugie - po co Ci tyle sleepów i application.processMessages?
Po trzecie po co ci zmienna: watekZawieszony, czy jak tam ją nazywasz?
Po czwarte - nie możesz tworzyć tyle wątków, ile Ci się podoba.
Po piąte - prawdopodobnie gdzieś powinno być Synchronize. Nie wiem, nie przebrnąłem.
Generalnie masakra. Weź to wyrzuć i napisz to od początku dobrze. I poczytaj o wątkach od A do Z.

I nie używaj Application.Terminate do zamykania aplikacji, tylko w tym wypadku Close.

0 
while not(Terminated) do
//...
mS := TMemoryStream.Create;

Po co wielokrotnie w pętli tworzysz obiekty?

Przyjrzyj się też tej pętli. Wyciąłem większość kodu zostawiając instrukcje sterujące:

      for i := j to j + (z - 1) do
        begin
          if ((zatrzymajPrace) OR (Terminated)) then
              Exit;
          try
          //...
          except
            on E : Exception do
                if (ContainsText(E.Message, '404')) then
                    Continue;
          end;
          Break;
        end;

WTF polega na bezwarunkowym break pod koniec pętli, z exitem i continue gdzieś w środku. Przebuduj to – być może na while albo until, bo w tej chwili to jest nielepsze od goto.

Ta sama procedura obcięta w inny sposób wygląda tak:

  while not(Terminated) do
    begin
      if (watekZawieszony) then
        begin
          Sleep(1000);
          Continue;
        end
      else     { <-- else które nic nie robi }
        begin { zbędne }
          mS := TMemoryStream.Create;
          http := TIdHTTP.Create(nil);
          // CIACH
        end;  { zbędne }

      // CIACH DUŻO KODU
      FreeAndNil(mS);
      FreeAndNil(http);
      watekZawieszony := True;
    end;

I co to robi? strukturę pętli widać dopiero po wycięciu 90% jej zawartości. Takich złożonych pętli rzeczywiście nie daje się czytać. Podziel duże procedury na mniejsze.
Nadmiarowe bloki (jak to else) świadczą o tym, że straciłeś nad tym wszystkim panowanie.

Szukanie memleaka nic nie da: nawet jeśli się go znajdzie, w takim kodzie zaraz inny się pojawi. Musisz kod gruntownie przebudować.

1 użytkowników online, w tym zalogowanych: 0, gości: 1