如何实现文件下载？要求能得到下载比例信息！

Question

uses UrlMon; 
function DownloadFile(Source, Dest: string): Boolean; 
begin 
try 
Result := UrlDownloadToFile(nil, PChar(source), 
PChar(Dest), 0, nil) = 0; 
except 
Result := False; 
end; 
end; 
if DownloadFile('http://www.borland.com/delphi6.zip, 
'c:\kylix.zip') then 
ShowMessage('Download succesful') 
else ShowMessage('Download unsuccesful') 
上面的虽然可以实现，但是不知道怎么样得到下载的状态信息！有那位高手回答一下，在线等！

Answer 1

给你个封装吧。
unit HTTPGet;interfaceuses
  Windows, Messages, SysUtils, Classes, WinInet;type
  TOnProgressEvent = procedure(Sender: TObject; TotalSize, Readed: Integer) of object;
  TOnDoneFileEvent = procedure(Sender: TObject; FileName: String; FileSize: Integer) of object;
  TOnDoneStringEvent = procedure(Sender: TObject; Result: String) of object;  THTTPGetThread = class(TThread)
  private
    FTAcceptTypes,
    FTAgent,
    FTURL,
    FTFileName,
    FTStringResult,
    FTUserName,
    FTPassword,
    FTPostQuery,
    FTReferer: String;
    FTBinaryData,
    FTUseCache: Boolean;    FTResult: Boolean;
    FTFileSize: Integer;
    FTToFile: Boolean;    BytesToRead, BytesReaded: DWord;    FTProgress: TOnProgressEvent;    procedure UpdateProgress;
  protected
    procedure Execute; override;
  public
    constructor Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword, aPostQuery, aReferer: String;
                       aBinaryData, aUseCache: Boolean; aProgress: TOnProgressEvent; aToFile: Boolean);
  end;  THTTPGet = class(TComponent)
  private
    FAcceptTypes: String;
    FAgent: String;
    FBinaryData: Boolean;
    FURL: String;
    FUseCache: Boolean;
    FFileName: String;
    FUserName: String;
    FPassword: String;
    FPostQuery: String;
    FReferer: String;
    FWaitThread: Boolean;    FThread: THTTPGetThread;
    FError: TNotifyEvent;
    FResult: Boolean;    FProgress: TOnProgressEvent;
    FDoneFile: TOnDoneFileEvent;
    FDoneString: TOnDoneStringEvent;    procedure ThreadDone(Sender: TObject);
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;    procedure GetFile;
    procedure GetString;
    procedure Abort;
  published
    property AcceptTypes: String read FAcceptTypes write FAcceptTypes;
    property Agent: String read FAgent write FAgent;
    property BinaryData: Boolean read FBinaryData write FBinaryData;
    property URL: String read FURL write FURL;
    property UseCache: Boolean read FUseCache write FUseCache;
    property FileName: String read FFileName write FFileName;
    property UserName: String read FUserName write FUserName;
    property Password: String read FPassword write FPassword;
    property PostQuery: String read FPostQuery write FPostQuery;
    property Referer: String read FReferer write FReferer;
    property WaitThread: Boolean read FWaitThread write FWaitThread;    property OnProgress: TOnProgressEvent read FProgress write FProgress;
    property OnDoneFile: TOnDoneFileEvent read FDoneFile write FDoneFile;
    property OnDoneString: TOnDoneStringEvent read FDoneString write FDoneString;
    property OnError: TNotifyEvent read FError write FError;
  end;procedure Register;implementation//  THTTPGetThreadconstructor THTTPGetThread.Create(aAcceptTypes, aAgent, aURL, aFileName, aUserName, aPassword, aPostQuery, aReferer: String;
                                  aBinaryData, aUseCache: Boolean; aProgress: TOnProgressEvent; aToFile: Boolean);
begin
  FreeOnTerminate := True;
  inherited Create(True);  FTAcceptTypes := aAcceptTypes;
  FTAgent := aAgent;
  FTURL := aURL;
  FTFileName := aFileName;
  FTUserName := aUserName;
  FTPassword := aPassword;
  FTPostQuery := aPostQuery;
  FTReferer := aReferer;
  FTProgress := aProgress;
  FTBinaryData := aBinaryData;
  FTUseCache := aUseCache;  FTToFile := aToFile;
  Resume;
