zoukankan      html  css  js  c++  java
  • 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.
  • 相关阅读:
    我只想拍到这样的美景
    [转]为什么开发人员工作10多年了还会迷茫?没有安全感?
    【java入门系列】封装特性
    【java入门系列】继承特性
    【java入门系列】类和对象
    【java入门系列】导航篇
    数据库事务四大特性
    POI操作Excel
    mysql-优化
    mysql-强化
  • 原文地址:https://www.cnblogs.com/delphi7456/p/1867681.html
Copyright © 2011-2022 走看看