@会网络的老鼠

涂飞平的博客空间

一个文件下载单元

10 年前 0

很久没有共享出什么好东西。
下面的代码是我在“Sundy注册表监控”系统中版本升级中使用到的一个函数,它可以完成下载任务,并实时更新下载进度显示。

//Sundy注册表监控程序
//版本升级子模块
//Sundy 2006-12-01
unit UpdateDownload;


interface
uses Classes, SysUtils, Windows, Wininet;


const
RTRN_DOWNOK = 0;
RTRN_CANCEL = -1;
RTRN_NOTCONN = -1;
RTRN_DATAERROR = -2;
RTRN_NOTFILE = -3;
RTRN_FSIZEERROR = -4;
RTRN_LOADERROR = -5;
type
TCallbackFunc = function(pos, total: integer; resved: integer): integer; stdcall;


TParamRec = packed record
rurl, rfilename: pchar;
rfunc: TCallbackFunc;
end;
PParamRec = ^TParamRec;


procedure DownloadFileFromUrl(url, filename: pchar; func: TCallbackFunc; const reload: boolean = TRUE); stdcall;
procedure _DownloadFileFrom(url, filename: pchar; func: TCallbackFunc; const reload: boolean = TRUE);


implementation


//利用Wininet库函数来完成Http/Ftp下载,使用非常安全且有效^_^


procedure _DownloadFileFrom(url, filename: pchar; func: TCallbackFunc; const reload: boolean = TRUE);
var
hhandle, hHttpFile: pointer;
fstream: TFileStream;
buf: array[0..255] of char;
result: integer;
bufleng, retsize, posion, totalsize, rsvd: DWORD;
pmem: Pointer;
begin
totalsize := 0;
posion := 0;
fstream := nil;
try
//********************************************************************
//建立Internet连接
//********************************************************************
hhandle := InternetOpen(pchar('SundyRegSpy''s Download Module'), INTERNET_OPEN_TYPE_PRECONFIG,
nil, nil, 0);
if hhandle = nil then
begin
result := RTRN_NOTCONN; //无法连接到主机
exit;
end;
if @func <> nil then
if func(posion, totalsize, -RTRN_NOTCONN) = RTRN_CANCEL then exit;
//********************************************************************
//打开URL
//********************************************************************
hHttpFile := InternetOpenUrl(hhandle, pchar(url), nil, 0, INTERNET_FLAG_NO_AUTO_REDIRECT,
0);
if hHttpFile = nil then
begin
result := RTRN_NOTCONN; //无法连接到主机
exit;
end;
if @func <> nil then
if func(posion, totalsize, -RTRN_NOTCONN) = RTRN_CANCEL then exit;
ZeroMemory(@buf[0], 256);
rsvd := 0;
//********************************************************************
//获取文件信息,存在和大小
//********************************************************************
bufleng := 256;
if not HttpQueryInfo(hHttpFile, HTTP_QUERY_STATUS_CODE, @buf[0], bufleng, rsvd) then
begin
result := RTRN_DATAERROR; //接收数据错误
exit;
end;
if @func <> nil then
if func(posion, totalsize, -RTRN_DATAERROR) = RTRN_CANCEL then exit;
if lstrcmp(@buf[0], pchar('200')) <> 0 then
begin
result := RTRN_NOTFILE; //指定文件不存在
exit;
end;
if @func <> nil then
if func(posion, totalsize, -RTRN_NOTFILE) = RTRN_CANCEL then exit;
ZeroMemory(@buf[0], 256);
bufleng := 256;
if not HttpQueryInfo(hHttpFile, HTTP_QUERY_CONTENT_LENGTH, @buf[0], bufleng, rsvd) then
begin
result := RTRN_FSIZEERROR; //读取文件大小出错
exit;
end;
if @func <> nil then
if func(posion, totalsize, -RTRN_FSIZEERROR) = RTRN_CANCEL then
exit;
totalsize := StrToInt(StrPas(@buf[0]));
//********************************************************************
//开始接收文件
//********************************************************************
if reload then //暂时不考虑断点续传
begin
result := RTRN_LOADERROR; //下载文件过程出现意外错误
GetMem(pmem, 1024);
if pmem = nil then exit;
fstream := TFileStream.Create(filename, fmCreate or fmShareDenyNone);
fstream.Seek(0, 0);
repeat
ZeroMemory(pmem, 1024);
if InternetReadFile(hHttpFile, pMem, 1024, retsize) then
begin
fstream.Write(pMem^, retsize);
posion := posion + retsize;
if @func <> nil then
if func(posion, totalsize, -RTRN_LOADERROR) = RTRN_CANCEL then
exit;
end;
until (retsize < 1024);
end;
result := RTRN_DOWNOK;
finally
if fstream <> nil then fstream.Free;
if pmem <> nil then freeMem(pmem);
if hHttpFile <> nil then
InternetCloseHandle(hHttpFile);
if hhandle <> nil then
InternetCloseHandle(hhandle);
if @func <> nil then
func(posion, totalsize, result);
end;
end;


function DownloadFileStub(P: pointer): DWORD; stdcall;
begin
try
if P = nil then exit;
_DownloadFileFrom(PParamRec(p)^.rurl, PParamRec(p)^.rfilename, PParamRec(p)^.rfunc, TRUE);
except


end;
end;


var
rparam: TParamRec;


procedure DownloadFileFromUrl(url, filename: pchar; func: TCallbackFunc; const reload: boolean = TRUE);
var
thrdid: dword;
begin
rparam.rurl := url;
rparam.rfilename := filename;
rparam.rfunc := func;
Windows.CreateThread(nil, 0, @DownloadFileStub, @rparam, 0, thrdid);
end;


end.

编写评论