unit TommHttpGet;

interface

uses
  Windows, Messages, SysUtils, Classes,WinInet,Forms,dialogs;

//下面是定義httpget的

type TTommHttpGetErrorMessage=(emCanceled,emNetWorkError,emUnknownError);

type
  TOnFileDoneEvent = procedure(Sender: TObject; FileName,url: String; FileSize: Integer;DownloadResult:boolean;aTotalFileCount,aDoneFileCount:integer) of object;
  TOnBeforeFileDownLoad=procedure(Sender:TObject;FileName,url:string) of object;
  TOnAllFileDoneEvent=procedure(Sender:TObject;FileCount:integer) of Object;
  TOnFileProgress=procedure(Sender:TObject;FileName,url:string;FileTotalSize,FileReadedSize:integer) of object;
  TOnFileDownloadError=procedure(Sender:TObject;FileName,url:string;ErrorMessage:TTommHttpGetErrorMessage) of object;

type
  TDownLoadThread=class(TThread)    //下載文件的線程
  private
    FtResult:boolean;
    FDownloadThreadCanceled:boolean;
    FaFileName,FaUrl:string;
    FAgent: string;
    FaUseCache:boolean;
    FaIndex:integer;
    FaFileSize:integer;   //文件大小
    FaReadSize:integer;   //已經完成的字節大小
    FaProgress:TOnFileProgress;  //
    FaErrorFound:TOnFileDownloadError;
    FErrorInfo:TTommHttpGetErrorMessage;  //錯誤信息
    procedure ThreadDownLoadProgress;
    procedure UpdateProgress;
    procedure DownLoadErrorFound;
  protected
    procedure Execute; override;
  public
    procedure AbortDownLoadThread;
    property tResult:boolean read FtResult;
    property aIndex:integer read FaIndex;
    Constructor Create(Agent, tFileName,tUrl:String;tUseCache:boolean;index:integer;tFileProgrsss:TOnFileProgress);
end;


type
  TTommHTTPGet = class(TComponent)
  private
    FAgent: String;
    FURLList: TStringList;       //遠程文件列表
    FFileNameList: TStringList;  //本地文件列表
    FUseCache: Boolean;
    FOnFileDone: TOnFileDoneEvent;
    FOnAllFileDone:TOnAllFileDoneEvent;
    FOnFileProgress:TOnFileProgress;  //單個文件下載的進度
    FOnFileDownloadError:TOnFileDownloadError;  //下載文件錯誤
    FOnBeforeFileDownLoad:TOnBeforeFileDownLoad;  //開始下載文件    
    FTotalFileCount:integer;
    FDoneFileCount:integer;
    FDownThread:array of TDownLoadThread;

    procedure DownLoadThreadDone(Sender:TObject);
    procedure GetFile(const Url,FileName:string;ThreadIndex:integer);
    procedure CheckThreadStatus;    
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure CancelDownLoad(ThreadIndex:integer);
    procedure CancelAll;
    procedure BeginDownLoad;
  published
    property Agent: String read FAgent write FAgent;
    property UrlList: TStringList read FUrlList write FUrlList;
    property UseCache: Boolean read FUseCache write FUseCache;
    property FileNameList: TStringList read FFileNameList write FFileNameList;
    property OnFileDone: TOnFileDoneEvent read FOnFileDone write FOnFileDone;
    property OnAllFileDone:TOnAllFileDoneEvent read FOnAllFileDone write FOnAllFileDone;
    property OnFileProgress:TOnFileProgress read FOnFileProgress write FOnFileProgress;
    property OnFileDownloadError:TOnFileDownloadError read FOnFileDownloadError write FOnFileDownloadError;
    property OnBeforeFileDownLoad:TOnBeforeFileDownLoad read FOnBeforeFileDownLoad write FOnBeforeFileDownLoad;
//    property Canceled:boolean read FCanceled;
  end;


implementation


//以下是對httpget的定義及函數

// HTTPGet

procedure TTommHTTPGet.BeginDownLoad;
var i:integer;
begin
  SetLength(FDownThread,FUrlList.Count);
  FDoneFileCount:=0;
  FTotalFileCount:=FUrlList.Count;
  for i:=0 to FUrlList.Count-1 do begin
    GetFile(FUrlList.Strings[i],FFileNameList.Strings[i],i);
  end;
  CheckThreadStatus;
end;

procedure TTommHTTPGet.CancelAll;
var i:integer;
begin
  for i:=0 to High(FDownThread) do begin
     if Assigned(FDownThread[i]) then CancelDownLoad(i); //只能停止還沒有結束的線程
  end;
end;

procedure TTommHTTPGet.CancelDownLoad(ThreadIndex:integer);
var WaitTime:integer;
    FDownLoadFileName,FDownLoadUrl:string;
    FDownLoadResult:boolean;
