-1

我正在使用 winInet 功能从互联网下载文件，这里有一个问题：如何恢复中止的下载？有没有非常简单的样本？我读了http://www.clevercomponents.com/articles/article015/resuming.asp但它不起作用！我只知道必须使用 InternetSetFilePointer 和 HttpSendRequest 但我不知道该怎么做。知道吗？谢谢大家

4

1 回答 1

0

我有这个完整的解决方案。试试看。它是在 Delphi 7 中编写的，我希望它可以在更多版本的 Delphi 中工作。

unit IEDownloadFile;

interface

uses
  classes, windows;
{(*}
type
  TDownloadStatus =
  (
    dsNULL                , dsFindingresource         , dsConnecting              , dsRedirecting,
    dsBegindownloaddata   , dsDownloadingdata         , dsEnddownloaddata         , dsBegindownloadcomponents,
    dsInstallingcomponents, dsEnddownloadcomponents   , dsUsingcachedcopy         , dsSendingrequest,
    dsClassidavailable    , dsMimetypeavailable       , dsCachefilenameavailable  , dsBeginsyncoperation,
    dsEndsyncoperation    , dsBeginuploaddata         , dsUploadingdata           , dsEnduploadingdata,
    dsProtocolclassid     , dsEncoding                , dsVerfiedmimetypeavailable, dsClassinstalllocation,
    dsDecoding            , dsLoadingmimehandler      , dsContentdispositionattach, dsFilterreportmimetype,
    dsClsidcaninstantiate , dsIunknownavailable       , dsDirectbind              , dsRawmimetype,
    dsProxydetecting      , dsAcceptranges
  );

const
  StatusStrArray: array[TDownloadStatus] of String =
  (
    'NULL'                 , 'Finding resource'       , 'Connecting'                 , 'Redirecting',
    'Begin download data'  , 'Downloading data'       , 'End download data'          , 'Begin download components',
    'Installing components', 'End download components', 'Using cached copy'          , 'Sending request',
    'Classid available'    , 'Mime type available'    , 'Cache filename available'   , 'Begin sync operation',
    'End sync operation'   , 'Begin upload data'      , 'Uploading data'             , 'End uploading data',
    'Protocol classid'     , 'Encoding'               , 'Verfied mime type available', 'Class install location',
    'Decoding'             , 'Loading mime handler'   , 'Content disposition attach' , 'Filter report mime type',
    'Clsid can instantiate', 'Iunknown available'     , 'Direct bind'                , 'Raw mime type',
    'Proxy detecting'      , 'Accept ranges'
    );

type
  TLWOnDownloading = procedure(Sender: TObject; size: Integer; var cancel: Boolean) of object;
  TLWDOnProgress   = procedure(Sender: TObject; position, max: Integer; status: TDownLoadStatus; statusStr, extraInfoStr: string; var cancel: Boolean) of object;
  TOnDownloadEnded = procedure(Sender: TObject; aborted, Error: Boolean; errorCode: HResult; ErrorStr: string) of object;
{*)}

