TWebBrowser - Does it only work when its Delphi parent form is showing?

Question

I have a form, call it FrmCheck, with a Twebbrowser on it. The webbrowser does not need to be shown but I an using it (instead of Indy or dynamically creating the Twebbrowser) for convenience. The only public function on FrmCheck is function CheckIP(TheIP:string):boolean; that navigates to a few web pages, does some processing to do with IP addresses, sets a boolean retun value and exits.

The function works correctly.

However, I've noticed that when function CheckIP is called from another form, it only returns if FrmCheck (the form containing the TWebBrowser) is showing at the time.

ie this works

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;

But with the FrmCheck.Show; commented out the function doesn't return.

ie this does not work

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;

As a work around I found I could show the form but immediately make it invisible

ie this does work and does not show the form on the screen, the desired behaviour

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;

Is this expected behaviour?

Does a TWebBrowser only operate correctly when it is on a form that is being shown (even if the form is invisible), or should I be looking elsewhere for an explanation?

In deference to MartynA, here is the code of the form, using the real function names instead of the simplified ones I used to make the point of my question clear.

I am still only asking the question 'Does a TWebBrowser only operate correctly when it is on a form that is being shown'? and not what is wrong with my code.

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  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
// Current IP CheckCurrent IP Address: 82.71.38.7
 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.

Stijn Sanders · Accepted Answer

Call WebBrowser1.HandleNeeded; before calling Navigate.

TWebBrowser - Does it only work when its Delphi parent form is showing?

Answers (1)

Related Questions