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.

附：delphi 进阶基础技能说明