TWebBrowser - 它仅在显示其 Delphi 父窗体时才有效吗?

用户2834566

我有一个表格,叫做 FrmCheck,上面有一个 Twebbrowser。webbrowser 不需要显示,但为了方便我使用它(而不是 Indy 或动态创建 Twebbrowser)。FrmCheck 上唯一的公共功能是function CheckIP(TheIP:string):boolean;导航到几个网页,对 IP 地址进行一些处理,设置一个布尔返回值并退出。

该功能正常工作。

但是,我注意到当从另一个表单调用函数 CheckIP 时,它仅在 FrmCheck(包含 TWebBrowser 的表单)当时显示时返回。

即这有效

procedure TForm1.TestMyIPaddress(Sender: TObject);
var 
    myIP : string;
begin
myIP := GetExternalIPAddress;
FrmCheck.Show;

if FrmCheck.CheckIP(myIP) then
   ShowMessage('New IP address ' + myIP +' added to those allowed access')
else
    ShowMessage('IP address already there') ;
end;

但是有了 FrmCheck.Show; 注释掉函数不会返回。

即这不起作用

procedure TForm1.TestMyIPaddress(Sender: TObject);
var 
    myIP : string;
begin
myIP := GetExternalIPAddress;
 //FrmCheck.Show;

if FrmCheck.CheckIP(myIP) then
   ShowMessage('New IP address ' + myIP +' added to those allowed access')
else
    ShowMessage('IP address already there') ;
end;

作为一种解决方法,我发现我可以显示表单但立即使其不可见

即这确实有效并且不会在屏幕上显示表单,即所需的行为

procedure TForm1.TestMyIPaddress(Sender: TObject);
var 
    myIP : string;
begin
myIP := GetExternalIPAddress;
FrmCheck.Show;
FrmCheck.Visible := False;

if FrmCheck.CheckIP(myIP) then
   ShowMessage('New IP address ' + myIP +' added to those allowed access')
else
    ShowMessage('IP address already there') ;
end;

这是预期的行为吗?

TWebBrowser 是否仅在显示的表单上正确运行(即使表单不可见),还是我应该在其他地方寻找解释?


尊重 MartynA,这里是表单的代码,使用真实的函数名称而不是我用来明确问题要点的简化名称。

我仍然只问“TWebBrowser 是否只在显示的表单上正确运行”的问题?不是我的代码有什么问题。

unit U_FrmCheckIPaddressIsInAllowedHosts;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls,
  MSHTML,    //to access the ole bits of twebrowser
  StrUtils,  //for 'containstext' function
  IdHTTP,   //for GetExtenalIPAddress function
  SHDocVw,   //to get to the Twebbroswer Class so we can extend it
  ActiveX // For IOleCommandTarget   when adding extensions to Twebbrowser
  ;

type

