Потоки

[PTyTb32]

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

Фигня какая-то, а не функция.

вероятно да, я и сам понимаю что обращаться из потока к форме не лучшая идея, сейчас немного понапрягал программу, она доходила до 1,5GB ОЗУ и до 50% процессора, и вот что было по завершению. я не знаю как в нормальный поток передать аргументы, может и правда лучше потоком забирать IP из списка?

[Pavia]

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

Synchronize используется в других потоках,

Это без разницы. Не хотите Synchronize, поставьте мьютекс.

uses SyncObjs;
...
var
Mutex:TMutex; // объявляем как глобальную переменную. Или внутри формы как общую переменную для всех потоков. 
...
procedure scanerIP(Parameter: PMsgRecord);
var
  d: integer;
  it: TIdTCPClient;
begin
  it := TIdTCPClient.Create(nil);
  it.Host := Parameter.ip;
  it.port := strtoint(Parameter.port);
  it.ConnectTimeout := Parameter.tc;

  try
    it.Connect;

    Mutex.Acquire;
    Parameter.p := Parameter.p + 1;
    Form1.RichEdit1.Lines.Add(Parameter.ip + ' YES');
    d := strtoint(Form1.Label12.Caption);
    d := d + 1;
    Form1.Label12.Caption := inttostr(d);
    d := strtoint(Form1.Label15.Caption);
    d := d + 1;
    Form1.Label15.Caption := inttostr(d);
    Mutex.Release;
    it.free;
  except
    on E: exception do
    begin
    it.free;
    Mutex.Acquire;
    Parameter.p := Parameter.p + 1;
    Mutex.Release;
    end;

  end;
end;

EndThread(0); -выкинуть, так как он лишний. ДА и мешает try-except корректно освободить SEH объекты.

[PTyTb32]

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

ДА и мешает try-except корректно освободить SEH объекты.

без этого обработчика вылетают сообщения о превышении времени на подключение (оно установлено на 500 миллисекунд)

я убрал проверку очередного адреса, нашел утечки в функции разбивающей ip диапазоны на адреса, дал ей циклом 100 или около того разных диапазонов и она их все в 1 переменную должны класть (stringlist) и когда программа занимает 1.8Gb памяти, вылетает out of memory, дополнительные стринг листы я очищаю (их содержимое тоже) и остается лишь 1 лист в котором хранятся нужные ip, делаю это вот так

procedure TForm1.getIP2(ips: string);
var
  sb: array [0 .. 3] of byte;
  eb: array [0 .. 3] of byte;
  Start, stop, resultip: tstringlist;
  ss, sp: string;
  i,p: byte;
  Count: longword;
begin
// это для разделения диапазона на 1 и последний адреса
  ss := ips; 
  sp := ss; 
  p := Pos('-', ss); 
  delete(ss, p, Length(ss)); 
  delete(sp, 1, p); 
  Start := tstringlist.Create; 
  stop := tstringlist.Create;
  resultip := tstringlist.Create; 
  Start.Delimiter := '.'; 
  Start.StrictDelimiter := true;
  Start.DelimitedText := ss; 
  stop.Delimiter := '.';
  stop.StrictDelimiter := true;
  stop.DelimitedText := sp;

//перекидываем адреса из текста в число
  for I := 0 to 3 do
  begin
    sb[I] := strtoint(Start[I]);
    eb[I] := strtoint(stop[I]);
  end;

//убиваем стринглисты и их содержимое
     FreeObjects(Start);
  FreeObjects(stop);
  FreeAndNil(Start);
  FreeAndNil(stop);


  repeat
    resultip.Add('');
    for I := 0 to 3 do
      resultip[Count] := resultip[Count] + inttostr(sb[I]) + '.';
    ss := resultip[Count];
    delete(ss, Length(ss), 1);
    resultip[Count] := ss;
    sb[3] := sb[3] + 1;
    Count := Count + 1;
    for I := 3 downto 0 do
      if sb[I] > 255 then
      begin
        sb[I] := 0;
        sb[I - 1] := sb[I - 1] + 1;
      end;
  until (sb[0] = eb[0]) and (sb[1] = eb[1]) and (sb[2] = eb[2])
    and (sb[3] = eb[3]);

    resultip.Add(sp);

  Form1.ProgressBar2.Max := resultip.Count;
  Form1.ProgressBar2.Position := 0;  

  Form1.Label10.Caption := inttostr(resultip.Count); // label10 - количество адресов в текущем диапазоне
  p := strtoint(Form1.Label16.Caption); // label16 - количество адресов во всех диапазонах
  p := p + resultip.Count;
  Form1.Label16.Caption := inttostr(p);
  for I := 0 to resultip.Count - 1 do
  begin
    listip.Add(resultip[I]); // заполнение главного стринглиста
  end;
