delphi 写一个下载程序,就像下载游戏前的那个下载软件，怎么样得到下载速率？

Question

delphi 写一个下载程序,就像下载游戏前的那个下载软件，怎么样得到下载速率？

Answer 1

t=当前时间
x=当前下载数
下载一段时间
速率=（当前下载数-x)/(当前时间-t)

Answer 2

uses 
   UrlMon;
URLDownloadToFile();  {用这个API函数}

Answer 3

建议使用IdHttp，使用URLDownLoadToFile来获取下载字节数及时间不能做到实时，只能等下载完成时才能计算速度。要想实时计算速度，要做很多额外的工作。IdHttp已经带有相关的事件，在事件中就可以得到下载字节数，直接计算就可以了。

Answer 4

{***************************************************************
 unit name: uMain.pas
 Copyright (c) 2010 Chenhao
 Email: [email protected]
 Notice:If this code works, it was written by Chenhao.
 Else, I don't know who wrote it. Use it on your own risk. No responsibilities for
 possible damages of even functionality can be taken.
***************************************************************}
unit uMain;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Buttons, UrlMon, ActiveX, ExtCtrls;type
  TForm1 = class(TForm, IBindStatusCallback)
    pbAllFile: TProgressBar;
    pbOneFile: TProgressBar;
    lblOneFile: TLabel;
    lblAllFile: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    {=== Interface function}
    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;
    {=== my function}
    function DownFiles(SourceFile, TargetFile: string): Boolean;
    function CloseMainApp(sAppName: string): Boolean;
    procedure DownloadVerFile;
    function CheckVer(Ver: string): string;
    procedure StartDownFiles;
    procedure StartUpdate;
    procedure WriteLog(sLog: string);
    procedure ClearDownloadFiles;
    { Private declarations }
  public
    { Public declarations }
  end;
type {=== 结构体,以Files.lst为例}
  TOneFile = record
    Ver: string;
    FileCount: Integer;
    OverIt: Boolean;
    FName: string;
    TargetDir: string;
    Ext: string;
  end;
var
  Form1: TForm1;implementation
uses
  AppIni;
var
  upAppName, upAppVer, upAppURL, AppPath: string;
  bCloseMainApp: Boolean;
  AllFiles: array of TOneFile;
const
  VerFName = 'Ver.txt';
{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject); {=== 程序初始化}
begin
  {ParamStr Format:AppName[Space]Version[space]bCloseMainApp[Space]URL }
  upAppName := ParamStr(1);
  upAppVer := ParamStr(2);
  bCloseMainApp := StrToBool(ParamStr(3));
  upAppURL := ParamStr(4);
  //    upAppName := 'stManage';
  //    upAppVer := '1.0.023';
  //    upAppURL := 'http://www.jschenhao.com.cn/Software/';
  AppPath := GetCurrentDir + '\';
  lblAllFile.Caption := '';
  lblOneFile.Caption := '';
  pbAllFile.Position := 0;
  pbOneFile.Position := 0;
  //  ShowMessage(upAppName + #13#10 + upAppVer + #13#10 + ParamStr(3) + #13#10 +
  //    upAppURL);    {=== CloseMainApp}
  if bCloseMainApp = True then
    CloseMainApp(upAppName+'.exe');  {=== AppIni.pas}  _AppIni(Application, Form1, upAppName);end;function TForm1.DownFiles(SourceFile, TargetFile: string): Boolean;
{=== 开始下载单个文件}
var
  BindStatusProc: IBindStatusCallback;
begin
  BindStatusProc := IBindStatusCallback(Self);
  Application.ProcessMessages;
  Result := URLDownloadToFile(nil, PChar(SourceFile), PChar(TargetFile), 0,
    BindStatusProc) <> S_Ok
end;
{=== Interface begin ==========================================================}function TForm1.GetBindInfo(out grfBINDF: DWORD;
  var bindinfo: TBindInfo): HResult;
begin
  Result := 0;
end;function TForm1.GetPriority(out nPriority): HResult;
begin
  Result := 0;
end;function TForm1.OnDataAvailable(grfBSCF, dwSize: DWORD;
  formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin
  Result := 0;
end;function TForm1.OnLowResource(reserved: DWORD): HResult;
begin
  Result := 0;
end;function TForm1.OnObjectAvailable(const iid: TGUID;
  punk: IInterface): HResult;
begin
  Result := 0;
end;function TForm1.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
  szStatusText: LPCWSTR): HResult; {=== 显示下载文件进度}
begin
  pbOneFile.Max := ulProgressMax;
  pbOneFile.Position := ulProgress;
  Application.ProcessMessages;
  lblOneFile.Caption := Format('%D/%D', [ulProgress, ulProgressMax]);
  Result := 0;
end;function TForm1.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin
  Application.ProcessMessages;
  Result := 0;
end;function TForm1.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;
begin
  Result := 0;
end;
{=== End  =====================================================================}function TForm1.CloseMainApp(sAppName: string): Boolean; {=== 关闭主程序}
var
  hWnd: THandle;
begin
  hWnd := FindWindow(nil, PChar(sAppName));
  if hWnd <> 0 then
    Result := PostMessage(hWnd, WM_CLOSE, 0, 0)
  else
    Result := False;
