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.