//убиваем стринглист и его содержимое
  FreeObjects(resultip); 
  FreeAndNil(resultip);

end;

Integer и byte всякие очищать ведь не нужно? я не понимаю где тут утечки происходят! где то вычитывал что inttostr и обратно само по себе создает утечку, но не понимаю почему

а вот и out of memory!!!! путем экспериментов, узнал следующее

procedure TForm1.Button2Click(Sender: TObject);
var a: array of string[15];
  I: Integer;
  f:longword;
begin
f:=99999911; //выдает out of memory
  SetLength(a,f);

end;

видимо я переполняю массив..
еще заметил что максимально возможное количество ip адресов - 4294967296, ровно столько же как и вместимость longword
неужели не выйдет работать со всеми диапазонами сразу?

Я нашел максимальную длину массива array of string[15], она равна 68427774, при этом если взять массив array of string[16], то при таком же его размере будет снова out of memory!!!
но странно между 0.0.0.0 и 0.255.255.255 лежит 16777216 адресов, а значит в этом диапазоне он должен работать

[Slym]

в свежих delphi можно более высокоуровнево

uses System.Threading, System.Generics.Collections;
type
  TV4ScanEntry=record
    ip:string;
    port:word;
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    HostList:TQueue<TV4ScanEntry>;
    ThreadPool:TThreadPool;
  public
  end;


procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
  if not assigned(HostList) then
    HostList:=TQueue<TV4ScanEntry>.Create;
  //Заполняем HostList

  if not assigned(ThreadPool) then
  begin
    ThreadPool:=TThreadPool.Create;
    ThreadPool.SetMaxWorkerThreads(30);
  end;
  for i:=0 to ThreadPool.MaxWorkerThreads-1 do
    TTask.Run(
      procedure
      var
        it:TIdTCPClient;
        ScanEntry:TV4ScanEntry;
      begin
        it := TIdTCPClient.Create(nil);
        try
          while TTask.CurrentTask.Status=TTaskStatus.Running do
          begin
            System.TMonitor.Enter(HostList);
            try
              if HostList.Count=0 then break;
                ScanEntry:=HostList.Extract;
            finally
              System.TMonitor.Exit(HostList);
            end;
            if it.Connected then
              it.Disconnect(false);
            it.Host := ScanEntry.ip;
            it.port := ScanEntry.port;
            it.ConnectTimeout := 500;
            try
              it.Connect;
              TThread.Queue(nil,
              procedure
              begin
                //Form1.RichEdit1.Lines.Add(ScanEntry.ip + ' YES');
              end);
            except
              TThread.Queue(nil,
              procedure
              begin
                //Form1.RichEdit1.Lines.Add(ScanEntry.ip + ' No');
              end);
            end;
          end;
        finally
          it.Free;
        end;
      end,
      ThreadPool);
end;

[PTyTb32]

спасибо, а потом это все очищать от утечек?

[Slym]

не знаешь, не умничай...
убить надо HostList и ThreadPool
но это где нибудь в OnClose...
от же TTask - самоубьется по завершению.
да и зачем гиговый HostList когда все хосты последовательные ip и можно на лету вычислить
ip - прекрасно помещается в integer...

[PTyTb32]

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

не знаешь, не умничай...

дык я не умничаю, а спрашиваю, и еще интересно можно ли как то поймать завершение последнего потока? это не обязательно, но не помешает, я честно говоря не понимаю как это работает ((

[Alex11223]

Кстати, там еще не завезли умные указатели что ли?

[PTyTb32]

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

ip - прекрасно помещается в integer...

не знал.

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

Кстати, там еще не завезли умные указатели что ли?

какие указатели?

[PTyTb32]

че откопал!!!!
хотя уже делаю проверку на количество элементов в массиве.. жесть какая, сейчас попробую на лету их цеплять, и не записывать пока они не прошли проверку