Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Сети > Проверка существования ресурса в сети


Автор: pvabox 18.3.2019, 23:34
 Уважаемые господа, помогите мне решить одну задачку. Мне необходимо проверять большой массив ссылок StringList на работоспособность.
Это ссылки playlist-а вида http://ott-cdn.../index.m3u8. Необходимо проверить лишь существование ресурса. Код имеет следующий вид:

Код

function CheckUrl(url: string): boolean;
// Проверка Url на работоспособность
var IdHTTP: TIdHTTP;
begin
  IdHTTP := TIdHTTP.Create(nil);
  try
    { здесь можно задать параметры IdHTTP }
    IdHTTP.ConnectTimeout := 5000;
    try
      IdHTTP.Head(url);
      result := (IdHTTP.ResponseCode = 200);
    except
      result := false;
    end;
  finally
    IdHTTP.Free;
  end;
end;

и обработчик

Код

procedure TForm1.BtnTestClick(Sender: TObject);
// Тест ссылок на работоспособность
var i : integer;
begin
  for i := 0 to StringList.Count - 1 do
    if CheckUrl(StringList[i]) 
      then StringList[i] := StringList[i] + ' +'
      else StringList[i] := StringList[i] + ' -';
end;


 У этого кода два больших недостатка - он вешает программу и, если сервер долго не отвечает, то поиск прекращается, хотя за это время можно было бы проверить другие ссылки.
Поэтому процесс сильно затягивается. Подскажите, как можно преодолеть эти две проблемы в D07? Полагаю, необходимо использовать несколько независимых потоков и если какие 
потоки зависнут, то другие продолжат работу. Но как это сделать не знаю. А может есть и другие решения?

Автор: Alexeis 19.3.2019, 10:45
Вы все правильно решили. Можно создавать хоть 100 потоков.  В разделе WinApi есть прибитая статья  "Многопоточность - как это делается в Дельфи. Не используйте потоки, не прочитав это". Оттуда можно стрельнуть примерчик работы.
Можно обойтись из без потоков, но для этого нужно искать классы для работы в асинхронном режиме. Технически в вашем случае не обязательно даже дожидаться ответа. Можно послать 100 запросов и раз в секунду пробегаться и проверять у каждого не пришел ли ответ. Но насколько я помню, IdHTTP так не умеет. Так умеют обычные сокеты (каждый сокет имеет свой буфер, который винда заполняет ответом от сетевой карты по мере прихода данных, так что не обязательно прям ловить момент прихода ответа). 

Автор: pvabox 19.3.2019, 15:31
Спасибо за ответ. Статью "Многопоточность - как это делается в Дельфи. Не используйте потоки, не прочитав это" я конечно же читал, но разобраться как реализовать мою задачу в коде так и не понял. В статье описаны все тонкости использования потоков, а какой вариант выбрать мне я так и не понял.
Если кто может помогите!

Автор: Alexeis 20.3.2019, 11:14
Да хоспади, тут же не нужно никакой синхронизации даже делать. Передал в конструкторе, вернул в деструкторе. Просто вызвать функцию изнутри Execute потока так как она есть.
Код

program Project3;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, System.Classes, IdHTTP;

type
 TMyThread = class(TThread)
      inx     : Integer;
      urlList : TStringList;
      res     : Boolean;
   public
      constructor Create(ainx : Integer; aurlList : TStringList); overload;
      destructor  Destroy; override;
      function CheckUrl(url: string): Boolean;
      procedure Execute; override;
 end;

constructor TMyThread.Create(ainx : Integer; aurlList : TStringList);
Begin
  inherited Create(true);
  inx     := ainx;
  urlList := aurlList;
  Resume;
End;

function TMyThread.CheckUrl(url: string): boolean;
// Проверка Url на работоспособность
var IdHTTP: TIdHTTP;
begin
  IdHTTP := TIdHTTP.Create(nil);
  try
    { здесь можно задать параметры IdHTTP }
    IdHTTP.ConnectTimeout := 5000;
    try
      IdHTTP.Head(url);
      result := (IdHTTP.ResponseCode = 200);
    except
      result := false;
    end;
  finally
    IdHTTP.Free;
  end;
end;

procedure TMyThread.Execute;
Begin
   res := CheckUrl(urlList[inx]);
End;

destructor TMyThread.Destroy;
begin
  if res
      then urlList[inx] := urlList[inx] + ' +'
      else urlList[inx] := urlList[inx] + ' -';
end;

var
  urlList : TStringList;
  myThrds : array of TMyThread;
   i : Integer;
begin
  urlList := TStringList.Create;
  urlList.Add('http://ya.ru/');
  urlList.Add('http://google.com/');

  SetLength(myThrds, urlList.Count);
  for i := 0 to urlList.Count-1 do
    myThrds[i] := TMyThread.Create(i, urlList);

  for i := 0 to urlList.Count-1 do
  begin
    myThrds[i].WaitFor;
    myThrds[i].Free;
  end;


