VPF::Проверка существования ресурса в сети

pvabox

Дата 18.3.2019, 23:34 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 35
Регистрация: 23.8.2009

Репутация: нет
Всего: нет

Уважаемые господа, помогите мне решить одну задачку. Мне необходимо проверять большой массив ссылок 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 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 2
Всего: 459

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

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

pvabox

Дата 19.3.2019, 15:31 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 35
Регистрация: 23.8.2009

Репутация: нет
Всего: нет

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

Alexeis

Дата 20.3.2019, 11:14 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 2
Всего: 459

Да хоспади, тут же не нужно никакой синхронизации даже делать. Передал в конструкторе, вернул в деструкторе. Просто вызвать функцию изнутри 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 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 35
Регистрация: 23.8.2009

Репутация: нет
Всего: нет

Круто! Я б до этого не допер. Спасибо, буду разбираться с кодом.

pvabox

Дата 21.3.2019, 20:43 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 35
Регистрация: 23.8.2009

Репутация: нет
Всего: нет

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 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 2
Всего: 459

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

--------------------

pvabox

Дата 24.3.2019, 11:05 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 35
Регистрация: 23.8.2009

Репутация: нет
Всего: нет

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

Код


FreeOnTerminate := true;

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

Это сообщение отредактировал(а) pvabox - 24.3.2019, 11:25

pvabox

Дата 24.3.2019, 14:21 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 35
Регистрация: 23.8.2009

Репутация: нет
Всего: нет

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

pvabox

Дата 25.3.2019, 21:59 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 35
Регистрация: 23.8.2009

Репутация: нет
Всего: нет

Мм..., похоже общаюсь на форуме сам с собой 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 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 18
Регистрация: 15.2.2019

Репутация: нет
Всего: нет

Я сейчас схожим вопросом занимаюсь.
Почему вы для проверки не используете 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 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 35
Регистрация: 23.8.2009

Репутация: нет
Всего: нет

Пасиба, 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;

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

Это сообщение отредактировал(а) pvabox - 26.3.2019, 14:26

_zorn_

Дата 28.3.2019, 17:45 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1077
Регистрация: 21.8.2007

Репутация: нет
Всего: 12

Цитата(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 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 35
Регистрация: 23.8.2009

Репутация: нет
Всего: нет

Цитата(_zorn_ @ 28.3.2019, 17:45

)

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

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

С WinAPI дельфя кучу предупреждений выдает.

pvabox

Дата 4.4.2019, 13:24 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 35
Регистрация: 23.8.2009

Репутация: нет
Всего: нет

Провел эксперимент, с 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

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

Это сообщение отредактировал(а) pvabox - 4.4.2019, 13:27

Присоединённый файл ( Кол-во скачиваний: 4 )

Test.zip 344,08 Kb

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »