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.

Answer 2

这使用聪明的互联网套件来处理下载，我没有在IDE中检查它，所以我不希望它编译，毫无疑问它充满了错误，但它应该足以让你启动。

我不知道为什么你不想使用Indy，但我强烈建议让一些组件来帮助Http下载...真的没有必要重新发明轮子。

interface
type
    TMyDownloadThread= Class(TThread)
    private
        FUrl: String;
        FFileName: String;
        FProgressHandle: HWND;
        procedure GetFile (Url: String; Stream: TStream; ReceiveProgress: TclSocketProgressEvent);
        procedure OnReceiveProgress(Sender: TObject; ABytesProceed, ATotalBytes: Integer);
        procedure SetPercent(Percent: Double);
    protected
        Procedure Execute; Override;
    public
        Constructor Create(Url, FileName: String; PrograssHandle: HWND);
    End;

implementation

constructor TMyDownloadThread.Create(Url, FileName: String; PrograssHandle: HWND);
begin
    Inherited Create(True);
    FUrl:= Url;
    FFileName:= FileName;
    FProgressHandle:= PrograssHandle;
    Resume;
end;


procedure TMyDownloadThread.GetFile(Url: String; Stream: TStream; ReceiveProgress: TclSocketProgressEvent);
var
    Http: TclHttp;
begin
    Http := TclHTTP.Create(nil);
    try
        try
            Http.OnReceiveProgress := ReceiveProgress;
            Http.Get(Url, Stream);
        except
        end;
    finally
        Http.Free;
    end;
end;

procedure TMyDownloadThread.OnReceiveProgress(Sender: TObject; ABytesProceed, ATotalBytes: Integer);
begin
    SetPercent((ABytesProceed / ATotalBytes) * 100);
end;

procedure TMyDownloadThread.SetPercent(Percent: Double);
begin
    PostMessage(FProgressHandle, AM_DownloadPercent, LowBytes(Percent), HighBytes(Percent));
end;

procedure TMyDownloadThread.Execute;
var
    FileStream: TFileStream;
begin
    FileStream := TFileStream.Create(FFileName, fmCreate);
    try
        GetFile(FUrl, FileStream, OnReceiveProgress);
    finally
        FileStream.Free;
    end;        
end;

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

2 个答案: