mydownfile.pas

提取网页文件图片地址,应用此工具

unit mydownfile;

interface

 uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, StdCtrls, ComCtrls,
  IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdAntiFreeze,
  IdAntiFreezeBase,U_Pub;
const
  WM_DONE = WM_USER + 100;
type
  TMyDownFile = class(Tcomponent)
  private
    FWorking:boolean;
    FidHTTP : TidHTTP;
    FAllWorkCount: integer;
    FDoneCount: integer;
    FStopDownLoad: boolean;
    FDownDir: string;
    FListView: TlistView;
    FitemIndex: integer;
    FSubItemIndex: integer;
    FHwnd: Thandle;
    function GetURLFileName(aURL: string): string;

    procedure OnHTTPWork(Sender: TObject;AWorkMode: TWorkMode; const AWorkCount: Integer);
    procedure WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
    procedure WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure SetDownDir(const Value: string);
    function CalcDoneCount:string;
    procedure DispDoneCount;

  protected

  public
   function HttpDownLoad(aURL, aFile: string; bResume: Boolean): boolean;
    Constructor create(AOwner:Tcomponent);override;
    destructor Destroy; override;
    procedure SetTimeOut(TimeOut:integer);
    function  DownFile(UrlName:string):boolean;
    property DoneCount:integer read FDoneCount;
    property AllWorkCount:integer read FAllWorkCount;
    property StopDownLoad:boolean read FStopDownLoad write FStopDownLoad;
    property DownDir:string read FDownDir write SetDownDir;
    property listView:TlistView read FListView write FListView;
    property ItemIndex:integer read FitemIndex write FitemIndex;
    property Hwnd:Thandle read FHwnd write FHwnd;
 //   property IcoDownIngIndex:integer read FIcoDownIngIndex write FIcoDownIngIndex;
 //   property IcoErrorDownIndex:integer read FIcoErrorDownIndex write FIcoErrorDownIndex;
 //   property IcoDownDoneIndex:integer read FIcoDownDoneIndex write FIcoDownDoneIndex;
 //   property  SubItemIndex:integer read FSubItemIndex write FSubItemIndex;
  end;
implementation

{ MyDownFile }

constructor TMyDownFile.create(AOwner: Tcomponent);
begin
  inherited;
  FidHTTP := TidHTTP.Create(self);
  FidHTTP.OnWork := OnHTTPWork;
  FidHTTP.OnWorkBegin := WorkBegin;
  FidHTTP.OnWorkEnd := WorkEnd;
end;

destructor TMyDownFile.Destroy;
begin
  FidHttp.Disconnect ;
  FidHTTP.Free ;
  inherited;
end;

procedure TMyDownFile.SetTimeOut(TimeOut: integer);
begin
  FIdHTTP.ReadTimeout := TimeOut;
end;


function TMyDownFile.GetURLFileName(aURL: string): string;
var
  i: integer;
  s: string;
begin //返回下载地址的文件名
  s := aURL;
  i := Pos('/', s);
  while i <> 0 do //去掉"/"前面的内容剩下的就是文件名了
  begin
    Delete(s, 1, i);
    i := Pos('/', s);
  end;
  Result := CorrFileName(s);
end;

function TMyDownFile.HttpDownLoad(aURL, aFile: string; bResume: Boolean): boolean;
var
  tStream: TFileStream;
begin //Http方式下载
 // infodlg(aUrl,'',1);
  result := false;
  aFile := FDownDir +  GetURLFileName(aURL);
 // aFile := CorrFileName(aFile);
 // infodlg(afile,'',1);
  if FileExists(aFile) then //如果文件已经存在
  deleteFile(aFile);
   // tStream := TFileStream.Create(aFile, fmOpenWrite) else
    tStream := TFileStream.Create(aFile, fmCreate);

  if bResume then //续传方式
  begin
    FIdHTTP.Request.ContentRangeStart := tStream.Size - 1;
    tStream.Position := tStream.Size - 1; //移动到最后继续下载
    FIdHTTP.Head(aURL);
    FIdHTTP.Request.ContentRangeEnd := FIdHTTP.Response.ContentLength;
  end else //覆盖或新建方式
  begin
    FIdHTTP.Request.ContentRangeStart := 0;
  end;

  try
 //   FAllWorkCount := FIdHTTP.Response.ContentLength;
    FIdHTTP.Get(aURL, tStream); //开始下载
    Tstream.Free;
    result := true;
     sendmessage(FHwnd,WM_DONE,0,0);
     FidHttp.Disconnect ;
  except
    TStream.Free;
    if FileExists(aFile) then
     DeleteFile(aFile);
      FlistView.Items.Item[FitemIndex].SubItems.Strings[2] := '下载失败';
      FlistView.Items.Item[FitemIndex].SubItemImages[2] := 3;
        sendmessage(FHwnd,WM_DONE,0,0);
      result := false;
       FidHttp.Disconnect ;
  end;
end;


procedure TMyDownFile.OnHTTPWork(Sender: TObject;AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
  if  FStopDownLoad then
    //中断下载
  begin
    FIdHTTP.Disconnect;
   // Bar.Visible := false;
    exit;
 end;
  // sleep(300);
  FDoneCount := AWorkCount;
 // infodlg(CalcDoneCount,'',1);
//infodlg(inttostr((FDonecount div  FIdHTTP.Response.ContentLength)) + '%','',1);
 DispDoneCount;

end;

procedure TMyDownFile.WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  FstopDownLoad := False;
  if AWorkCountMax > 0 then
   FAllWorkCount := AWorkCountMax;//FIdHTTP.Response.ContentLength;
    FWorking := true;
    FlistView.Items.Item[FitemIndex].SubItems.Strings[2] := '正在下载';
       FlistView.Items.Item[FitemIndex].SubItemImages[2] := 2;
//    DispDoneCount;
end;

procedure TMyDownFile.WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  //  FDoneCount := 0;
   // FAllWorkCount := 0;
 //   DispDoneCount;
 FlistView.Items.Item[FitemIndex].SubItems.Strings[2] := '下载成功';
       FlistView.Items.Item[FitemIndex].SubItemImages[2] := 4;

end;

function TMyDownFile.DownFile(UrlName: string): boolean;
begin
  if HttpDownLoad(UrlName,FDownDir + '\' + GetURLFileName(UrlName),false) then
    result := true
   else
     result := false;
end;

procedure TMyDownFile.SetDownDir(const Value: string);
begin
  FDownDir := Value;
end;

function TMyDownFile.CalcDoneCount: string;
var
 cur:currency;
begin
  cur :=  FDoneCount div 1024;// div (FIdHTTP.Response.ContentLength) ;
  result := currtostr(cur) + 'K';

end;

procedure TMyDownFile.DispDoneCount;
var
 DispDataStr:string;
begin
  DispDataStr := CalcDoneCount;
  FlistView.Items.Item[FitemIndex].SubItems.Strings[3] := DispDataStr;
 // FlistView.Repaint;
end;

end.