Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.09.2018, 14:20   #11
PTyTb32
Форумчанин
 
Регистрация: 06.10.2013
Сообщений: 216
По умолчанию

Цитата:
Сообщение от Alex11223 Посмотреть сообщение
Фигня какая-то, а не функция.
вероятно да, я и сам понимаю что обращаться из потока к форме не лучшая идея, сейчас немного понапрягал программу, она доходила до 1,5GB ОЗУ и до 50% процессора, и вот что было по завершению. я не знаю как в нормальный поток передать аргументы, может и правда лучше потоком забирать IP из списка?
Изображения
Тип файла: png 123132.png (15.2 Кб, 99 просмотров)
PTyTb32 вне форума Ответить с цитированием
Старый 11.09.2018, 14:31   #12
Pavia
Лис
Старожил
 
Аватар для Pavia
 
Регистрация: 18.09.2015
Сообщений: 2,409
По умолчанию

Цитата:
Сообщение от 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 объекты.
Хорошо поставленный вопрос это уже половина ответа. | Каков вопрос, таков ответ.
У дзен программиста программа делает то что он хотел, а не то что он написал .
Pavia вне форума Ответить с цитированием
Старый 11.09.2018, 14:34   #13
PTyTb32
Форумчанин
 
Регистрация: 06.10.2013
Сообщений: 216
По умолчанию

Цитата:
Сообщение от 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 адресов, а значит в этом диапазоне он должен работать

Последний раз редактировалось PTyTb32; 11.09.2018 в 17:59.
PTyTb32 вне форума Ответить с цитированием
Старый 11.09.2018, 17:55   #14
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

в свежих 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;
Не стесняемся, плюсуем!
Slym вне форума Ответить с цитированием
Старый 11.09.2018, 18:14   #15
PTyTb32
Форумчанин
 
Регистрация: 06.10.2013
Сообщений: 216
По умолчанию

спасибо, а потом это все очищать от утечек?
PTyTb32 вне форума Ответить с цитированием
Старый 11.09.2018, 19:07   #16
Slym
Участник клуба
 
Регистрация: 07.12.2011
Сообщений: 1,025
По умолчанию

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

Последний раз редактировалось Slym; 11.09.2018 в 19:15.
Slym вне форума Ответить с цитированием
Старый 11.09.2018, 19:15   #17
PTyTb32
Форумчанин
 
Регистрация: 06.10.2013
Сообщений: 216
По умолчанию

Цитата:
Сообщение от Slym Посмотреть сообщение
не знаешь, не умничай...
дык я не умничаю, а спрашиваю, и еще интересно можно ли как то поймать завершение последнего потока? это не обязательно, но не помешает, я честно говоря не понимаю как это работает ((
PTyTb32 вне форума Ответить с цитированием
Старый 11.09.2018, 19:41   #18
Alex11223
Старожил
 
Аватар для Alex11223
 
Регистрация: 12.01.2011
Сообщений: 19,500
По умолчанию

Кстати, там еще не завезли умные указатели что ли?
Ушел с форума, https://www.programmersforum.rocks, alex.pantec@gmail.com, https://github.com/AlexP11223
ЛС отключены Аларом.
Alex11223 вне форума Ответить с цитированием
Старый 11.09.2018, 19:52   #19
PTyTb32
Форумчанин
 
Регистрация: 06.10.2013
Сообщений: 216
По умолчанию

Цитата:
Сообщение от Slym Посмотреть сообщение
ip - прекрасно помещается в integer...
не знал.



Цитата:
Сообщение от Alex11223 Посмотреть сообщение
Кстати, там еще не завезли умные указатели что ли?
какие указатели?
PTyTb32 вне форума Ответить с цитированием
Старый 11.09.2018, 19:55   #20
PTyTb32
Форумчанин
 
Регистрация: 06.10.2013
Сообщений: 216
По умолчанию

че откопал!!!!
хотя уже делаю проверку на количество элементов в массиве.. жесть какая, сейчас попробую на лету их цеплять, и не записывать пока они не прошли проверку
Изображения
Тип файла: png 123132.png (21.5 Кб, 122 просмотров)
PTyTb32 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Потоки. Закрываются все потоки при ошибке в одном. Son Общие вопросы Delphi 11 01.11.2013 09:32
потоки Cpluser C# (си шарп) 1 28.10.2012 17:00
Потоки _Mixer_ Общие вопросы по Java, Java SE, Kotlin 4 16.10.2011 19:25
Потоки С++ Aleksin Помощь студентам 1 07.11.2010 18:15
потоки tanek Помощь студентам 6 15.03.2010 21:42