在 Delphi 的线程中从 Internet 下载文件

Question

如何在没有 Indy 组件的情况下使用 Delphi 2009/10 中的线程从带有进度条的 Internet 下载文件？

Answer 1

我也不喜欢用indy，我的原因是它太大了。你也可以使用wininet。我为一个需要小应用程序大小的小项目编写了以下内容。

unit wininetUtils;

interface

uses Windows, WinInet
{$IFDEF KOL}
,KOL
{$ELSE}
,Classes
{$ENDIF}
;

type

{$IFDEF KOL}
  _STREAM = PStream;
  _STRLIST = PStrList;
{$ELSE}
  _STREAM = TStream;
  _STRLIST = TStrings;
{$ENDIF}

TProgressCallback = function (ATotalSize, ATotalRead, AStartTime: DWORD): Boolean;

function DownloadToFile(const AURL: String; const AFilename: String;
  const  AAgent: String = '';
  const AHeaders: _STRLIST = nil;
  const ACallback: TProgressCallback = nil
  ) : LongInt;

function DownloadToStream(AURL: String; AStream: _STREAM;
  const  AAgent: String = '';
  const AHeaders: _STRLIST = nil;
  const ACallback: TProgressCallback = nil
  ) : LongInt;

implementation

function DownloadToFile(const AURL: String; const AFilename: String;
  const  AAgent: String = '';
  const AHeaders: _STRLIST = nil;
  const ACallback: TProgressCallback = nil
  ) : LongInt;
var
  FStream: _STREAM;
begin
  {$IFDEF KOL}
//    fStream := NewFileStream(AFilename, ofCreateNew or ofOpenWrite);
//    fStream := NewWriteFileStream(AFilename);
    fStream := NewMemoryStream;
  {$ELSE}
    fStream := TFileStream.Create(AFilename, fmCreate);
//    _STRLIST = TStrings;
  {$ENDIF}
  try
    Result := DownloadToStream(AURL, FStream, AAgent, AHeaders, ACallback);
    fStream.SaveToFile(AFilename, 0, fStream.Size);
  finally
    fStream.Free;
  end;
end;

function StrToIntDef(const S: string; Default: Integer): Integer;
var
  E: Integer;
begin
  Val(S, Result, E);
  if E <> 0 then Result := Default;
end;

function DownloadToStream(AURL: String; AStream: _STREAM;
  const  AAgent: String = '';
  const AHeaders: _STRLIST = nil;
  const ACallback: TProgressCallback = nil
  ) : LongInt;

  function _HttpQueryInfo(AFile: HINTERNET; AInfo: DWORD): string;
  var
    infoBuffer: PChar;
    dummy: DWORD;
    err, bufLen: DWORD;
    res: LongBool;
  begin
    Result := '';
    bufLen := 0;
    dummy := 0;
    infoBuffer := nil;
    res := HttpQueryInfo(AFile, AInfo, infoBuffer, bufLen, dummy);
    if not res then
    begin
      // Probably working offline, or no internet connection.
      err := GetLastError;
      if err = ERROR_HTTP_HEADER_NOT_FOUND then
      begin
        // No headers
      end else if err = ERROR_INSUFFICIENT_BUFFER then
      begin
        GetMem(infoBuffer, bufLen);
        try
          HttpQueryInfo(AFile, AInfo, infoBuffer, bufLen, dummy);
          Result := infoBuffer;
        finally
          FreeMem(infoBuffer);
        end;
      end;
    end;
  end;

  procedure ParseHeaders;
  begin

  end;


const
  BUFFER_SIZE = 16184;
var
  buffer: array[1..BUFFER_SIZE] of byte;
  Totalbytes, Totalread, bytesRead, StartTime: DWORD;
  hInet: HINTERNET;
  reply: String;
  hFile: HINTERNET;
begin
  Totalread := 0;
  Result := 0;
  hInet := InternetOpen(PChar(AAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil,nil,0);
  if hInet = nil then Exit;

  try
    hFile := InternetOpenURL(hInet, PChar(AURL), nil, 0, 0, 0);
    if hFile = nil then Exit;
    StartTime := GetTickCount;
    try
      if AHeaders <> nil then
      begin
        AHeaders.Text := _HttpQueryInfo(hFile, HTTP_QUERY_RAW_HEADERS_CRLF);
        ParseHeaders;
      end;

      Totalbytes := StrToIntDef(_HttpQueryInfo(hFile,
        HTTP_QUERY_CONTENT_LENGTH), 0);

      reply := _HttpQueryInfo(hFile, HTTP_QUERY_STATUS_CODE);
      if reply = '200' then
        // File exists, all ok.
        result := 200
      else if reply = '401' then
        // Not authorised. Assume page exists,
        // but we can't check it.
        result := 401
      else if reply = '404' then
        // No such file.
        result := 404
      else if reply = '500' then
        // Internal server error.
        result := 500
      else
        Result := StrToIntDef(reply, 0);

      repeat
        InternetReadFile(hFile, @buffer, SizeOf(buffer), bytesRead);
        if bytesRead > 0 then
        begin
          AStream.Write(buffer, bytesRead);
          Inc(Totalread, bytesRead);
          if Assigned(ACallback) then
          begin
            if not ACallback(TotalBytes, Totalread, StartTime) then Break;
          end;
          Sleep(10);
        end;
    //    BlockWrite(localFile, buffer, bytesRead);
      until bytesRead = 0;

    finally
      InternetCloseHandle(hFile);
    end;
  finally
    InternetCloseHandle(hInet);
  end;
end;


end.