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 進階基礎技能說明