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.
原文地址:https://www.cnblogs.com/delphi7456/p/1867681.html