end;procedure TForm1.DownloadVerFile; {=== 下载版本}
begin
  lblAllFile.Caption := 'Downloading Ver,Please Waiting... ';
  if not DirectoryExists(AppPath + '\DownLoad\') then
    ForceDirectories(AppPath + '\DownLoad\');
  if DownFiles(upAppURL + '/' + upAppName + '/' + VerFName, AppPath +
    '\DownLoad\' + VerFname) then
    raise Exception.Create('ErrorCode:0030'); {=== 0030=下载版本失败}
end;function TForm1.CheckVer(Ver: string): string;
var
  VerList: TStringList;
begin
  DownloadVerFile;
  VerList := TStringList.Create;
  try
    VerList.LoadFromFile(AppPath + '\download\' + VerFName);
    if VerList.Values[Ver] <> '' then
      Result := VerList.Values[Ver]
    else
      Result := 'Null';
  finally
    VerList.Free;
  end; // try
end;procedure TForm1.StartDownFiles; {=== 开始下载}
const
  FileList = 'FileList.txt';
var
  Ver, URLPath, LocalPath: string;
  Idx, FileCount: Integer;
  Lists: TStringList;
begin
  Ver := CheckVer(upAppVer); //获取版本信息，根据upAppVer
  if Ver = 'Null' then
  begin
    MessageBox(0, '当前已经最新版本。', '提示', MB_ICONINFORMATION);
    ClearDownloadFiles;
    Close;
  end;
  URLPath := upAppURL + upAppName + '/' + Ver + '/';
  LocalPath := AppPath + 'Download\';
  if not DirectoryExists(LocalPath) then
    ForceDirectories(LocalPath);
//  ShowMessage(URLPath + FileList+#13#10+LocalPath + FileList);
  DownFiles(URLPath + FileList, LocalPath + FileList); { ==下载文件列表失败}
  if not FileExists(LocalPath + FileList) then
    raise Exception.Create('Filelist not found.');
  Lists := TStringList.Create; {=== 加载下载文件列表}
  Lists.LoadFromFile(LocalPath + FileList);
  try
    FileCount := StrToInt(Lists.Values['FileCount']);
    pbAllFile.Max := FileCount;
    SetLength(AllFiles, FileCount);
    for Idx := 0 to FileCount - 1 do
    begin
      with AllFiles[Idx] do
      begin
        FName := Lists.Values['fName' + IntToStr(Idx)];
        TargetDir := Lists.Values['Dir' + IntToStr(Idx)];
        //        OverIt := StrToBool(Lists.Values['OverIt' +
        //          IntToStr(Idx)]);
        Ext := Lists.Values['ext' + IntToStr(Idx)];
        DownFiles(URLPath + FName, LocalPath + FName);
        if not FileExists(LocalPath + FName) then
          WriteLog(FName + '  ,download failed.');
        lblAllFile.Caption := 'Total:' + IntToStr(Idx + 1) + '/' +
          IntToStr(pbAllFile.Max);
        pbAllFile.Position := Idx + 1;
      end;
    end;
  finally
    Lists.Free;
  end; // try
end;procedure TForm1.StartUpdate; {=== 开始复制文件}
var
  Count, Idx: Integer;
  LocalPath: string;
begin
  Count := Length(AllFiles);
  pbAllFile.Max := Count;
  LocalPath := AppPath + 'Download\';
  lblAllFile.Caption := 'Copy Files,Please Wait...';
  pbAllFile.Position := 0;
  pbAllFile.Max := Count;
  for Idx := 0 to Count - 1 do
  begin
    with AllFiles[Idx] do
    begin
      if FileExists(LocalPath + FName) then
      begin
        if TargetDir <> 'Default' then
        begin
          if not DirectoryExists(AppPath + TargetDir) then
            ForceDirectories(AppPath + TargetDir);
        end;
        if TargetDir <> 'Default' then
          CopyFile(PChar(LocalPath + FName), PChar(AppPath + TargetDir + FName),
            OverIt)
      else
        CopyFile(PChar(LocalPath + FName), PChar(AppPath + FName),
          OverIt);
          
      if ExtractFileExt(FName) <> Ext then
        ChangeFileExt(AppPath + TargetDir + FName, Ext);
      pbAllFile.Position := Idx + 1;
    end
  else
    WriteLog(FName + ' ,not found.');
end;
Application.ProcessMessages;
pbAllFile.Position := Idx + 1;
end;
lblAllFile.Caption := 'Finished.';
end;procedure TForm1.WriteLog(sLog: string);
var
  F: TextFile;
  LogFilename: string;
begin
  LogFilename := AppPath + 'update.log';
  try
    AssignFile(F, LogFilename);
    if FileExists(LogFilename) then
      Append(F)
    else
      Rewrite(F);
    Writeln(F, 'DateTime:' + FormatDateTime('YYYY/MM/DD,HH:MM:SS', Now) + ',' +
      sLog);
  finally
    CloseFile(F);
  end;
end;procedure TForm1.ClearDownloadFiles; {=== 删除download文件夹里面所有文件}
var
  Sr: TSearchRec;
  DownLoadPath: string;
begin
  DownLoadPath := AppPath + 'Download';
  if FindFirst(DownLoadPath + '\*.*', faAnyFile, Sr) = 0 then
  begin
    repeat
      begin
        if sr.Name[1] = '.' then
          Continue;
        if (sr.Attr and faAnyFile) = sr.Attr then
          DeleteFile(DownLoadPath + '\' + sr.Name);
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
end;procedure TForm1.FormActivate(Sender: TObject);
begin
  StartDownFiles;
  StartUpdate;
  ClearDownloadFiles;
  Close;
end;end.发个我以前写的代码，你参考下，如果要例子的话，留个电邮我。