end.

Автор: pvabox 20.3.2019, 15:19
Круто! Я б до этого не допер. Спасибо, буду разбираться с кодом.

Автор: pvabox 21.3.2019, 20:43
Alexeis, Вы предложили простой и отличный вариант решения задачи. Но у меня есть несколько вопросов:
- Подскажите, а на каком этапе данные из urlList потока передаются в urlList формы, т.е. обратно в основной поток?
- Если urlList содержит около 300 адресов, то получается будет создано столько же потоков, а как переписать этот код

Код

for i := 0 to urlList.Count-1 do
    myThrds[i] := TMyThread.Create(i, urlList);

for i := 0 to urlList.Count-1 do
  begin
    myThrds[i].WaitFor;
    myThrds[i].Free;
  end;


чтобы создавалось не более MAX_THREADS потоков?

Автор: Alexeis 22.3.2019, 12:50
pvabox, в данном случае нет 2х списков. Объект TStringList это и есть указатель на объект. Передача объекта это по сути передача указателя. Он тупо общий. 
Код будет устойчиво работает, если не меняется количество элементов списка, поскольку поток производит чтение url без синхронизации. Просто запись результатов осуществляется в деструкторе, а деструктор отрабатывает уже в главном потоке. Поэтому нет никакой необходимости в синхронизации. 
   Самый простой вариант как сделать ограничение это разбить TStringList на несколько списков, чтоб каждый список был меньше MAX_THREADS. И проверять каждый список по очереди. Я бы даже уменьшил количество потоков до 100. Вряд ли при количестве больше 100 будет прирост. Скорее всего накладные расходы на обслуживание 300 потоков перекроют пользу от параллельности. Сетевая карта у вас одна, хорошо если соединение гигабитное и она успеет все это быстро отправить, иначе просто образуется длинная очередь из запросов к серверам. Ваша цель состоит в том, чтобы успеть отправить столько запросов, что они все успеют уйти до тех пор пока первые ответы сервера начнут уже приходить. Когда придут первые ответы процессор переключиться на их обработку.
  Более сложное решение потребует создания пула потоков. Т.е. мы создает примерно 100 потоков и не завершаем их при приходе ответа, а лишь синхронизируем ответ (функция Synchronize), после чего дает этому потоку новый url. В этом случае всегда будут загружены все 100 потоков. 

Автор: pvabox 24.3.2019, 11:05
Alexeis, в коде используется метод WaitFor, который вешает программу, пока не получит ответ. Если в конструкторе прописать
Код

FreeOnTerminate := true;

то как тогда запустить деструктор, если метод Free "в ручную" вызываться не будет?

Автор: pvabox 24.3.2019, 14:21
Результаты тестов - 400 рабочих ссылок (400 потоков) время проверки около 3 секунд на скорости соединения с интернетом 40 Мб/с. Если ссылки не рабочие, то на время проверки программа виснет напрочь, даже окно не двигается.
Полагаю, что в деструкторе необходимо производить проверку, не является ли данный поток последним и если да, то запустить, например процедуру ThreadsCompleted основного потока и продолжить работу программы. Может существует более простой метод? Подскажите пожалуйста.

Автор: pvabox 25.3.2019, 21:59
Мм...,  похоже общаюсь на форуме сам с собой  smile , короче вот что получилось:

Код

unit UThreadHTTP;

interface

uses Classes, IdHTTP;

type
  TThreadHTTP = class(TThread)
    public
      num : integer;
      url : string;
      res : boolean;
      constructor Create(aNum: integer; aUrl: string; aTermEvent: TNotifyEvent);
    protected
      procedure Execute; override;
    private
      function CheckUrl(link: string): boolean;
 end;

implementation

{ ThreadHTTP }

constructor TThreadHTTP.Create(aNum: integer; aUrl: string; aTermEvent: TNotifyEvent);
begin
  inherited Create(true);
  num := aNum;
  url := aUrl;
  FreeOnTerminate := true;
  OnTerminate := aTermEvent;
  Resume;
end;

function TThreadHTTP.CheckUrl(link: string): boolean;
// Проверка link на работоспособность
var IdHTTP: TIdHTTP;
begin
  IdHTTP := TIdHTTP.Create(nil);
  try
    { здесь можно задать параметры IdHTTP }
    IdHTTP.ConnectTimeout := 5000;
    try
      IdHTTP.Head(link);
      result := (IdHTTP.ResponseCode = 200);
    except
      result := false;
    end;
  finally
    IdHTTP.Free;
  end;
end;

procedure TThreadHTTP.Execute;
begin
  res := CheckUrl(url);
