作用是取得网页的HTML源码,使用idHttp控件。
       将获取的过程写在线程里,不再主线程内运行,是防止界面的无响应现象。idAntiFree控件虽然可以做到,但是效果不明显。很多时候线程里不可能做太多的事情,可能用来通用化,而且线程之间的通信还是比较麻烦,用消息的方法虽然简单,但是如果我用来接受消息的类是不可视的话,使用AllocateHWnd函数来建立消息句柄将占用资源,所以这个时候使用回调函数是比较折中的办法,虽然不太符合OO设计^_^.
       下面是代码(WinXP SP2 + D2006测试通过)...

unit MainFrm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdHTTP;
type
TCallBack = procedure(Html: string) of object;

type
TForm1 = class(TForm)
    mmo1: TMemo;
    btn1: TButton;
    edt1: TEdit;
    procedure btn1Click(Sender: TObject);
private
    procedure myCallBack(Html: string);
    { Private declarations }
public
    { Public declarations }
end;

THtmlThreade = class(TThread)
private
    FHttp: TIdHTTP;
    FUrl: string;
    myCallBack: TCallBack;
protected
    procedure Execute; override;
public
    constructor Create(aUrl: string; CallBack: TCallBack);
    destructor Destroy; override;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.myCallBack(Html: string);
begin
mmo1.Text := Html;
end;

{ THtmlThreade }
procedure THtmlThreade.Execute;
begin
myCallBack(FHttp.Get(FUrl));
end;

constructor THtmlThreade.Create(aUrl: string; CallBack: TCallBack);
begin
inherited Create(True);
FUrl := aUrl;
myCallBack := CallBack;
FHttp := TIdHTTP.Create(nil);
FreeOnTerminate := True;
end;

destructor THtmlThreade.Destroy;
begin
FHttp.Free;
inherited Destroy;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
mythread: THtmlThreade;
begin
mythread := THtmlThreade.Create(edt1.Text, myCallBack);
mythread.Resume;
end;

end.

Last modification:August 5th, 2010 at 11:20 am
如果觉得我的文章对你有用,请随意赞赏