type
  TIEDownLoader = class(TComponent)
  private
    FUrl: string;
    FOnProgress: TLWDOnProgress;
    FOnBegin: TNotifyEvent;
    FOnLowResources: TNotifyEvent;
    FOnEnd: TOnDownloadEnded;
    FDestinationFolder: string;
    //      FTriggeredDownloadingEvent: boolean;
    FLWOnDownloading: TLWOnDownloading;
    FFilePath: string;
    FCaching: Boolean;
    procedure SetUrl(const Value: string);
    procedure SetFilePath(const Value: string);
    procedure SetCaching(const Value: Boolean);
  protected
    procedure doLowREsources; virtual;
    procedure doBegin; virtual;
    procedure doEnded(aborted, error: Boolean; errorCode: HResult; statusStr: string); virtual;
    procedure doProgress(position, max: Integer; status: TDownLoadStatus; statusStr, extraInfoStr: string; var cancel: Boolean); virtual;
    procedure doDownloading(size: Integer; var cancel: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    function Execute: Boolean; virtual;
  published
    //use Caching
    property Caching: Boolean read FCaching write SetCaching;
    //where to get data
    property Url: string read FUrl write SetUrl;
    //where to put it
    property DestinationFolder: string read FDestinationFolder write FDestinationFolder;
    //filepath overrides destinationFolder and the filename in the url
    property FilePath: string read FFilePath write SetFilePath;
    //process has begun - simple notification
    property OnBegin: TNotifyEvent read FOnBegin write FOnBegin;
    //is able to download (in fact is downloading like IE download dialog)
    //like IE you oppotunity to cancel (cancel:=true or exception);
    //only triggered once (at begining of download)
    property OnDownloading: TLWOnDownloading read FLWOnDownloading write FLWOnDownloading;
    //download progressing, also triggered when OnDownloading is triggered. Cancel=false by default
    property OnProgress: TLWDOnProgress read FOnProgress write FOnProgress;
    //completed : indicates success through Error parameter (file probably gets removed by windows)
    property OnEnd: TOnDownloadEnded read FOnEnd write FOnEnd;
  end;

function ExtractObjectName(url: string): string;

{$EXTERNALSYM DeleteUrlCacheEntryA}
function DeleteUrlCacheEntryA(pszUrl: PAnsiChar): BOOL; stdcall;
{$EXTERNALSYM DeleteUrlCacheEntryW}
function DeleteUrlCacheEntryW(pszUrl: PWideChar): BOOL; stdcall;
{$EXTERNALSYM DeleteUrlCacheEntry}
function DeleteUrlCacheEntry(pszUrl: PChar): BOOL; stdcall;

procedure Register;

implementation

uses
  HttpApp, UrlMon, SysUtils, ActiveX;

type
  TUrlCallBack = class(TInterfacedObject, IBindStatusCallBack)
  private
    FErrorCode: HResult;
    FExcepted: Boolean;
    FExceptStr: string;
    FExceptionType: ExceptClass;
    FOwner: TIEDownLoader;
    FHResultVal: HRESULT;
    FTriggeredDownloadingEvent: Boolean;
    FCaching: Boolean;
    procedure SetHResultVal(const Value: HRESULT);
    procedure handleException(e: Exception);
    procedure SetCaching(const Value: Boolean);
  public
    procedure Init(Owner: TIEDownLoader);
    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;
    property Caching: Boolean read FCaching write SetCaching;
    property ErrorCode: HResult read FErrorCode;
    property Excepted: Boolean read FExcepted;
    property ExceptStr: string read FExceptStr;
    property ExceptionType: ExceptClass read FExceptionType;
    property HResultVal: HRESULT read FHResultVal write SetHResultVal;
  end;

  { TUrlCallBack }

function TUrlCallBack.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult;
begin
  Result := E_NOTIMPL;
  if not FCaching then
  begin
    DeleteUrlCacheEntry(Pointer(FOwner.FUrl));
    Result := S_OK;
  end;
end;

function TUrlCallBack.GetPriority(out nPriority): HResult;
begin
  Result := E_NOTIMPL;
end;

procedure TUrlCallBack.handleException(e: Exception);
begin
  FExcepted := True;
  FExceptStr := e.message;
  FExceptionType := ExceptClass(e.ClassType);
end;

procedure TUrlCallBack.Init(Owner: TIEDownLoader);
begin
  FOwner := owner;
end;

function TUrlCallBack.OnDataAvailable(grfBSCF, dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
  Result := E_NOTIMPL;
end;

function TUrlCallBack.OnLowResource(reserved: DWORD): HResult;
begin
  Result := S_OK;
  try
    FOwner.doLowREsources;
  except
    on e: Exception do
    begin
      handleException(e);
      Result := E_FAIL;
    end;
  end;
end;

function TUrlCallBack.OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult;
begin
  Result := E_NOTIMPL;
end;

function TUrlCallBack.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
var
  cancel: Boolean;
begin
  Result := s_OK;
  cancel := False;
  try
    try
      if (ulStatusCode = 5) and (not FTriggeredDownloadingEvent) then
      begin
        Fowner.doDownloading(ulProgressMax, cancel);
        FTriggeredDownloadingEvent := True;
        if cancel then
          Exit;
      end;

      if ulStatusCode > ulong(high(TDownloadStatus)) then
        ulStatusCode := 0;

      FOwner.doProgress(ulprogress, ulProgressmax, TDownloadStatus(ulstatusCode), statusStrArray[TDownloadStatus(ulstatusCode)], string(szStatusText), cancel);
    except
      on e: Exception do
      begin
        Cancel := True;
        handleException(e);
      end;
    end;
  finally
    if Cancel then
      Result := E_ABORT;
  end;
end;

function TUrlCallBack.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin
  Result := S_OK;
  try
    Fowner.doBegin;
  except
    on e: Exception do
    begin
      handleException(e);
      Result := E_INVALIDARG;
    end;
  end;
end;

function TUrlCallBack.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;
begin
  Result := S_OK;
  FHREsultVal := HResult;
  try
    FOwner.doEnded(HResult = E_ABORT, (HResult <> 1) and (HResult <> E_ABORT), FHREsultVal, sysErrorMessage(hresult))
  except
    on e: Exception do
      HandleException(e);
  end;
end;

procedure TUrlCallBack.SetCaching(const Value: Boolean);
begin
  FCaching := Value;
end;

procedure TUrlCallBack.SetHResultVal(const Value: HRESULT);
begin
  FHResultVal := Value;
end;

{ TIEDownLoader }

procedure TIEDownLoader.doEnded(Aborted, Error: Boolean; ErrorCode: HResult; StatusStr: string);
begin
  if Assigned(FOnEnd) then
    FOnEnd(Self, Aborted, Error, ErrorCode, StatusStr);
end;

procedure TIEDownLoader.doLowREsources;
begin
  if Assigned(FOnLowResources) then
    FOnLowResources(Self);
end;

procedure TIEDownLoader.doProgress(Position, Max: Integer; Status: TDownLoadStatus; StatusStr, ExtraInfoStr: string; var Cancel: Boolean);
begin
  if Assigned(FOnProgress) then
    FOnProgress(Self, Position, Max, Status, StatusStr, ExtraInfoStr, Cancel);
end;

procedure TIEDownLoader.doBegin;
begin
  if Assigned(FOnBegin) then
    FonBegin(Self);
end;

function TIEDownLoader.Execute: Boolean;
var
  HttpFields: TStringList;
  CallBack: TUrlCallBack;
  CallBackI: IBindStatusCallBack;
  hr: HRESULT;
begin
  if FDestinationFolder = '' then
    FDestinationFolder := ExtractFilePath(ParamStr(0));

  CallBackI := nil;
  HttpFields := nil;
  Result := False;
  CoInitialize(nil); //allow multithreading

  try
    try
      HttpFields := TStringList.Create;
      CallBack := TUrlCallBack.Create;
      CallBack.Caching := FCaching;
      CallBackI := CallBack; //for avoiding premature free
      CallBack.Init(Self);

      ExtractHttpFields(['/'], [], Pointer(httpDecode(Trim(FUrl))), HttpFields, False);

      if FFilePath = '' then
        hr := UrlDownloadToFile(nil, Pointer(FUrl), Pointer(IncludeTrailingPathDelimiter(Trim(FDestinationFolder)) + HttpFields[HttpFields.Count - 1]), 0, CallBackI)
      else
      begin
        SetLength(FFilePath, MAX_PATH + 1);
        hr := UrlDownloadToFile(nil, Pointer(FUrl), Pointer(FFilePath), URLOSTRM_GETNEWESTVERSION, CallBackI);
      end;

      if hr = E_OUTOFMEMORY then
        raise EOSError.Create(SysErrorMessage(hr));

      Result := hr = S_OK;

      if CallBack.excepted then
        raise CallBack.ExceptionType.Create(CallBack.FExceptStr);
    finally
      CallBackI := nil;
    end;
  finally
    HttpFields.Free;
    couninitialize;
  end;
end;

procedure TIEDownLoader.SetUrl(const Value: string);
begin
  FUrl := Value;
end;

procedure TIEDownLoader.doDownloading(size: Integer; var cancel: Boolean);
begin
  if Assigned(FLWOnDownloading) then
    FLWOnDownloading(Self, size, cancel);
end;

function ExtractObjectName(url: string): string;
var
  HttpFields: TStringList;
begin
  HttpFields := TStringList.Create;
  try
    ExtractHttpFields(['/'], [], Pointer(httpDecode(Trim(Url))), HttpFields, False);
    Result := HttpFields[HttpFields.Count - 1]
  finally
    HttpFields.Free;
  end;
end;

procedure Register;
begin
  RegisterComponents('Borrisholt', [TIEDownLoader]);
end;

procedure TIEDownLoader.SetFilePath(const Value: string);
begin
  FFilePath := Value;
end;

constructor TIEDownLoader.Create(AOwner: TComponent);
begin
  inherited;
  FDestinationFolder := '';
  FFilePath := '';
  FCaching := False;
end;

procedure TIEDownLoader.SetCaching(const Value: Boolean);
begin
  FCaching := Value;
end;

const
  WinNetLib = 'Wininet.DLL';

function DeleteUrlCacheEntryA; external WinNetLib name 'DeleteUrlCacheEntryA';
function DeleteUrlCacheEntryW; external WinNetLib name 'DeleteUrlCacheEntryW';
function DeleteUrlCacheEntry; external WinNetLib name 'DeleteUrlCacheEntry';

end.

这是我使用该组件时的她：

首先是 DFM 文件：

    对象 Form1：TForm1
      左 = 311
      顶部 = 153
      宽度 = 745
      身高 = 248
      颜色 = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      字体颜色 = clWindowText
      字体高度 = -11
      Font.Name = 'MS 无衬线'
      字体样式 = []
      OldCreateOrder = False
      OnCreate = FormCreate
      PixelsPerInch = 96
      文本高度 = 13
      对象标签2：TLabel
        左 = 8
        顶部 = 117
        宽度 = 32
        高度 = 13
        标题 = '标签 2'
      结尾
      对象标签3：TLabel
        左 = 8
        顶部 = 132
        宽度 = 32
        高度 = 13
        标题 = '标签 3'
      结尾
      对象标签4：TLabel
        左 = 8
        顶部 = 147
        宽度 = 32
        高度 = 13
        标题 = '标签 4'
      结尾
      对象Label12：TLabel
        左 = 96
        顶部 = 147
        宽度 = 38
        高度 = 13
        标题 = '标签 12'
      结尾
      对象Label11：TLabel
        左 = 96
        顶部 = 132
        宽度 = 38
        高度 = 13
        标题 = '标签 11'
      结尾
      对象Label10：TLabel
        左 = 96
        顶部 = 117
        宽度 = 38
        高度 = 13
        标题 = '标签 10'
      结尾
      对象 ProgressBar1：TProgressBar
        左 = 8
        顶部 = 48
        宽度 = 713
        身高 = 57
        平滑 = 真
        TabOrder = 0
      结尾
      对象备忘录1：TMemo
        左 = 304
        顶部 = 120
        宽度 = 417
        身高 = 89
        TabOrder = 1
      结尾
      对象取消：TButton
        左 = 8
        顶部 = 8
        宽度 = 75
        高度 = 25
        标题 = '取消'
        TabOrder = 2
        OnClick = CANCELClick
      结尾
      对象 Timer1：TTimer
        间隔 = 500
        OnTimer = Timer1Timer
        左 = 32
        顶部 = 152
      结尾
    结尾

然后是pas文件：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, IEDownloadFile,
  StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label12: TLabel;
    Label11: TLabel;
    Label10: TLabel;
    Memo1: TMemo;
    Timer1: TTimer;
    CANCEL: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure CANCELClick(Sender: TObject);
  private
    STime: TDateTime;
    BytesToTransfer: Integer;
    CancelTransfer : Boolean;

    { Private declarations }
    procedure DownLoaderBegin(Sender : TObject);
    procedure DownLoaderDownloading(Sender: TObject; size: Integer; var cancel: Boolean);
    procedure DownLoaderProgress(Sender: TObject; position, max: Integer; status: TDownLoadStatus; statusStr, extraInfoStr: String; var cancel: Boolean);
    procedure DownLoaderDownloadEnded(Sender: TObject; aborted, Error: Boolean; errorCode: HResult; ErrorStr: String);
  public
    { Public declarations }
    DownLoader : TIEDownLoader;
  end;

var
  Form1: TForm1;

implementation
uses
  Math;
{$R *.DFM}

var
  AverageSpeed: Double = 0;

procedure TForm1.DownLoaderBegin(Sender: TObject);
begin
  ProgressBar1.Position := 0;
  STime := Now;
  CancelTransfer := false;
end;

procedure TForm1.DownLoaderDownloadEnded(Sender: TObject; aborted, Error: Boolean; errorCode: HResult; ErrorStr: String);
begin
  Label10.Caption := '';
  Label11.Caption := '';
  Label12.Caption := '';
  ProgressBar1.Position := 0;
end;

procedure TForm1.DownLoaderDownloading(Sender: TObject; size: Integer; var cancel: Boolean);
begin
end;

function ConvertBytes(i: Int64): string;
begin
  if i < Power(1024, 1) then
    Result := IntToStr(i) + ' Bytes';

  if (i >= Power(1024, 1)) and (i < Power(1024, 2)) then
    Result := Format('%7.2f', [i / Power(1024, 1)]) + ' KB';

  if (i >= Power(1024, 2)) and (i < Power(1024, 3)) then
    Result := Format('%7.2f', [i / Power(1024, 2)]) + ' MB';

  if (i >= Power(1024, 3)) and (i < Power(1024, 4)) then
    Result := Format('%7.2f', [i / Power(1024, 3)]) + ' GB';

  Result := Trim(Result);
end;

Function FormatSeconds(TotalSeconds : Double; WholeSecondsOnly : Boolean = True; DisplayAll : Boolean = False): String;
Var
  Centuries,Years,Months,Minutes,Hours,Days,Weeks : Word;
  Secs : Double;
  TmpStr: Array[1..8] of String;
  SecondsPerCentury: Int64;
  FS : String;
begin
  (** Suppress the decimal part if Whole Seconds Only is desired **)
  If WholeSecondsOnly then
    FS:='%.0f'
  else
    FS:='%.2f';

  (** Split the calculation to avoid an overflow **)
  SecondsPerCentury:= 36500*24;
  SecondsPerCentury:= SecondsPerCentury * 3600;
  SecondsPerCentury:= SecondsPerCentury + ( {4 Leap years per century} 4 * 24 * 3600);
  (** Get centuries **)
  Centuries:=Trunc(TotalSeconds / SecondsPerCentury);
  TotalSeconds:=TotalSeconds-(Centuries * SecondsPerCentury);

  (** Get years **)
  Years:=Trunc(TotalSeconds / (SecondsPerCentury / 100));
  TotalSeconds:=TotalSeconds-(Years * (SecondsPerCentury / 100));

  (** Get months **)
  Months:=Trunc(TotalSeconds / (SecondsPerCentury / 1200));
  TotalSeconds:=TotalSeconds-(Months * (SecondsPerCentury / 1200));

  (** Get weeks **)
  Weeks:=Trunc(TotalSeconds / (24 * 3600 * 7));
  TotalSeconds:=TotalSeconds-(Weeks * (24 * 3600 * 7));

  (** Get days **)
  Days:=Trunc(TotalSeconds / (24 * 3600));
  TotalSeconds:=TotalSeconds-(Days * (24 * 3600));

  (** Get Hours **)
  Hours:=Trunc(TotalSeconds / 3600);
  TotalSeconds:=TotalSeconds-(Hours * 3600);

  (** Get minutes **)
  Minutes:=Trunc(TotalSeconds / 60);
  TotalSeconds:=TotalSeconds-(Minutes * 60);

  (** Get seconds **)
  If WholeSecondsOnly then
    Secs:=Trunc(TotalSeconds)
  else
    Secs:=TotalSeconds;

  (** Deal with single values **)
  if Centuries = 1 then
    TmpStr[1] := ' Century, '
  else
    TmpStr[1] := ' Centuries, ';

  if Years = 1 then
    TmpStr[2] := ' Year, '
  else
    TmpStr[2] := ' Years, ';

  if Months = 1 then
    TmpStr[3] := ' Month, '
  else
    TmpStr[3] :=' Months, ';

  if Weeks = 1 then
    TmpStr[4] := ' Week, '
  else
    TmpStr[4] := ' Weeks, ';

  if Days = 1 then
    TmpStr[5] := ' Day, '
  else
    TmpStr[5] := ' Days, ';

  if Hours = 1 then
    TmpStr[6] :=' Hour, '
  else
    TmpStr[6]:=' Hours, ';

  if Minutes = 1 then
    TmpStr[7] :=' Minute, '
  else
    TmpStr[7]:=' Minutes, ';

  if Secs = 1 then
    TmpStr[8] :=' Second.'
  else
    TmpStr[8]:=' Seconds.';

  If DisplayAll then
   Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s', [Centuries,TmpStr[1],Years,TmpStr[2],Months,TmpStr[3],Weeks,TmpStr[4],Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]])
  else
    begin
      if Centuries >= 1 then
       begin
         Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s', [Centuries,TmpStr[1],Years,TmpStr[2],Months,TmpStr[3],Weeks,TmpStr[4],Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
         Exit;
       end;

      if Years >= 1 then
       begin
         Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',[Years,TmpStr[2],Months,TmpStr[3],Weeks,TmpStr[4],Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
         Exit;
       end;

      if Months >= 1 then
       begin
         Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s',[Months,TmpStr[3],Weeks,TmpStr[4],Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
         Exit;
       end;

      if Weeks >= 1 then
       begin
         Result:= Format('%.0d%s%.0d%s%.0d%s%.0d%s' + FS + '%s', [Weeks,TmpStr[4],Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
         Exit;
       end;

      if Days >= 1 then
       begin
         Result:= Format('%.0d%s%.0d%s%.0d%s' + FS + '%s', [Days,TmpStr[5],Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
         Exit;
       end;

      if Hours >= 1 then
       begin
         Result:= Format('%.0d%s%.0d%s' + FS + '%s', [Hours,TmpStr[6],Minutes,TmpStr[7],Secs,TmpStr[8]]);
         Exit;
       end;

      if Minutes >= 1 then
       begin
         Result:= Format('%.0d%s' + FS + '%s', [Minutes,TmpStr[7],Secs,TmpStr[8]]);
         exit;
       end;

      Result:= Format(FS + '%s', [Secs,TmpStr[8]]);
    end;
end;

procedure TForm1.DownLoaderProgress(Sender: TObject; Position, max: Integer; status: TDownLoadStatus; statusStr, extraInfoStr: String;  var cancel: Boolean);
Var
  S, T : String;
  TotalTime: TDateTime;
  H, M, Sec, MS: Word;
  DLTime: Double;
begin
  Cancel := CancelTransfer;

  if Cancel then
    exit;

  ProgressBar1.Max := max;
  ProgressBar1.Position := position;
  BytesToTransfer  := max;

  if BytesToTransfer = 0 then //No Update File
    exit;

  TotalTime :=  Now - STime;
  DecodeTime(TotalTime, H, M, Sec, MS);
  Sec := Sec + M * 60 + H * 3600;
  DLTime := Sec + MS / 1000;
  if DLTime > 0 then
    AverageSpeed := (Position / 1024) / DLTime;

  if AverageSpeed > 0 then
  begin
    T := Label11.Caption;
    Sec := Trunc(((BytesToTransfer - Position) / 1024) / AverageSpeed);
    S := FormatSeconds(Sec);
    Label3.Caption := 'Time remaining';
    Label11.Caption := ' : ' + s;
  end;

  Label2.Caption := 'Transfering';
  Label10.Caption := ' : ' + ConvertBytes(BytesToTransfer);
  S := FormatFloat('0 KB/s', AverageSpeed);
  Label4.Caption := 'Download speed';
  Label12.Caption := ' : ' + S;
  ProgressBar1.Position := Position;

  if Memo1.Lines.IndexOf(statusStr) = -1 then
    Memo1.Lines.Add(statusStr);

  if T <>  S then
    Application.ProcessMessages;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Label2.Caption := 'Transfering';
  Label3.Caption := 'Time remaining';
  Label4.Caption := 'Download speed';
  Label10.Caption := '';
  Label11.Caption := '';
  Label12.Caption := '';
  ProgressBar1.Position := 0;
  Timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := false;
  DownLoader := TIEDownLoader.Create(Self);
  DownLoader.Caching := false;
  DownLoader.OnBegin := DownLoaderBegin;
  DownLoader.OnDownloading := DownLoaderDownloading;
  DownLoader.OnProgress := DownLoaderProgress;
  DownLoader.OnEnd := DownLoaderDownloadEnded;
  DownLoader.Url := 'http://download.microsoft.com/download/c/d/f/cdfd58f1-3973-4c51-8851-49ae3777586f/MDAC_TYP.EXE';
  DownLoader.Url := 'http://download.microsoft.com/download/1/2/7/127c5938-d36a-4405-9df1-f00d57495652/WindowsServer2003-KB889101-SP1-x86-ENU.exe';
  DownLoader.Execute;
  FreeAndNil(DownLoader);
end;

procedure TForm1.CANCELClick(Sender: TObject);
begin
  CancelTransFer := true;
end;

end.
于 2014-09-15T17:44:24.667 回答