udownfilethread.pas

这是一个从指定网页格式分离单词的小程序

{-----------------------------------------------------------------------------
 Unit Name: uDownFileThread
 Author:    Piao
 Date:      2005-3-13 19:03:30
 Purpose:   下载文件线程
 History:
-----------------------------------------------------------------------------}
unit uDownFileThread;

interface

uses
  Classes, IdHTTP, IdComponent, Windows;

type
  TDownFileThread = class(TThread)
    FsURL: string;                //下载的URL地址
    FsFileName: string;           //存放文件名称
    FProHandle: HWND;             //处理消息的Handle
    FFailedTry: integer;          //失败尝试次数
    FTaskID: integer;             //主程分配的线程ID编号
    FIdHTTPDown: TIdHTTP;         //下载数据组件
    FDownLoadOK: boolean;
  private
    { Private declarations }
    procedure IdHTTPDownWork(Sender: TObject;
      AWorkMode: TWorkMode; const AWorkCount: Integer);
    procedure IdHTTPDownWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    function DownHtml(var StrHtml: string): boolean;
    procedure OnDownOver;
  protected
    procedure Execute; override;

  public
    constructor Create(sURL,sFileName:String; ProHandle: HWND;
      FailedTry, TaskID: integer; CreateSuspended: boolean);
    destructor Destroy; override;
  end;

implementation

uses uConst, uPublic;


{ TDownFileThread }

constructor TDownFileThread.Create(sURL, sFileName: String;
  ProHandle: HWND; FailedTry, TaskID: integer; CreateSuspended: boolean);
begin
  inherited Create(CreateSuspended);
  FsURL := sURL;                        //下载的URL地址
  FsFileName := sFileName;              //存放文件名称
  FProHandle := ProHandle;              //处理消息的Handle
  FFailedTry := FailedTry;              //失败尝试次数
  FTaskID := TaskID;                    //主程分配的线程ID编号
  FIdHTTPDown := TIdHTTP.Create(nil);   //创建下载数据组件
  FIdHTTPDown.OnWork := IdHTTPDownWork;
  FIdHTTPDown.OnWorkEnd := IdHTTPDownWorkEnd;
  FDownLoadOK := False;                 //下载成功标识
end;

destructor TDownFileThread.Destroy;
begin
  FIdHTTPDown.Free;       //释放下载数据组件
  Synchronize(OnDownOver);
  inherited Destroy;
end;

procedure TDownFileThread.Execute;
var sHtml: string;
begin
  { Place thread code here }
  FreeOnTerminate := True;              //当线程结束时自动释放
  if DownHtml(sHtml) then
  try
    with TMemoryStream.Create do
    begin
      Write(Pointer(sHtml)^,Length(sHtml));
      Seek(0,0);
      SaveToFile(FsFileName);
      Free;
    end;//with
  except
    //SendMessage(FProHandle,WM_SendErrorMsg,FTaskID,0);//发送下载失败消息
    FDownLoadOK := False;
  end;//try
  
  //PostMessage(FProHandle,WM_CheckTmpURLList,0,0);//发送更新相似页面消息
  FDownLoadOK := True;
  //if FDownLoadOK then SendMessage(FProHandle,WM_SendErrorMsg,FTaskID,1);//发送下载完成消息
end;

procedure TDownFileThread.IdHTTPDownWork(Sender: TObject;
  AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
  if Terminated then
  begin
    if Sender is TIdHTTP then
    begin
      TIdHTTP(Sender).DisconnectSocket;
      TIdHTTP(Sender).Disconnect;
    end;
  end;//if
end;

procedure TDownFileThread.IdHTTPDownWorkEnd(Sender: TObject;
  AWorkMode: TWorkMode);
begin
  FDownLoadOK := True;
end;

function TDownFileThread.DownHtml(var StrHtml: string): boolean;
var iTryNum: integer;
begin
  Result := False;
  for iTryNum := 0 to FFailedTry - 1 do
  begin
    if FIdHTTPDown.Connected then FIdHTTPDown.Disconnect;
    try
      FDownLoadOK := False;
      Result := True;
      StrHtml := '';
      StrHtml := FIdHTTPDown.Get(FsURL);
    except
      Result := False;
    end;//try
    if (StrHtml <> '') or Result then Break;
    if Terminated then
    begin
      Result := False;
      Break;
    end;//if
    Sleep(0);
  end;//for iTryNum
end;

procedure TDownFileThread.OnDownOver;
var t: integer;
begin
  t := 1;
  if FDownLoadOK then t := 0;
  ProOnDownOver(FTaskID, t);
end;

end.