end;

end.


Код

uses UThreadHTTP;
var
  urlList : TStringList;   // список URL адресов
  RunThread: integer = 0;  // счетчик запущенных потоков


procedure TMyForm.BtnCheckClick(Sender: TObject);
// Проверка ссылок на работоспособность в потоке
var i: integer;
    AThHTTP : array of TThreadHTTP;
begin
  if RunThread > 0 then exit;  // защита от повторного запуска
  SetLength(AThHTTP, urlList.Count);
  // Запускаем все потоки
  for i := 0 to urlList.Count - 1 do  // запускаем все потоки
    begin
      inc(RunThread);
      AThHTTP[i] := TThreadHTTP.Create(i, urlList[i], ThreadTerm);
    end;
  { результат принимаем в обработчике закрытия потока TMyForm.ThreadTerm }
end;


procedure TMyForm.ThreadTerm(Sender: TObject);
// Обработчик завершенного потока
var   ThHTTP: TThreadHTTP;
begin
  dec(RunThread);
  if ThHTTP.res then urlList[ThHTTP.num] := urlList[ThHTTP.num] + ' +'
                else urlList[ThHTTP.num] := urlList[ThHTTP.num] + ' -';
  // Если поток последний
  if RunThread = 0 then ShowMessage('Check done');
end;


Но появилась новая проблема. При большом количестве запросов истекает время ConnectTimeout и возникает исключение, хотя ссылка рабочая. Придется ограничивать число потоков.

Автор: RAIN666 26.3.2019, 11:45
Я сейчас схожим вопросом занимаюсь.
Почему вы для проверки не используете WinAPI функции? Оно же быстрее должно быть.
что-нибудь типа этого:
Код

function CheckURL(aURL: string) : Integer;
var
  hInet    : HINTERNET;
  hUrl : HINTERNET;
  dwBufferLen, dwIndex : DWORD;
  pErrorCode : array [0..255] of Char;
begin
  Result := 404;
  hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG,
                        nil, nil, 0);
  if Assigned(hInet) then
  begin
    hUrl := InternetOpenUrl(hInet, PChar(aURL), nil, 0,0,0);
    if Assigned(hUrl) then
    begin
      dwIndex := 0;
      dwBufferLen := 20;
      HttpQueryInfo(hUrl, HTTP_QUERY_STATUS_CODE, @pErrorCode, dwBufferLen, dwIndex);
      Result := StrToInt(pErrorCode);
      InternetCloseHandle(hUrl);
      InternetCloseHandle(hInet);
    end else
    InternetCloseHandle(hInet);
  end;
end;

не подойдёт?

Автор: pvabox 26.3.2019, 13:59
Пасиба, RAIN666, я бы написал так:

Код

function CheckURL(aURL: string): Integer;
var
  hInet, hUrl: HINTERNET;
  dwBufferLen, dwIndex, pErrorCode: DWORD;
begin
  result := 404;
  hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(hInet) then
    try
      hUrl := InternetOpenUrl(hInet, PChar(aURL), nil, 0,0,0);
      if Assigned(hUrl) then
        try
          dwIndex := 0;
          dwBufferLen := SizeOf(pErrorCode);
          HttpQueryInfo(hUrl, HTTP_QUERY_STATUS_CODE, @pErrorCode, dwBufferLen, dwIndex);
          result := StrToInt(pErrorCode);
        finally
          InternetCloseHandle(hUrl);
        end;
    finally
      InternetCloseHandle(hInet);
    end;
end;


или так:

Код

function CheckUrl(aURL: WideString): boolean;
const
  C_CLIENT: WideString = 'checkurl';
var
  lSession, lFile: hInternet;
  lBuf, lLen, lIdx: DWORD;
begin
  result := false;
  lSession := InternetOpenW( PWideChar(C_CLIENT), PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0);
  if Assigned(lSession) then
  try
    lFile :=InternetOpenURLW( lSession, PWideChar(aURL), nil, 0 , INTERNET_FLAG_RELOAD, 0);
    if Assigned( lFile ) then
    try
      lIdx := 0;
      lLen := SizeOf(lBuf);
      if HttpQueryInfoW( lFile, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @lBuf, lLen, lIdx) then
        result := (lBuf = 200) or (lBuf = 302);
    finally
      InternetCloseHandle( lFile )
    end;
  finally
    InternetCloseHandle(lSession);
  end;
end;


попробую, потом отпишусь.

Автор: _zorn_ 28.3.2019, 17:45
Цитата(pvabox @  19.3.2019,  06:34 Найти цитируемый пост)
Мне необходимо проверять большой массив ссылок StringList на работоспособность.

Спамеры пошли дальше...  smile

