delphi 读网页线程TReadHtmlThread

读网页，通常是一个耗时操作。故把读网页放入线程是显得比较重要了。

本例用改进后的 TIdhttpEx 加上线程来实现读网页。

它的父类TSimpleThread 在此

本例程源码在此

源码中包含了所有的支持单元，其它单元后续会慢慢讲解

 unit uReadHtmlThread;

 interface

 uses
   uSimpleThread, uIdhttpEx;

 type

   TReadHtmlThread = class; // 提前申明 TReadHtmlThread 是一个类,后面好办事

   TReadStatus = (rsOK, rsErr);

   // 这里就用上TReadHtmlThread ，不然要写个 Sender:TObject 用起来不方便
   TOnReadStatus = procedure(Sender: TReadHtmlThread; AStatus: TReadStatus) of object;

   TReadHtmlThread = class(TSimpleThread)
   private

     FIdHttp: TIdhttpEx; // 这是我改进后的 TIdhttp
     FOnReadStatus: TOnReadStatus;

     FUrl: string;
     FNewUrl: string;
     FHtml: string;

     FListIndex: integer; // 我工用中用的，请把它当成一个参数即可。
     FPosInList: integer; // 同上

     procedure InitIdhttp; // 重新创建 FIdhttp, 如果读网页出错了，就用一下它(经验之谈)

     procedure ReadHtml; // 本例重点,请仔细看
     procedure DoReadHtml; // 本例重点,请仔细看

     procedure SetOnReadStatus(const Value: TOnReadStatus);
     procedure DoOnReadStatus(AStatus: TReadStatus); // 执行事件，关于事件均可参考此写法
     procedure SetHtml(const Value: string);
     procedure SetUrl(const Value: string);
     procedure SetListIndex(const Value: integer);
     procedure SetPosInList(const Value: integer);

   public

     constructor Create; reintroduce; // 再次把 Create 的参数去掉，为以后线程池做准备
     { 因为线程池会用到泛型的 LIST ，泛型定义时可以写一个约束条件 如：
       TSimpleThing<T:TXXObject,Constructor> 这个 Constructor 要求 T 的Create没有参数
     }
     destructor Destroy; override;
     procedure StartThread; override; // 启动线程，注意看!!!
     property OnReadStatus: TOnReadStatus read FOnReadStatus write SetOnReadStatus;
     property Url: string read FUrl Write SetUrl;
     property NewUrl: string read FNewUrl;
     property Html: string Read FHtml Write SetHtml;
     property ListIndex: integer read FListIndex write SetListIndex;
     property PosInList: integer read FPosInList write SetPosInList;
   end;

 implementation

 { TReadHtmlThread }
 uses
   uOperateIndy, SysUtils;
 { uOperateIndy 是我写的一个单元，操作Idhttp简便方法 }

 destructor TReadHtmlThread.Destroy;
 begin
   WaitThreadStop; // 在父中说了为什么要写这句
   if Assigned(FIdHttp) then
     FIdHttp.Free;
   inherited;
 end;

 procedure TReadHtmlThread.DoOnReadStatus(AStatus: TReadStatus);
 begin
   if Assigned(FOnReadStatus) then
     FOnReadStatus(self, AStatus);
 end;

 procedure TReadHtmlThread.DoReadHtml;
 begin

   // 这才是重点

   InitIdhttp;

   FNewUrl := FUrl;
   if IdhttpGet(FIdHttp, FUrl, FHtml) then
   begin
     FNewUrl := FIdHttp.Url.URI; // 重定向后的 Url
     DoOnReadStatus(rsOK)
   end
   else
     DoOnReadStatus(rsErr);

 end;

 procedure TReadHtmlThread.InitIdhttp;
 begin
   if Assigned(FIdHttp) then
   begin
     FIdHttp.Free;
   end;
   FIdHttp := TIdhttpEx.Create(nil);
 end;

 procedure TReadHtmlThread.ReadHtml;
 begin
   ExeProcInThread(DoReadHtml); // 哈哈，就一句！
 end;

 procedure TReadHtmlThread.SetHtml(const Value: string);
 begin
   FHtml := Value;
 end;

 procedure TReadHtmlThread.SetListIndex(const Value: integer);
 begin
   FListIndex := Value;
 end;

 procedure TReadHtmlThread.SetOnReadStatus(const Value: TOnReadStatus);
 begin
   FOnReadStatus := Value;
 end;

 procedure TReadHtmlThread.SetPosInList(const Value: integer);
 begin
   FPosInList := Value;
 end;

 procedure TReadHtmlThread.SetUrl(const Value: string);
 begin
   FUrl := Value;
 end;

 procedure TReadHtmlThread.StartThread;
 begin
   inherited;
   ReadHtml; // 其实还是这一句，哈哈
 end;

 constructor TReadHtmlThread.Create;
 begin
   inherited Create(false);
 end;

 end.

uReadHtmlThread.pas

附：delphi 进阶基础技能说明