begin
  if ThreadIndex>High(FDownThread) then exit;
  if not Assigned(FDownThread[ThreadIndex]) then exit;  //如果本線程已經結束，則不能取消。


  FDownLoadFileName:=FDownThread[ThreadIndex].FaFileName;
  FDownLoadUrl:=FDownThread[ThreadIndex].FaUrl;
  FDownLoadResult:=false;//  FDownThread[ThreadIndex].FtResult;  //凡是被停止下載的都為下載失敗

  if Assigned(FDownThread[ThreadIndex]) then begin
     FDownThread[ThreadIndex].Terminate;
     FDownThread[ThreadIndex].AbortDownLoadThread;
     WaitTime:=0;
     while (WaitTime<5000) and (FDownThread[ThreadIndex]<>nil) do begin
       Application.ProcessMessages;
       inc(WaitTime);
       if not Assigned(FDownThread[ThreadIndex]) then begin
          //if Assigned(FOnFileDone) then FOnFileDone(Self,FDownLoadFileName,FDownLoadUrl,0,FDownLoadResult,FTotalFileCount,FDoneFileCount);
          FDownThread[ThreadIndex]:=nil;
          ///CheckThreadStatus;
          exit;
       end;
       Application.ProcessMessages;
     end;

     //if Assigned(FDownThread) then
     if Assigned(FDownThread[ThreadIndex]) then begin
        TerminateThread(FDownThread[ThreadIndex].Handle,0);
        try
         FDownThread[ThreadIndex].Free;
        except
        end;
        FDownThread[ThreadIndex]:=nil;
        //if Assigned(FOnFileDone) then FOnFileDone(Self, FDownLoadFileName,FDownLoadUrl,0,FDownLoadResult,FTotalFileCount,FDoneFileCount);
        //CheckThreadStatus;
     end;
  end;
end;

procedure TTommHTTPGet.CheckThreadStatus;
var i:integer;
begin
  FDoneFileCount:=0;
  for i:=0 to High(FDownThread) do begin
      if not Assigned(FDownThread[i]) then begin
         Inc(FDoneFileCount);  //已經下載完成數目加1
      end;
  end;

  if FDoneFileCount>=FTotalFileCount then begin   //所有的線程都已經結束了。
     if Assigned(FOnAllFileDone) then FOnAllFileDone(self,FUrlList.Count);
     FUrlList.Clear;
     FFileNameList.Clear;
     SetLength(FDownThread,0);
  end;

//
end;

constructor TTommHttpGet.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FUrlList:=TStringList.Create;
  FFileNameList:=TStringList.Create;
  FAgent := 'Mozilla/4.0(compatible;MSIE5.01;Windows NT5.0)';
end;

destructor TTommHttpGet.Destroy;
begin
  FUrlList.Free;
  FFileNameList.Free;
  inherited Destroy;
end;

procedure TTommHTTPGet.DownLoadThreadDone(Sender: TObject);
var FDownLoadResult:boolean;   //本線程的下載結果
    FDownLoadUrl,FDownLoadFileName:string;   //本線程下載的url和filename
begin
   CheckThreadStatus;
   FDownLoadResult:=TDownLoadThread(Sender).tResult;
   FDownLoadUrl:=TDownLoadThread(Sender).FaUrl;
   FDownLoadFileName:=TDownLoadThread(Sender).FaFileName;
   if Assigned(FOnFileDone) then FOnFileDone(Self, FDownLoadFileName,FDownLoadUrl,0,FDownLoadResult,FTotalFileCount,FDoneFileCount);
//   TDownLoadThread(Sender).Free;
//   FDownThread[TDownLoadThread(Sender).aIndex].Free;
   FDownThread[TDownLoadThread(Sender).aIndex]:=nil; //本線程結束
   CheckThreadStatus;

end;

procedure TTommHttpGet.GetFile(const Url,FileName:string;ThreadIndex:integer);
var tempFileStream:TMemoryStream;
    DownUrl,DownFileName:string;