Добавлено через 1 минуту и 58 секунд
Цитата(RAIN666 @  26.3.2019,  18:45 Найти цитируемый пост)
Почему вы для проверки не используете WinAPI функции? Оно же быстрее должно быть.

Мне нравится это "должно быть"  smile 
А сам замерить не хочешь ? Чтобы юзать уродское WinAPI должны быть более веские поводы чем "должно быть".

Автор: pvabox 29.3.2019, 14:49
Цитата(_zorn_ @  28.3.2019,  17:45 Найти цитируемый пост)
Спамеры пошли дальше...

 Почему же сразу спамеры, я для себя решил написать программку типа IPTV M3U Editor, которая работает с IPTV плей-листами и, в том числе проверяет работоспособность ссылок. Вот и обратился с вопросами оптимизации  smile 
С WinAPI дельфя кучу предупреждений выдает.

Автор: pvabox 4.4.2019, 13:24
Провел эксперимент, с WinAPI код в экзешнике на 120 кб меньше, но работает на четверть времени дольше, поэтому остановился на компоненте Indy. Проверку организовал в 20 (параметр задается) потоков, работает очень быстро, программу не вешает вообще, даже прокрутка списка во время проверки не тормозит. Поставленная задача решена полностью!

Вот пример метода проверки ссылок в N потоков, который я использовал:
Код

uses
  UThreadHTTP;

const
  THREAD_MAX = 20;           // максимальное количество рабочих потоков
var
  urlList: TStringList;      // список URL адресов
  CreatTh: integer = 0;      // счетчик созданных потоков
  DistrTh: integer = 0;      // счетчик завершенных потоков
  LimitTh: integer = 0;      // количество рабочих потоков


procedure TMyForm.BtnCheckClick(Sender: TObject);
// Проверка списка ссылок
var
  i: integer;
begin
  if CreatTh > 0 then exit;  // защита от повторного запуска
  if urlList.Count > THREAD_MAX
    then LimitTh := THREAD_MAX
    else LimitTh := urlList.Count;
  // Запуск первых LimitTh потоков
  {остальные потоки формируются по мере завершения этих потоков}
  for i := 0 to LimitTh - 1 do ThreadRun(i);
  { результат принимаем в обработчике завершения потока TMyForm.ThreadTerm }
end;


procedure TMyForm.ThreadRun(elem: integer);
// Создание и запуск потока
var
  ThRun: TThreadHTTP;
begin
  inc(CreatTh);
  ThRun := TThreadHTTP.Create(elem, urlList[elem], ThreadTerm);
  ThRun.Resume;
end;


procedure TMyForm.ThreadTerm(Sender: TObject);
// Обработчик завершения потока
var
  ThHTTP: TThreadHTTP absolute Sender;
begin
  inc(DistrTh);
  // Сохраняем данные из завершенного потока
  if ThHTTP.res then urlList[ThHTTP.num] := urlList[ThHTTP.num] + ' +'
                else urlList[ThHTTP.num] := urlList[ThHTTP.num] + ' -';
  // Зополняем очередь потоков, если есть еще данные
  if CreatTh < urlList.Count
    then ThreadRun(CreatTh)
    else if DistrTh = urlList.Count then
           begin
             // Если поток последний
             CreatTh := 0;
             DistrTh := 0;
             ShowMessage('Check done');
           end;
end;


и модуль потока

Код

unit UThreadHTTP;

interface

uses
  Classes;

type
  TThreadHTTP = class(TThread)
    public
      num : integer;
      url : string;
      res : boolean;
      constructor Create(aNum: integer; aUrl: string; aTermEvent: TNotifyEvent);
    protected
      procedure Execute; override;
    private
      function CheckUrl(link: string): boolean;
 end;

implementation

uses
  IdHTTP;

{ ThreadHTTP }

constructor TThreadHTTP.Create(aNum: integer; aUrl: string; aTermEvent: TNotifyEvent);
begin
  inherited Create(true);
  num := aNum;
  url := aUrl;
  FreeOnTerminate := true;
  OnTerminate := aTermEvent;
end;

function TThreadHTTP.CheckUrl(link: string): boolean;
// Проверка файла на существование
var
  IdHTTP: TIdHTTP;
begin
  IdHTTP := TIdHTTP.Create(nil);
  try
    { здесь можно задать параметры IdHTTP }
    IdHTTP.ConnectTimeout := 10000;
    try
      IdHTTP.Head(link);
      result := (IdHTTP.ResponseCode = 200) or (IdHTTP.ResponseCode = 302);
    except
      result := false;
    end;
  finally
    IdHTTP.Free;
  end;
end;

procedure TThreadHTTP.Execute;
begin
  res := CheckUrl(url);
end;

end.


Всем спасибо за помощь!  smile 

Ну и вот что получилось, может кому пригодиться

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)