end;procedure THTTPGetThread.UpdateProgress;
begin
  FTProgress(Self, FTFileSize, BytesReaded);
end;procedure THTTPGetThread.Execute;
var
  hSession, hConnect, hRequest: hInternet;
  HostName, FileName: String;
  f: File;
  Buf: Pointer;
  dwBufLen, dwIndex: DWord;
  Data: Array[0..$400] of Char;
  TempStr: String;
  RequestMethod: PChar;
  InternetFlag: DWord;
  AcceptType: LPStr;
  //检测文件状态 2个变量
  dwcode: array[1..20] of char;
  re: integer;  procedure ParseURL(URL: String; var HostName, FileName: String);    procedure ReplaceChar(c1, c2: Char; var St: String);
    var
      p: Integer;
    begin
      while True do
       begin
        p := Pos(c1, St);
        if p = 0 then Break
        else St[p] := c2;
       end;
    end;  var
    i: Integer;
  begin
    if Pos('http://', LowerCase(URL)) <> 0 then
      System.Delete(URL, 1, 7);    i := Pos('/', URL);
    HostName := Copy(URL, 1, i);
    FileName := Copy(URL, i, Length(URL) - i + 1);    if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
      SetLength(HostName, Length(HostName) - 1);
  end; procedure CloseHandles;
 begin
   InternetCloseHandle(hRequest);
   InternetCloseHandle(hConnect);
   InternetCloseHandle(hSession);
 end;begin
  try
    ParseURL(FTURL, HostName, FileName);    if Terminated then
     begin
      FTResult := False;
      Exit;
     end;

Answer 2

if FTAgent <> '' then
     hSession := InternetOpen(PChar(FTAgent),
       INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)
    else
     hSession := InternetOpen(nil,
       INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);    hConnect := InternetConnect(hSession, PChar(HostName),
      INTERNET_DEFAULT_HTTP_PORT, PChar(FTUserName), PChar(FTPassword), INTERNET_SERVICE_HTTP, 0, 0);    if FTPostQuery = '' then RequestMethod := 'GET'
    else RequestMethod := 'POST';    if FTUseCache then InternetFlag := 0
    else InternetFlag := INTERNET_FLAG_RELOAD;    AcceptType := PChar('Accept: ' + FTAcceptTypes);
    hRequest := HttpOpenRequest(hConnect, RequestMethod, PChar(FileName), 'HTTP/1.0',
                PChar(FTReferer), @AcceptType, InternetFlag, 0);    if FTPostQuery = '' then
     HttpSendRequest(hRequest, nil, 0, nil, 0)
    else
     HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
                     PChar(FTPostQuery), Length(FTPostQuery));    if Terminated then
     begin
      CloseHandles;
      FTResult := False;
      Exit;
     end;
   //检测文件状态
    dwIndex  := 0;
    dwBufLen := 1024;
    FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE, @dwcode, dwBufLen, dwIndex);
    re := StrToIntDef(pchar(@dwcode), 404); //如果不能转换，则负直为404
   if re <> 200 then
    begin
     CloseHandles;
     FTResult := False;
     Exit;
   end;   //获取文件大小
    dwIndex  := 0;
    dwBufLen := 1024;
    GetMem(Buf, dwBufLen);
   FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,Buf, dwBufLen, dwIndex);   if Terminated then
     begin
      FreeMem(Buf);
      CloseHandles;
      FTResult := False;
      Exit;
     end;    if FTResult or not FTBinaryData then
     begin
      if FTResult then
        FTFileSize := StrToInt(StrPas(Buf));      BytesReaded := 0;      if FTToFile then
       begin
        AssignFile(f, FTFileName);
        Rewrite(f, 1);
       end
      else FTStringResult := '';      while True do
       begin
        if Terminated then
         begin
          if FTToFile then CloseFile(f);
          FreeMem(Buf);
          CloseHandles;          FTResult := False;
          Exit;
         end;        if not InternetReadFile(hRequest, @Data, SizeOf(Data), BytesToRead) then Break
        else
         if BytesToRead = 0 then Break
         else
          begin
           if FTToFile then
            BlockWrite(f, Data, BytesToRead)
           else
            begin
             TempStr := Data;
             SetLength(TempStr, BytesToRead);
             FTStringResult := FTStringResult + TempStr;
            end;           inc(BytesReaded, BytesToRead);
           if Assigned(FTProgress) then
            Synchronize(UpdateProgress);
          end;
       end;      if FTToFile then
        FTResult := FTFileSize = Integer(BytesReaded)
      else
       begin
        SetLength(FTStringResult, BytesReaded);
        FTResult := BytesReaded <> 0;
       end;      if FTToFile then CloseFile(f);       
     end;    FreeMem(Buf);    CloseHandles;
  except
  end;
