如何在没有 Indy 组件的情况下使用 Delphi 2009/10 中的线程从 Internet 下载带有进度条的文件？
【问题讨论】：
这使用聪明的互联网套件来处理下载，我没有在 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;
【讨论】：
我也不喜欢用 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.
【讨论】：