TWebBrowser控件的一个应用：在线刷Kx工具

先前用控制台程序做了个在线刷Kx的小工具，有一个问题就是perform wm_close后IE会报错：恢复当前会话什么的，而且占用资源也不小（主要是IE占资源）。

今晚想做一个VCL版的，特别是联系一下TWebBrowser控件等工具。通过对TWebBrowser控件的研究，熟悉了他的几个响应时间，也发觉其有一定的局限性。

或许是我没有找到具体的使用方法吧，至少怎样用TWebBrowser控件来控制自动登陆BBS我就没找到现成的控制函数，当然没找到并不代表没有，留个悬念吧。

有些收获我直接放在代码里了，有些还是总结一下吧：

1、用好时钟控件能减少一些代码的编写：本来想写个响应最小化的消息函数，来让程序隐藏切换至tray图标。但是发现可以利用WindowState=wsMinimized来

判断窗体的状态，最小化了就直接隐藏并切换至tray图标。

2、日期时间函数的学习，HourSpan和DaySpan的用法，来计算两个时间的间隔。

3、小数位数的操作RoundTo（）

 

下面附上源代码，不足之处希望多批评指正！

MainFrm的：

unit MainFrm;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, OleCtrls, SHDocVw, ExtCtrls, StdCtrls,DateUtils,Math;



type

  TForm1 = class(TForm)

    tmrStateMonitor: TTimer;

    tmrRefresh: TTimer;

    Panel1: TPanel;

    lstInfoShow: TListBox;

    wbIE: TWebBrowser;

    TrayIcon: TTrayIcon;

    procedure FormCreate(Sender: TObject);

    procedure wbIEDocumentComplete(ASender: TObject; const pDisp: IDispatch;

      var URL: OleVariant);

    procedure wbIENavigateError(ASender: TObject; const pDisp: IDispatch;

      var URL, Frame, StatusCode: OleVariant; var Cancel: WordBool);

    procedure tmrStateMonitorTimer(Sender: TObject);

    procedure tmrRefreshTimer(Sender: TObject);

    procedure TrayIconDblClick(Sender: TObject);

    procedure FormHide(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;



var

  Form1: TForm1;

  bDocumentComplete,bNavigateError:Boolean;

  StartTime:TDateTime;

  const sErrorLinkInternet:String='错误！无法访问网页！';

  const sSuccessLinkInternet:String=' 成功访问网页！';

  const sSuccessRefresh:String=' 成功刷新网页！';

  const sOnlineTime:string=' 在线时长：';

  const sHour:string='小时';



implementation



{$R *.dfm}



function GetOnlineTimeStr(StartTime,EndTime:TDateTime):string;

begin

  Result:=sOnlineTime+floattostr(RoundTo(HourSpan(StartTime,EndTime),-3))+sHour;

end;







procedure TForm1.FormCreate(Sender: TObject);

begin

  wbIE.Navigate('http://bbs.pediy.com/index.php');

end;







procedure TForm1.FormHide(Sender: TObject);

begin

  Hide();

  WindowState := wsMinimized;

  TrayIcon.Visible := True;

end;



procedure TForm1.tmrRefreshTimer(Sender: TObject);

begin

  wbIE.Refresh;//根据制定事件刷新网页

  lstInfoShow.Items.add(DateTimeToStr(now)+sSuccessRefresh+GetOnlineTimeStr(StartTime,Now));

end;



procedure TForm1.tmrStateMonitorTimer(Sender: TObject);

begin

  if bNavigateError then

  begin

    ShowMessage(sErrorLinkInternet);//无法打开网页时结束程序

    Application.Terminate;

  end;

  if bDocumentComplete and (tmrRefresh.Enabled=False) then

  begin

    StartTime:=Now;

    lstInfoShow.Items.add(DateTimeToStr(StartTime)+sSuccessLinkInternet);

    tmrRefresh.Enabled:=True;

  end;

  if WindowState=wsMinimized then// 最小化的时候切换到Tray

  begin

    Hide();

    TrayIcon.Visible := True;

  end;

end;



procedure TForm1.TrayIconDblClick(Sender: TObject);

begin

  { Hide the tray icon and show the window,

  setting its state property to wsNormal. }

  TrayIcon.Visible := False;

  Show();

  WindowState := wsNormal;

  Application.BringToFront();

end;



procedure TForm1.wbIEDocumentComplete(ASender: TObject; const pDisp: IDispatch;

  var URL: OleVariant);

begin

  //只要页面加载完毕就会发生这个事件，无论页面是否加载正常。

  //基于ReadyState属性来判断

  // 正常访问时，第一个显示DownloadComplete，

  //第二个相应的是NavigateComplete2 第三是downloadcomplete 第四才是documentcomplete

  //ShowMessage('DocumentComplete');

  bDocumentComplete:=True;

end;



//procedure TForm1.wbIEDownloadComplete(Sender: TObject);

//begin

//  //与onDocumentComplete事件类似，无论页面是否正常加载都会显示

//  // 发生错误时，第一个显示DownloadComplete，居然抢在 NavigateError前

//  //第三个相应的是NavigateComplete2 第四是downloadcomplete 第五是documentcomplete

//  //downloadcomplete还要出现一次。

//  //ShowMessage('DownloadComplete');

//end;



//procedure TForm1.wbIENavigateComplete2(ASender: TObject; const pDisp: IDispatch;

//  var URL: OleVariant);

//begin

// //Note:  Unlike the OnDownloadComplete event, OnNavigateComplete2 does not occur if the operation is not successful.

//   //ShowMessage('NavigateComplete2');

//end;



procedure TForm1.wbIENavigateError(ASender: TObject; const pDisp: IDispatch;

  var URL, Frame, StatusCode: OleVariant; var Cancel: WordBool);

begin

   //综合起来判断一次访问成功与否，关键在看出不出NavigateError

   //当 DocumentComplete发生，NavigateError不发生的时候，可以认为访问成功。

   //实际上，只要NavigateError发生，就报错终止程序，那么自然可以认为

   //DocumentComplete是访问成功的标志。

    //ShowMessage('NavigateError!');

    bNavigateError:=True;

end;

end.

Dpr的：

program RefreshKxTB;



uses

  Forms,

  MainFrm in 'MainFrm.pas' {Form1};



{$R *.res}



begin

  ReportMemoryLeaksOnShutdown:=True;

  Application.Initialize;

  Application.MainFormOnTaskbar := True;

  Application.CreateForm(TForm1, Form1);

  Application.Run;

end.