[ПОТОКИ] Сыпется софт

[bakanaev]

Сабж. Собрал у себя на ПК софтину, у меня работает ок при юбом колличестве потоков, у товарища что на ПК что на ноуте если больше 200 поток то вылетает вот такое
Провери еще на 2-х ноутах, все работает.
У товарища Win7 64x ultimate (у меня Win8 хотя я тестил на Win7 64x ultimate). 32 оперативы и i7.
Не могу понять в чем проблема
Прошу помощи, заранее благодарен

[Stilet]

Ну а сам код где?

[bakanaev]

Сообщение от Stilet

Ну а сам код где?

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, SyncObjs, IdHTTP, Vcl.ComCtrls;

type
  TForm2 = class(TForm)
    GroupBox3: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    IdHTTP1: TIdHTTP;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    OpenDialog1: TOpenDialog;
    Edit4: TEdit;
    Label10: TLabel;
    UpDown1: TUpDown;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


TNewThread = class(TThread)
  private
   Rez,domen : string;
    protected
    procedure Execute; override;
  public
    procedure Sync;
    constructor Create(CreateSuspended: Boolean);

  end;

var
  Form2: TForm2;
  find:integer = 0;
  check:integer = 0;
  i : integer= -1;
  work:bool;
  links:TStringList;
  CS:TcriticalSection;
implementation

{$R *.dfm}
//...........................
function  SaveToFile(str:string; FileDir:String): string;
var
 f:TextFile;

begin

AssignFile(f,FileDir);
if not FileExists(FileDir) then
 begin
  Rewrite(f);
  CloseFile(f);
 end;
Append(f);
Writeln(f,str);
Flush(f);
CloseFile(f);
end;


 //...................................
constructor TNewThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
end;
procedure TNewThread.Execute;
var  IdHTTP1:TIdHTTP;

     html,fnd_text:string;
begin

while work do
 begin


    IdHTTP1:=TIdHTTP.Create;
   CS.Enter;
      fnd_text:=Form2.Edit1.Text;
      domen:='';
      inc(i);
      if i < links.Count -1  then  domen:=links.Strings [i]  else work:=false;
   CS.Leave;

     html:='';
     if work then
     begin
       try
       html:=IdHTTP1.Get(trim(domen));
       except  end;
       if pos (fnd_text,html) <> 0 then Rez:='GOOD|'+domen
       else Rez:='NOT';
     Synchronize(Sync);
     end;


    IdHTTP1.Free;
 end;//Edn while
end;

procedure TNewThread.Sync;
begin

 if pos('GOOD',Rez) <> 0 then
 begin
 try
 SaveToFile(copy(rez,pos('|',rez)+1,length(rez)-pos('|',rez)),ExtractFilePath(ParamStr(0))+'\good.txt');
 except
 on E:Exception do ShowMessage(E.Message ); end;
 inc(find);
 end;
 inc(check);
 Form2.Label6.Caption:=IntToStr(check);
 Form2.Label7.Caption:=IntToStr(find);


  end;
procedure TForm2.Button1Click(Sender: TObject);
var j:integer;
begin
if Button1.Caption = 'Начать'  then
  begin
  Button1.Caption:='Стоп';
  work:=true;
   for j := 1 to StrToInt (Edit4.Text) do
   begin
     TNewThread.Create(false);
   end;

  end
else
  begin
    Button1.Caption:='Начать';
    work:=false;
    check:=0;
    find:=0;
    i:=-1;
  end;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then links.LoadFromFile(OpenDialog1.FileName );
lAbel1.Caption:=IntToStr(links.Count);

end;

procedure TForm2.FormCreate(Sender: TObject);
begin
 CS:=TcriticalSection.create;
 links:=TStringList.Create;
 links.Free;
 links:=TStringList.Create;
end;

end.

[Stilet]

CS.Enter;

А стесняюсь спросить - это зачем?

TNewThread.Create(false);

А почему нигде не фиксируешь объект? На него ничто не ссылается, значт он не освобождается.

[bakanaev]

А стесняюсь спросить - это зачем?

Это аналог Synchronize(), подсмотрел в одном видео уроке. Но делал и через Synchronize(), результат тот же.

TNewThread.Create(false);

Да, я в курсе. На скорую руку писал.

Если что-то не так, скажите прямо в чем проблема. Буду только рад!

[Slym]

 links:=TStringList.Create;
 links.Free;
 links:=TStringList.Create;

в чем магия?

котгавно... хотя и на первый взгляд рабочее

в идеале должна быть 1 глобальная переменная...
cs - выкинуть, данный участок можно через Sync переделать

[bakanaev]

Сообщение от Slym

 links:=TStringList.Create;
 links.Free;
 links:=TStringList.Create;

в чем магия?

котгавно... хотя и на первый взгляд рабочее

:D
Забыл убрать, сорри))
Но это не влияет

[Slym]

CS.Enter;
fnd_text:=Form2.Edit1.Text;

CS - в данном случае не спасает от некорректного доступа к форме, т.к. VCL ничего не знает о CS

[bakanaev]

Сообщение от Slym

CS.Enter;
fnd_text:=Form2.Edit1.Text;

CS - в данном случае не спасает от некорректного доступа к форме, т.к. VCL ничего не знает о CS

Хм, сейчас попробуем. Но тестировал вроде)

[bakanaev]

Не помогло