begin
  if Assigned(FOnBeforeFileDownLoad) then FOnBeforeFileDownLoad(self,FileName,url);
  DownUrl:=url;
  DownFileName:=FileName;

  if (pos('file://',lowercase(DownUrl))>0) or (FileExists(DownUrl))then begin
     delete(DownUrl,1,7);
     DownUrl:=StringReplace(DownUrl,'/','\',[rfReplaceAll, rfIgnoreCase]);
     DownUrl:=StringReplace(DownUrl,'\\','\',[rfReplaceAll, rfIgnoreCase]);
     if FileExists(DownUrl) then begin      //Downurl是一個本地文件，則不需要下載
       tempFileStream:=TMemoryStream.Create;
       try
         tempFileStream.LoadFromFile(DownUrl);
         tempFileStream.SaveToFile(DownFileName);
       except
         if Assigned(FOnFileDone) then FOnFileDone(Self, DownFileName,DownUrl,0,false,FTotalFileCount,FDoneFileCount);
         exit;
       end;
       if Assigned(FOnFileDone) then FOnFileDone(Self, DownFileName,DownUrl,tempFileStream.Size,True,FTotalFileCount,FDoneFileCount);
       tempFileStream.Free;
     end else begin
       if Assigned(FOnFileDone) then FOnFileDone(Self, DownFileName,DownUrl,0,false,FTotalFileCount,FDoneFileCount);
       exit;
    end;
    exit;
  end;

  FDownThread[ThreadIndex]:=TDownLoadThread.Create(FAgent, DownFileName,DownUrl,FUseCache,ThreadIndex,FOnFileProgress);    //遠程文件
//  FThreadDone[ThreadIndex]:=false;
//  FCanceled:=false;
  FDownThread[ThreadIndex].FreeOnTerminate:=True;  //線程的釋放在DownLoadThreadDown事件中
  FDownThread[ThreadIndex].OnTerminate:=DownLoadThreadDone;
  FDownThread[ThreadIndex].Resume;                               //開始下載
//  while Assigned(FDownThread) do begin
//     Application.ProcessMessages;
//  end;
//  //以上的循環是為了等待線程的完成，如果沒有以上循環的話，則成了異步下載
end;

//以上是httpget的函數



{ TDownLoadThread }

procedure TDownLoadThread.AbortDownLoadThread;
begin
  FDownloadThreadCanceled:=True;
end;


constructor TDownLoadThread.Create(Agent, tFileName,tUrl:String;tUseCache:boolean;index:integer;tFileProgrsss:TOnFileProgress);
begin
  FaFileName:=tFileName;
  FaUrl:=tUrl;
  FaUseCache:=tUseCache;
  FDownloadThreadCanceled:=false;
  FaIndex:=index;
  FaProgress:=tFileProgrsss;
  FAgent := Agent;
  inherited Create(True);
end;

procedure TDownLoadThread.DownLoadErrorFound;
begin
  try
    if Assigned(FAErrorFound) then FaErrorFound(Self,FaFileName,FaUrl,FErrorInfo);
  except
  end;
end;

procedure TDownLoadThread.Execute;
begin
  ThreadDownLoadProgress;
  try
    if not FtResult then Synchronize(DownLoadErrorFound);
  except
  end;  
end;

procedure TDownLoadThread.ThreadDownLoadProgress;
const BufferSize = 1024;
var Buffer: array[1..BufferSize] of Byte;
    BufferLen: DWORD;
    f: File;
    hSession,hUrl:hInternet;
    ErrorFound:boolean;
    dwBufLen, dwIndex: DWord;
    Buf: Pointer;
    FTResult: Boolean;    
begin
  ErrorFound:=false;
  FtResult:=false;
  if Terminated then begin
     FErrorInfo:=emCanceled;  //操作被用戶終止
     exit;
  end;

  if FAgent <> '' then hSession := InternetOpen(PChar(FAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0)
  else hSession := InternetOpen(nil,INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  try
    if Terminated then begin
       InternetCloseHandle(hSession);
       FErrorInfo:=emCanceled;  //操作被用戶終止
       exit;       
    end;  
    hURL := InternetOpenURL(hSession,PChar(FaUrl),nil,0,0,0);
    if (hUrl=nil) or Terminated then begin
       FtResult:=false;
       InternetCloseHandle(hSession);
       FErrorInfo:=emNetWorkError;
       exit;
    end;

    dwIndex  := 0;
    dwBufLen := 1024;
    GetMem(Buf, dwBufLen);
    if HttpQueryInfo(HURL,HTTP_QUERY_CONTENT_LENGTH,Buf,dwBufLen, dwIndex) then begin
       FaFileSize:= StrToInt(StrPas(Buf));
    end;
    FreeMem(Buf);
    //得到要下載文件的大小

    FaReadSize:=0;
    try
      AssignFile(f, FaFileName);
      Rewrite(f,1);
      repeat
        if FDownloadThreadCanceled or Terminated then break;
        InternetReadFile(hURL, @Buffer,SizeOf(Buffer), BufferLen);
        try
          if FDownloadThreadCanceled or Terminated then break;
          BlockWrite(f, Buffer, BufferLen);
          Inc(FaReadSize,BufferLen);
          Synchronize(UpdateProgress);
        except
          ErrorFound:=true;
          break;
        end;
        if FDownloadThreadCanceled or Terminated then break;        
      until BufferLen = 0;
      FaReadSize:=FaFileSize;
      Synchronize(UpdateProgress);      
      CloseFile(f);
      FtResult:=(not ErrorFound) and (not FDownloadThreadCanceled) and (not Terminated);
      if (not FtResult) and (not Terminated) then FErrorInfo:=emUnKnownError  //未知錯誤
      else FErrorInfo:=emCanceled;
    finally
     FErrorInfo:=emUnKnownError;
     InternetCloseHandle(hURL);
    end
  finally
    InternetCloseHandle(hSession);
 end;

end;

procedure TDownLoadThread.UpdateProgress;
begin
  if Assigned(FaProgress) then
  FaProgress(Self,FaFileName,FaUrl,FaFileSize,FaReadSize);
end;

end.