//override Twebbrowser to add functionality to suppres js errors yet keep running code
//from https://stackoverflow.com/questions/8566659/how-do-i-make-twebbrowser-keep-running-javascript-after-an-error
  TWebBrowser = class(SHDocVw.TWebBrowser, IOleCommandTarget)
  private
    function QueryStatus(CmdGroup: PGUID; cCmds: Cardinal; prgCmds: POleCmd;
      CmdText: POleCmdText): HRESULT; stdcall;

    function Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD;
      const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; stdcall;
  end;
  ////////////////////////////////////////////////////

  TFrmCheckIPaddressIsInAllowedHosts = class(TForm)
    WebBrowser1: TWebBrowser;
    procedure WebBrowser1BeforeNavigate2(ASender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure WebBrowser1DocumentComplete(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure WebBrowser1NavigateComplete2(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

  private      { Private declarations }
    CurDispatch: IDispatch;  //used to wait until document is loaded
    FDocLoaded: Boolean;     //flag to indicate when document is loaded
    addresses : TStringList;  //to hold the list of IP addresses already in hosts list
    TheIPAddress:string;
    AddressAdded : Boolean; //set to True if added



    procedure LogIntoCpanelAndCheckIPaddress;
    function GetElementById(const Doc: IDispatch; const Id: string): IDispatch;
    function GetTextOfPage(WB:twebbrowser) : string;
    function IPaddressAlreadyPresent(TheIPAddress:string; HostList2:TstringList): boolean ;
    procedure Logout;
    procedure AddNewIPaddress(TheIPaddress: string);
    function GetExternalIPAddress: string;   //works without needing to create a file
  public
    { Public declarations }
     function CheckIPAddressAndAddIfNecessary(IPaddress:string):boolean;     //returns true if address added,false otherwise
  end;

var
  FrmCheckIPaddressIsInAllowedHosts: TFrmCheckIPaddressIsInAllowedHosts;
  CheckForIPaddress : Boolean;
  CanExit : Boolean;   //flag to say we have checked the address and maybe added it

implementation

{$R *.dfm}

{ TForm5 }


{ TWebBrowser extensions}

function TWebBrowser.Exec(CmdGroup: PGUID; nCmdID, nCmdexecopt: DWORD;
  const vaIn: OleVariant; var vaOut: OleVariant): HRESULT; stdcall;
begin
  // presume that all commands can be executed; for list of available commands
  // see SHDocVw.pas unit, using this event you can suppress or create custom
  // events for more than just script error dialogs, there are commands like
  // undo, redo, refresh, open, save, print etc. etc.
  // be careful, because not all command results are meaningful, like the one
  // with script error message boxes, I would expect that if you return S_OK,
  // the error dialog will be displayed, but it's vice-versa
  Result := S_OK;

  // there's a script error in the currently executed script, so
  if nCmdID = OLECMDID_SHOWSCRIPTERROR then
  begin
    // if you return S_FALSE, the script error dialog is shown
    Result := S_FALSE;
    // if you return S_OK, the script error dialog is suppressed
    Result := S_OK;
  end;
end;   { end of TWebBrowser extensions}



function TWebBrowser.QueryStatus(CmdGroup: PGUID; cCmds: Cardinal;
  prgCmds: POleCmd; CmdText: POleCmdText): HRESULT;  stdcall;
begin
    Result := S_OK;
end;


procedure TFrmCheckIPaddressIsInAllowedHosts.AddNewIPaddress(TheIPaddress: string);
var
  Elem: IHTMLElement;

begin
//get hold of the new hosts box and enter the new IP address
  Elem := GetElementById(WebBrowser1.Document, 'host') as IHTMLElement;
  if Assigned(Elem) then
   if Elem.tagName = 'INPUT' then (Elem as IHTMLInputElement).value := TheIPaddress;

   //now click the add hosts button
     Elem := GetElementById(WebBrowser1.Document, 'submit-button') as IHTMLElement;
  if Assigned(Elem) then
    Elem.click;
end;


function TFrmCheckIPaddressIsInAllowedHosts.CheckIPAddressAndAddIfNecessary(IPaddress:string):boolean;
begin
TheIPAddress :=     IPaddress;
AddressAdded := False;
LogIntoCpanelAndCheckIPaddress  ;
Result := AddressAdded;
end;

procedure TFrmCheckIPaddressIsInAllowedHosts.FormCreate(Sender: TObject);
begin
  addresses := TStringList.create;
end;

procedure TFrmCheckIPaddressIsInAllowedHosts.FormDestroy(Sender: TObject);
begin
 addresses.Free;
end;



function TFrmCheckIPaddressIsInAllowedHosts.GetElementById(const Doc: IDispatch;  const Id: string): IDispatch;
 var
  Document: IHTMLDocument2;     // IHTMLDocument2 interface of Doc
  Body: IHTMLElement2;          // document body element
  Tags: IHTMLElementCollection; // all tags in document body
  Tag: IHTMLElement;            // a tag in document body
  I: Integer;                   // loops thru tags in document body
begin
  Result := nil;
  // Check for valid document: require IHTMLDocument2 interface to it
  if not Supports(Doc, IHTMLDocument2, Document) then
    raise Exception.Create('Invalid HTML document');
  // Check for valid body element: require IHTMLElement2 interface to it
  if not Supports(Document.body, IHTMLElement2, Body) then
    raise Exception.Create('Can''t find <body> element');
  // Get all tags in body element ('*' => any tag name)
  Tags := Body.getElementsByTagName('*');
  // Scan through all tags in body
  for I := 0 to Pred(Tags.length) do
      begin
        // Get reference to a tag
        Tag := Tags.item(I, EmptyParam) as IHTMLElement;
        // Check tag's id and return it if id matches
        if AnsiSameText(Tag.id, Id) then
        begin
          Result := Tag;
          Break;
        end;
      end;
end;

function TFrmCheckIPaddressIsInAllowedHosts.GetExternalIPAddress: string;
 //this is a copy of the function that is already in U_GeneralRoutines in mambase
var
i: integer;
PageText : string;
MStream : TMemoryStream;
HttpClient: TIdHTTP;  //need 'uses IdHTTP '

begin
//use http://checkip.dyndns.org to return ip address in a page containing the single line below
// <html><head><title>Current IP Check</title></head><body>Current IP Address: 82.71.38.7</body></html>
 Result := '';
 MStream := TMemoryStream.Create;
 HttpClient := TIdHTTP.Create;
 try
    try
    HttpClient.Get( 'http://checkip.dyndns.org/', MStream );  //download web page to a memory stream (instead of a file)
    HttpClient.Disconnect;  //not strickly necessary but prevents error 10054 Connection reset by peer
    SetString(PageText, PAnsiChar(MStream.Memory), MStream.Size) ; //assign stream contents to a string called PageText
    for i := 1 to Length(PageText) do      //extract just the numeric ip address from the line returned from the web page
        if (PageText[i] in ['0'..'9','.']) then
           Result := Result + PageText[i]  ;
    except
    on E : Exception do
      begin
      showmessage ('Could not download from checkip'  +slinebreak
                  +'Exception class name = '+E.ClassName+ slinebreak
                  +'Exception message = '+E.Message);
      end  //on E
    end;//try except

 finally
    MStream.Free;
    FreeAndNil(HttpClient);   //freenamdnil needs sysutils
 end;
end;


function TFrmCheckIPaddressIsInAllowedHosts.GetTextOfPage(WB: twebbrowser): string;
var
  Document: IHtmlDocument2;
begin
  document := WB.document as IHtmlDocument2;
  result := trim(document.body.innertext);  // to get text
 end;

function TFrmCheckIPaddressIsInAllowedHosts.IPaddressAlreadyPresent(TheIPAddress: string;
  HostList2: TstringList): boolean;
const
      digits = ['0'..'9'];
  var
    i,j,k : integer;
    line : string;
    match : boolean;
begin
result := false;  //assume the IP address is not there

////////////////////////
 for i := 0 to HostList2.Count - 1 do
     begin
     Line := HostList2[i];  // or Memo1.Lines.Strings[i]; //  get one line

     if (line <> '') and (line[1] in digits) then  //first character is a digit so we are on an IP address row  - note if line = '' then line[i] is not (and cannot be), evaluated

   //  if length(line) >= length(TheIPAddress) then  //could possibly match
        begin
        match := true;    //assume they match
        for j := 1 to length(TheIPAddress) do
          begin
          if not ((TheIPAddress[j] = line[j]) or (line[j] = '%')) then   //they don't match
              match := false;
          end;
         //set flag for result of this comparison
        if match then  //every position must have matched
          begin
          result := match;
          Exit;   //quit looping through lin4es as we have found it
          end;
        end; // if length(line) >= length(TheIPAddress)
     end;// for i := 0 to HostList.Lines.Count - 1
end;

procedure TFrmCheckIPaddressIsInAllowedHosts.LogIntoCpanelAndCheckIPaddress;
var
  Elem: IHTMLElement;
  Document: IHtmlDocument2;
 // d: OleVariant;
begin

//set teh global variable to say whether we check the text of the page or not
CheckForIPaddress := True; //as we haven't checked yet. this gets set to false after the first check
CanExit := False;  //don't exit this section until we have checked the address

//navigate to the cpanel IP hosts page - as part of this process we wil have to log on

  WebBrowser1.Navigate('https://thewebsite address.html');  //this goes through the login page
   repeat
     Application.ProcessMessages
   until FDocLoaded;

//while the page is loading, every time WebBrowser1DocumentComplete fires
//we check to see if we are on the hosts page and if so process the ip address

//now the log on page will be showing as part of navigating to the hosts page so
//fill in the user name and passwrord
   Elem := GetElementById(WebBrowser1.Document, 'user') as IHTMLElement;
  if Assigned(Elem) then
   if Elem.tagName = 'INPUT' then (Elem as IHTMLInputElement).value := 'the user';

//now the password
  Elem := GetElementById(WebBrowser1.Document, 'pass') as IHTMLElement;
  if Assigned(Elem) then
   if Elem.tagName = 'INPUT' then (Elem as IHTMLInputElement).value := 'thepassword';

   // now click the logon button
 Elem := GetElementById(WebBrowser1.Document, 'login_submit') as IHTMLElement;
  if Assigned(Elem) then
    Elem.click;

   repeat
     Application.ProcessMessages
   until FDocLoaded;

    //now we are logged on so see what the url is so we know the security token
   //    memo1.Lines.Add(WebBrowser1.LocationURL); //debug, show the url so we can get the security code

   //now wait until we have finished any residual processing of the IP address and then exit
   repeat
     Application.ProcessMessages
   until CanExit;
   Logout;
 end;

procedure TFrmCheckIPaddressIsInAllowedHosts.Logout;
begin
WebBrowser1.Navigate( 'https://thelogouturl' );
   repeat
     Application.ProcessMessages
   until FDocLoaded;
   showmessage('logged out');
end;


procedure TFrmCheckIPaddressIsInAllowedHosts.WebBrowser1BeforeNavigate2(ASender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
   CurDispatch := nil;
      FDocLoaded := False;
end;

procedure TFrmCheckIPaddressIsInAllowedHosts.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
  var s : string;
begin
     if (pDisp = CurDispatch) then
      begin
        FDocLoaded := True;
        CurDispatch := nil;
      end;

    //WebBrowser1DocumentComplete is called many times and so FDocLoaded could be true many times
    //to avoid checking the ip address multiple times we use a global variable CheckForIPaddress as a flag
    //to ensure we only check once

    if CheckForIPaddress and FDocLoaded then     //if CheckForIPaddress is false then we have already checked so don't do it again
        begin
        //now check which page we are on. if its the hosts page then we have the text we need
         s := GetTextOfPage(Webbrowser1);
         if ContainsText(s,'Remote Database Access Hosts') then //we are on the hosts page
          begin     //process the ip address with respect to those already recorded
          CheckForIPaddress := false; //reset the flag so that we don't bother checking each time FDocLoaded is true
          addresses.text :=s;       //put the addresses into a list so we can check them
          if IPaddressAlreadyPresent(TheIPAddress, addresses) then
              begin
              AddressAdded := false;
             // showmessage('already there');
             // Logout;
              end
          else
             begin
            // showmessage('not there');
             AddNewIPaddress(TheIPAddress);
             AddressAdded := True;
            // Logout;
             end;
          //either way we can now exit
          CanExit := True; //the procedure  LogIntoCpanelAndGotToHostsPage can exit back to the main program when it finishes
          end;
        end; //if FDocLoaded



end;

procedure TFrmCheckIPaddressIsInAllowedHosts.WebBrowser1NavigateComplete2(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
       if CurDispatch = nil then
        CurDispatch := pDisp;
end;

end.
斯蒂恩·桑德斯

打电话WebBrowser1.HandleNeeded;之前先打电话Navigate

本文收集自互联网,转载请注明来源。

如有侵权,请联系[email protected] 删除。

编辑于
0

我来说两句

0条评论
登录后参与评论

相关文章

来自分类Dev

带有TWebBrowser的MultiView Android Delphi

来自分类Dev

自上次显示以来,检测Delphi TWebBrowser网页已更改的最佳方法是什么?

来自分类Dev

Delphi-TWebBrowser中的证书错误,IE9中没有错误

来自分类Dev

Delphi-TWebBrowser中的证书错误,IE9中没有错误

来自分类Dev

delphi twebbrowser设置Element的属性样式无效

来自分类Dev

Delphi Twebbrowser识别html元素ID

来自分类Dev

从Delphi 10.3中的TWebBrowser OnNavigateError提取StatusCode

来自分类Dev

Delphi Twebbrowser识别html元素ID

来自分类Dev

Delphi TWebBrowser无法从LocalHost运行Javascript

来自分类Dev

Powershell 脚本仅在存在断点时才有效

来自分类Dev

glDrawArrays仅在我向其传递“错误”数据时才有效

来自分类Dev

仅在Perl中存在哈希条目时才有效地获取它

来自分类Dev

清除DRAW帧缓冲区仅在附加到GL_COLOR_ATTACHMENT0时才有效吗?

来自分类Dev

Delphi TWebBrowser.GoBack:如何处理重定向

来自分类Dev

__doPostBack仅在页面上有LinkButton,Calendar或WizardStep控件时才有效

来自分类Dev

Mypy:具有某些方法的通用容器仅在应用附加协议时才有效

来自分类Dev

CSS文本过渡仅在HTML输入具有“ required”标签时才有效

来自分类Dev

push.default 仅在没有定义 ref 规范时才有效?

来自分类Dev

如何验证该字段大于仅在检查特定按钮时才有效

来自分类Dev

媒体查询断点仅在启用触摸模拟时才有效

来自分类Dev

SVG过滤器仅在样式属性中添加时才有效(Firefox)

来自分类Dev

页面上的自动滚动仅在 ctrl+单击使用 jquery 的按钮时才有效

来自分类Dev

数据绑定仅在 select ng-options 中使用 as 语法时才有效

来自分类Dev

wpf datagrid mousebinding leftdoubleclick 命令仅在项目已被选中时才有效

来自分类Dev

代码仅在未包装在函数中时才有效

来自分类Dev

仅在插入断点时才有效的 iOS Drawer UI

来自分类Dev

为什么我的 tkinter 窗口仅在全局创建时才有效?

来自分类Dev

Nginx 仅在将工作进程用户设置为 root 时才有效

来自分类Dev

我的底部导航栏仅在我双击以切换片段时才有效

Related 相关文章

  1. 1

    带有TWebBrowser的MultiView Android Delphi

  2. 2

    自上次显示以来,检测Delphi TWebBrowser网页已更改的最佳方法是什么?

  3. 3

    Delphi-TWebBrowser中的证书错误,IE9中没有错误

  4. 4

    Delphi-TWebBrowser中的证书错误,IE9中没有错误

  5. 5

    delphi twebbrowser设置Element的属性样式无效

  6. 6

    Delphi Twebbrowser识别html元素ID

  7. 7

    从Delphi 10.3中的TWebBrowser OnNavigateError提取StatusCode

  8. 8

    Delphi Twebbrowser识别html元素ID

  9. 9

    Delphi TWebBrowser无法从LocalHost运行Javascript

  10. 10

    Powershell 脚本仅在存在断点时才有效

  11. 11

    glDrawArrays仅在我向其传递“错误”数据时才有效

  12. 12

    仅在Perl中存在哈希条目时才有效地获取它

  13. 13

    清除DRAW帧缓冲区仅在附加到GL_COLOR_ATTACHMENT0时才有效吗?

  14. 14

    Delphi TWebBrowser.GoBack:如何处理重定向

  15. 15

    __doPostBack仅在页面上有LinkButton,Calendar或WizardStep控件时才有效

  16. 16

    Mypy:具有某些方法的通用容器仅在应用附加协议时才有效

  17. 17

    CSS文本过渡仅在HTML输入具有“ required”标签时才有效

  18. 18

    push.default 仅在没有定义 ref 规范时才有效?

  19. 19

    如何验证该字段大于仅在检查特定按钮时才有效

  20. 20

    媒体查询断点仅在启用触摸模拟时才有效

  21. 21

    SVG过滤器仅在样式属性中添加时才有效(Firefox)

  22. 22

    页面上的自动滚动仅在 ctrl+单击使用 jquery 的按钮时才有效

  23. 23

    数据绑定仅在 select ng-options 中使用 as 语法时才有效

  24. 24

    wpf datagrid mousebinding leftdoubleclick 命令仅在项目已被选中时才有效

  25. 25

    代码仅在未包装在函数中时才有效

  26. 26

    仅在插入断点时才有效的 iOS Drawer UI

  27. 27

    为什么我的 tkinter 窗口仅在全局创建时才有效?

  28. 28

    Nginx 仅在将工作进程用户设置为 root 时才有效

  29. 29

    我的底部导航栏仅在我双击以切换片段时才有效

热门标签

归档