unit UrlDownload;
interface
uses
Windows, Activex,SysUtils, Variants, Classes, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, UrlMon,WinINet;
type
TDownloadWin = class(TForm)
StartB: TButton;
StopB: TButton;
Label4: TLabel;
Label1: TLabel;
Label3: TLabel;
Source: TComboBox;
Dest: TEdit;
DownProgressBar: TProgressBar;
procedure StartBClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure StopBClick(Sender: TObject);
private
NetError:bool;
public
end;
//定义回调接口（COM接口）类
type TCallback = class(TObject,IBindStatusCallback)
protected
FRefCount: Integer;
//定义COM 接口中一个 IUnknown
function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
public
//重载IBindStatusCallback中的方法
function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
function GetPriority(out nPriority): HResult; stdcall;
function OnLowResource(reserved: DWORD): HResult; stdcall;
function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
szStatusText: LPCWSTR): HResult; stdcall;
function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
stgmed: PStgMedium): HResult; stdcall;
function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
end;
var
DownloadWin: TDownloadWin;
bsc: TCallback;
UCancel:bool; //是否停止下载标记量
implementation
{$R *.dfm}
//---------------------------------------------------------------
function TCallback.QueryInterface(const IID: TGUID;
out Obj): Integer;
begin
if GetInterface(IID, Obj) then Result := S_OK
else Result := E_NOINTERFACE;
end;
//--------------------------------------------------------------
function TCallback._AddRef: Integer;
begin
Inc(FRefCount);
Result := FRefCount;
end;
//--------------------------------------------------------------
function TCallback._Release: Integer;
begin
Dec(FRefCount);
Result := FRefCount;
end;
//--------------------------------------------------------------
function TCallback.GetBindInfo(out grfBINDF: DWORD;
var bindinfo: TBindInfo): HResult;
begin
Result := E_NOTIMPL;
end;
//--------------------------------------------------------------
function TCallback.GetPriority(out nPriority): HResult;
begin
//可根据实际需要修改函数体
Result := E_NOTIMPL;
end;
//--------------------------------------------------------------
function TCallback.OnDataAvailable(grfBSCF, dwSize: DWORD;
formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
//可根据实际需要修改函数体
Result := E_NOTIMPL;
end;
//--------------------------------------------------------------
function TCallback.OnLowResource(reserved: DWORD): HResult;
begin
//可根据实际需要修改函数体
Result := E_NOTIMPL;
end;
//--------------------------------------------------------------
function TCallback.OnObjectAvailable(const iid: TGUID;
punk: IUnknown): HResult;
begin
//可根据实际需要修改函数体
Result := E_NOTIMPL;
end;
//--------------------------------------------------------------
function TCallback.OnStartBinding(dwReserved: DWORD;
pib: IBinding): HResult;
begin
//可根据实际需要修改函数体
Result := E_NOTIMPL;
end;
//--------------------------------------------------------------
function TCallback.OnStopBinding(hresult: HResult;
szError: LPCWSTR): HResult;
begin
if DownloadWin.NetError and not UCancel then //如果下载过程被中断则
begin
showmessage('网络出错或文件不存在，无法继续下载');
DownloadWin.Label3.Caption:='文件大小:';
DownloadWin.StartB.Enabled:=true;
end;
Result := S_OK;
end;
//--------------------------------------------------------------
function TCallback.OnProgress(ulProgress, ulProgressMax,
ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin
case ulStatusCode of
BINDSTATUS_FINDINGRESOURCE : DownloadWin.Label3.Caption:='已找到网站';
BINDSTATUS_CONNECTING: DownloadWin.Label3.Caption :='正在连接网站';
BINDSTATUS_BEGINDOWNLOADDATA:
DownloadWin.Label3.Caption:= '文件大小: '+floattostr(ulProgressMax*0.001)+' KB';
BINDSTATUS_DOWNLOADINGDATA: //正在下载中
begin
if ulProgressMax > 0 then DownloadWin.DownProgressBar.Position := (ulProgress * 100 div ulProgressMax);
Result := S_OK;
if (UCancel) then //如果停止下载
begin
Result:=E_ABORT ; //返回异常结束标记值
showmessage('下载失败');
exit;
end;
end;
BINDSTATUS_ENDDOWNLOADDATA: //下载正常结束
begin
DownloadWin.DownProgressBar.Position:=100;
DownloadWin.Label3.Caption:='下载完毕';
DownloadWin.NetError:=false;
DownloadWin.StartB.Enabled:=true;
end;
end;
Application.ProcessMessages;
end;
//--------------------------------------------------------------
procedure TDownloadWin.StartBClick(Sender: TObject);
begin
DeleteUrlCacheEntry(pchar(trim(Source.Text))); //从本地临时目录中删除同一文件
NetError:=true;
UCancel:=false;
StartB.Enabled:=false;
DownProgressBar.Position:=0;
DownloadWin.Label3.Caption:='文件大小:';
//调用文件下载函数，注意第5个参数的设置
if UrlDownloadToFile(nil, PChar(trim(Source.text)), PChar(trim(Dest.text)), 0, bsc)=S_OK then StartB.Enabled:=true;
end;
//--------------------------------------------------------------
procedure TDownloadWin.StopBClick(Sender: TObject);
begin
UCancel:=true; //停止下载
StartB.Enabled:=true; //开始按钮变实
end;
//--------------------------------------------------------------
procedure TDownloadWin.FormCreate(Sender: TObject);
begin
bsc := TCallback.Create; //创建一个回调接口对象
end;
end.
