Загрузка файла по умолчанию имени с помощью URLDownloadToFile в Delphi

Delphi , Интернет и Сети , URL

При работе с загрузкой файлов в Delphi с помощью функции URLDownloadToFile может возникнуть проблема, когда в URL не указано реальное имя файла. В таком случае может потребоваться указать только путь к файлу, сохранив имя по умолчанию, которое отображается, например, в Проводнике Windows.

Решением данной проблемы может служить отправка отдельного запроса HEAD к URL перед загрузкой файла, чтобы проверить значение заголовка Content-Disposition, если он присутствует. Это можно сделать с помощью функций HttpSendRequest и HttpQueryInfo или любого другого HTTP-библиотеки. После получения информации о имени файла можно сформировать имя файла и загрузить URL в это имя.

Другой вариант - использовать временное имя файла для загрузки, а затем проверить значение заголовка Content-Disposition, если он присутствует, и переименовать файл, если это необходимо. Для получения заголовков ответа из URLDownloadToFile необходимо написать класс, реализующий интерфейсы IBindStatusCallback и IHttpNegotiate COM, и передать экземпляр этого класса в параметр lpfnCB. Заголовки ответа будут переданы в реализацию OnResponse интерфейса IHttpNegotiate.

Пример кода для реализации первого варианта:

uses
  Winapi.Windows,
  Winapi.ActiveX,
  IdGlobal;

function GetFileNameFromUrl(const url: string): string;
var
  hSession: THandle;
  hConnect: THandle;
  hRequest: THandle;
  dwSize: DWORD;
  lpData: Pointer;
  dwDispositionType: DWORD;
  lpFileName: PChar;
begin
  Result := '';
  hSession := WinHttpOpen(nil, nil, nil, nil, 0);
  if hSession <> 0 then
  begin
    hConnect := WinHttpConnect(hSession, PChar(url), 80, 0);
    if hConnect <> 0 then
    begin
      hRequest := WinHttpSendRequest(hConnect, 'HEAD', 0, nil, 0, 0, 0);
      if hRequest <> 0 then
      begin
        if WinHttpReceiveResponse(hRequest, nil) then
        begin
          dwSize := SizeOf(DWORD);
          if WinHttpQueryHeaders(hRequest, WINHTTP_QUERY_CONTENT_DISPOSITION, WINHTTP_HEADER_NAME_BY_INDEX, nil, dwSize, dwDispositionType, lpData) then
          begin
            lpFileName := PChar(lpData);
            if Pos('filename=', lpFileName) > 0 then
              Result := Copy(lpFileName, Pos('filename=') + 8, Length(lpFileName) - Pos('filename=') - 8);
          end;
        end;
      end;
      WinHttpCloseHandle(hRequest);
    end;
    WinHttpCloseHandle(hConnect);
  end;
  WinHttpCloseHandle(hSession);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  url: string;
begin
  url := 'http://example.com/file.txt';
  if GetFileNameFromUrl(url) <> '' then
    URLDownloadToFile(nil, url, 'C:\temp\file.txt', 0, nil);
end;

Пример кода для реализации второго варианта: ```pascal uses Winapi.Windows, Winapi.ActiveX, IdGlobal;

type THttpNegotiate = interface(IUnknown) ['{44878502-44D4-11D0-89C7-00C04FC2AAE4}'] function OnResponse(hRequest: THandle; dwContext: Longint; dwInternetStatus: Longint; lParam: Longint; dwStatusCode: Longint; dwStatusCodeHigh: Longint): Longint; stdcall; end;

THttpNegotiateClass = class(TInterfacedObject, IHttpNegotiate) private fTempFileName: string; public function OnResponse(hRequest: THandle; dwContext: Longint; dwInternetStatus: Longint; lParam: Longint; dwStatusCode: Longint; dwStatusCodeHigh: Longint): Longint; stdcall; property TempFileName: string read fTempFileName; end;

TBindStatusCallback = interface(IUnknown) ['{79EAC9EE-BAF9-11CE-8C82-00AA004BA90B}'] function OnStartBinding(dwReserved: Longint; grfBSCOption: Longint): Longint; stdcall; function OnProgress(grfBSCF: Longint; dwProgress: Longint; dwProgressMax: Longint; dwStatusCode: Longint; dwStatusCodeHigh: Longint): Longint; stdcall; function OnDataAvailable(dwProgress: Longint; dwProgressMax: Longint; dwBufferLength: Longint; lpcBuffer: Pointer): Longint; stdcall; function OnStopBinding(hResult: Longint): Longint; stdcall; function GetPriority(dwReserved: Longint): Longint; stdcall; end;

TBindStatusCallbackClass = class(TInterfacedObject, IBindStatusCallback) private fTempFileName: string; public function OnStartBinding(dwReserved: Longint; grfBSCOption: Longint): Longint; stdcall; function OnProgress(grfBSCF: Longint; dwProgress: Longint; dwProgressMax: Longint; dwStatusCode: Longint; dwStatusCodeHigh: Longint): Longint; stdcall; function OnDataAvailable(dwProgress: Longint; dwProgressMax: Longint; dwBufferLength: Longint; lpcBuffer: Pointer): Longint; stdcall; function OnStopBinding(hResult: Longint): Longint; stdcall; function GetPriority(dwReserved: Longint): Longint; stdcall; property TempFileName: string read fTempFileName; end;

function THttpNegotiateClass.OnResponse(hRequest: THandle; dwContext: Longint; dwInternetStatus: Longint; lParam: Longint; dwStatusCode: Longint; dwStatusCodeHigh: Longint): Longint; begin Result := 0; if dwInternetStatus = INTERNET_STATUS_REDIRECTION

Создано по материалам из источника по ссылке.

Загрузка файла по умолчанию имени с помощью URLDownloadToFile в Delphi

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

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

:: Главная :: URL ::