end;// HTTPGetconstructor THTTPGet.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FAcceptTypes := '*/*';
  FAgent := 'UtilMind HTTPGet';
end;destructor THTTPGet.Destroy;
begin
  Abort;
  inherited Destroy;
end;procedure THTTPGet.GetFile;
var
  Msg: TMsg;
begin
  if not Assigned(FThread) then
   begin
    FThread := THTTPGetThread.Create(FAcceptTypes, FAgent, FURL, FFileName, FUserName, FPassword, FPostQuery, FReferer,
                                     FBinaryData, FUseCache, FProgress, True);
    FThread.OnTerminate := ThreadDone;
    if FWaitThread then
    while Assigned(FThread) do
     while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
   end
end;procedure THTTPGet.GetString;
var
  Msg: TMsg;
begin
  if not Assigned(FThread) then
   begin
    FThread := THTTPGetThread.Create(FAcceptTypes, FAgent, FURL, FFileName, FUserName, FPassword, FPostQuery, FReferer,
                                     FBinaryData, FUseCache, FProgress, False);
    FThread.OnTerminate := ThreadDone;
    if FWaitThread then
     while Assigned(FThread) do
      while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
       begin
         TranslateMessage(Msg);
         DispatchMessage(Msg);
       end;
   end
end;procedure THTTPGet.Abort;
begin
  if Assigned(FThread) then
   begin
    FThread.Terminate;
    FThread.FTResult := False;
   end;
end;procedure THTTPGet.ThreadDone(Sender: TObject);
begin
  FResult := FThread.FTResult;
  if FResult then
   if FThread.FTToFile then
    if Assigned(FDoneFile) then FDoneFile(Self, FThread.FTFileName, FThread.FTFileSize) else
   else
    if Assigned(FDoneString) then FDoneString(Self, FThread.FTStringResult) else   
  else
   if Assigned(FError) then FError(Self);
  FThread := nil;
end;procedure Register;
begin
  RegisterComponents('UtilMind', [THTTPGet]);
end;end.
{
http_query_status_code 19 && 状态代码
http_query_status_text 20 && 状态文本
http_query_content_type 1 && 类型
http_query_content_length 5 && 内容长度
http_query_content_range 53 && 范围
http_query_date 9 && 日期
http_query_last_modified 11 && 最后修订
http_query_version 18 && 协议
http_query_raw_headers 21 && 获取 http 信息 - 分隔符为 0
http_query_raw_headers_crlf 22 && 获取 http 信息 - 分隔符为“回车换行符”
http_query_server 37 && 服务器
http_query_rest_method 45 && http协议命令
http_query_etag 54 && etag
}
注册后在窗口上放一个httpget
然后
 HTTPGet1.URL := 'http://www.baidu.com/ss.zip';
 HTTPGet1.FileName := 'c:\1.zip';
 HTTPGet1.GetFile;
具体事件比如下载完成，出错，等都有。可以自己看。

Answer 3

你这个代码怎么用哦
能不能具体说一下
是不是存成一个.pas文件啊？
我一点不熟悉但是很需要这方面的资料

Answer 4

procedure TForm1.HTTPGet1Progress(Sender: TObject; TotalSize,
  Readed: Integer);
begin
     label1.Caption:=inttostr(TotalSize);
     label2.Caption:=inttostr(Readed);
     ProgressBar1.Max:=TotalSize;
     ProgressBar1.Position:=Readed;
end;
把上面的代码 复制到文本 然后改名.pas  然后 在DELPHI里install component 就行了