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.
  • 相关阅读:
    二分图 洛谷P2055 [ZJOI2009]假期的宿舍
    并查集 洛谷P1640 [SCOI2010]连续攻击游戏
    贪心 洛谷P2870 Best Cow Line, Gold
    贪心 NOIP2013 积木大赛
    快速幂 NOIP2013 转圈游戏
    倍增LCA NOIP2013 货车运输
    树形DP 洛谷P2014 选课
    KMP UVA1328 Period
    动态规划入门 BZOJ 1270 雷涛的小猫
    KMP POJ 2752Seek the Name, Seek the Fame
  • 原文地址:https://www.cnblogs.com/delphi7456/p/1867681.html
Copyright © 2011-2022 走看看