Сохранить все картинки TWebBrowser

Delphi , Интернет и Сети , Браузер

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

uses
   UrlMon;

 function DownloadFile(SourceFile, DestFile: string): Boolean;
 begin
   try
     Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0,
       nil) = 0;
   except
     Result := False;
   end;
 end;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   k, p: Integer;
   Source, dest, ext: string;
 begin
   for k := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do
   begin
     Source := WebBrowser1.OleObject.Document.Images.Item(k).Src;
     p := LastDelimiter('.', Source);
     ext := UpperCase(Copy(Source, p + 1, Length(Source)));
     if (ext = 'GIF') or (ext = 'JPG') then
     begin
       p  := LastDelimiter('/', Source);
       dest := ExtractFilePath(ParamStr(0)) + Copy(Source, p + 1,
         Length(Source));
       DownloadFile(Source, dest);
     end;
   end;
 end;

Here is the translation of the text into Russian:

Это программный код на Delphi, который использует компонент TWebBrowser для скачивания всех изображений (GIF и JPG) с веб-страницы. Изображения скачиваются в тот же каталог, где находится исполняемый файл.

Вот разбивка кода:

1. Функция DownloadFile принимает два параметра типа string: SourceFile и DestFile. Она использует функцию UrlDownloadToFile из единицы UrlMon для скачивания файла, указанного в SourceFile, в файл, указанный в DestFile.
2. Процедура Button1Click вызывается при клике кнопки с надписью "Button1".
3. Процедура проходит по всем изображениям на веб-странице с помощью цикла for. Для каждого изображения она извлекает источник URL и проверяет, является ли расширение файла GIF или JPG (без учета регистра).
4. Если расширение файла GIF или JPG, процедура строит путь к файлу назначения, конкатенируя путь каталога исполняемого файла с именем изображения.
5. Затем процедура вызывает функцию DownloadFile для скачивания изображения.

Вот некоторые предложения по улучшению кода:

• Вместо использования hardcoded пути каталога исполняемого файла с помощью ExtractFilePath(ParamStr(0)),consider использовать более надежный метод, например GetEnvironmentVariable('USERPROFILE') или GetEnvironmentVariable('TEMP'), для определения временного каталога.
• Рассмотрите добавление обработки ошибок для случаев, когда скачивание изображения fails. Вы можете использовать блок Except в функции DownloadFile для ловли любых исключений, которые возникнут во время процесса скачивания.
• Если вы хотите скачать все изображения,regardless of their file extension, можно удалить условие if (ext = 'GIF') or (ext = 'JPG') then.
• Рассмотрите использование более эффективного метода для скачивания нескольких файлов в параллельном режиме. Текущая реализация скачивает каждый файл последовательно, что может занять много времени для больших количеств файлов.

Вот альтернативное решение с использованием пула потоков для скачивания изображений в параллельном режиме:

uses
  UrlMon, IdThreadPool;

Тип TImageDownloader = class (TThread) private FSource: string; FDestFile: string; public constructor Create(Source: string; DestFile: string); procedure Execute; end;

Процедура TForm1.Button1Click(Sender: TObject); var k, p: Integer; Source, dest, ext: string; begin for k := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do begin Source := WebBrowser1.OleObject.Document.Images.Item(k).Src; p := LastDelimiter('.', Source); ext := UpperCase(Copy(Source, p + 1, Length(Source))); if (ext = 'GIF') or (ext = 'JPG') then begin p := LastDelimiter('/', Source); dest := ExtractFilePath(ParamStr(0)) + Copy(Source, p + 1, Length(Source)); TImageDownloader.Create(Source, dest).Start; end; end; end;

{ TImageDownloader } constructor TImageDownloader.Create(Source: string; DestFile: string); begin FSource := Source; FDestFile := DestFile; end;

procedure TImageDownloader.Execute; var DownloadHandle: Cardinal; begin DownloadHandle := UrlDownloadToFile(nil, PChar(FSource), PChar(FDestFile), 0, nil); if DownloadHandle <> 0 then RaiseException('Failed to download image'); end; ``` В этом альтернативном решении мы создаем пул потоков с помощью компонента IdThreadPool и присваиваем каждому заданию скачивания изображения отдельный поток. Это позволяет скачивать несколько изображений в параллельном режиме, что может значительно улучшить производительность для больших количеств файлов.

Код на Delphi позволяет сохранять все картинки из веб-браузера TWebBrowser, используя функцию UrlDownloadToFile и перебора элементов документа.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Браузер ::