delphi 读网页线程TReadHtmlThread

读网页，通常是一个耗时操作。故把读网页放入线程是显得比较重要了。
本例用改进后的 TIdhttpEx 加上线程来实现读网页。
源码中包含了所有的支持单元，其它单元后续会慢慢讲解
  1 unit uReadHtmlThread;
  2 
  3 interface
  4 
  5 uses
  6   uSimpleThread, uIdhttpEx;
  7 
  8 type
  9 
 10   TReadHtmlThread = class; // 提前申明 TReadHtmlThread 是一个类,后面好办事
 11 
 12   TReadStatus = (rsOK, rsErr);
 13 
 14   // 这里就用上TReadHtmlThread ，不然要写个 Sender:TObject 用起来不方便
 15   TOnReadStatus = procedure(Sender: TReadHtmlThread; AStatus: TReadStatus) of object;
 16 
 17   TReadHtmlThread = class(TSimpleThread)
 18   private
 19 
 20     FIdHttp: TIdhttpEx; // 这是我改进后的 TIdhttp
 21     FOnReadStatus: TOnReadStatus;
 22 
 23     FUrl: string;
 24     FNewUrl: string;
 25     FHtml: string;
 26 
 27     FListIndex: integer; // 我工用中用的，请把它当成一个参数即可。
 28     FPosInList: integer; // 同上
 29 
 30     procedure InitIdhttp; // 重新创建 FIdhttp, 如果读网页出错了，就用一下它(经验之谈)
 31 
 32     procedure ReadHtml; // 本例重点,请仔细看
 33     procedure DoReadHtml; // 本例重点,请仔细看
 34 
 35     procedure SetOnReadStatus(const Value: TOnReadStatus);
 36     procedure DoOnReadStatus(AStatus: TReadStatus); // 执行事件，关于事件均可参考此写法
 37     procedure SetHtml(const Value: string);
 38     procedure SetUrl(const Value: string);
 39     procedure SetListIndex(const Value: integer);
 40     procedure SetPosInList(const Value: integer);
 41 
 42   public
 43 
 44     constructor Create; reintroduce; // 再次把 Create 的参数去掉，为以后线程池做准备
 45     { 因为线程池会用到泛型的 LIST ，泛型定义时可以写一个约束条件 如：
 46       TSimpleThing<T:TXXObject,Constructor> 这个 Constructor 要求 T 的Create没有参数
 47     }
 48     destructor Destroy; override;
 49     procedure StartThread; override; // 启动线程，注意看!!!
 50     property OnReadStatus: TOnReadStatus read FOnReadStatus write SetOnReadStatus;
 51     property Url: string read FUrl Write SetUrl;
 52     property NewUrl: string read FNewUrl;
 53     property Html: string Read FHtml Write SetHtml;
 54     property ListIndex: integer read FListIndex write SetListIndex;
 55     property PosInList: integer read FPosInList write SetPosInList;
 56   end;
 57 
 58 implementation
 59 
 60 { TReadHtmlThread }
 61 uses
 62   uOperateIndy, SysUtils;
 63 { uOperateIndy 是我写的一个单元，操作Idhttp简便方法 }
 64 
 65 destructor TReadHtmlThread.Destroy;
 66 begin
 67   WaitThreadStop; // 在父中说了为什么要写这句
 68   if Assigned(FIdHttp) then
 69     FIdHttp.Free;
 70   inherited;
 71 end;
 72 
 73 procedure TReadHtmlThread.DoOnReadStatus(AStatus: TReadStatus);
 74 begin
 75   if Assigned(FOnReadStatus) then
 76     FOnReadStatus(self, AStatus);
 77 end;
 78 
 79 procedure TReadHtmlThread.DoReadHtml;
 80 begin
 81 
 82   // 这才是重点
 83 
 84   InitIdhttp;
 85 
 86   FNewUrl := FUrl;
 87   if IdhttpGet(FIdHttp, FUrl, FHtml) then
 88   begin
 89     FNewUrl := FIdHttp.Url.URI; // 重定向后的 Url
 90     DoOnReadStatus(rsOK)
 91   end
 92   else
 93     DoOnReadStatus(rsErr);
 94 
 95 end;
 96 
 97 procedure TReadHtmlThread.InitIdhttp;
 98 begin
 99   if Assigned(FIdHttp) then
100   begin
101     FIdHttp.Free;
102   end;
103   FIdHttp := TIdhttpEx.Create(nil);
104 end;
105 
106 procedure TReadHtmlThread.ReadHtml;
107 begin
108   ExeProcInThread(DoReadHtml); // 哈哈，就一句！
109 end;
110 
111 procedure TReadHtmlThread.SetHtml(const Value: string);
112 begin
113   FHtml := Value;
114 end;
115 
116 procedure TReadHtmlThread.SetListIndex(const Value: integer);
117 begin
118   FListIndex := Value;
119 end;
120 
121 procedure TReadHtmlThread.SetOnReadStatus(const Value: TOnReadStatus);
122 begin
123   FOnReadStatus := Value;
124 end;
125 
126 procedure TReadHtmlThread.SetPosInList(const Value: integer);
127 begin
128   FPosInList := Value;
129 end;
130 
131 procedure TReadHtmlThread.SetUrl(const Value: string);
132 begin
133   FUrl := Value;
134 end;
135 
136 procedure TReadHtmlThread.StartThread;
137 begin
138   inherited;
139   ReadHtml; // 其实还是这一句，哈哈
140 end;
141 
142 constructor TReadHtmlThread.Create;
143 begin
144   inherited Create(false);
145 end;
146 
147 end.
uReadHtmlThread.pas
附：delphi 进阶基础技能说明