TWebBrowser - Delphi親フォームが表示されている場合にのみ機能しますか？

Question

私はフォームを持っています、それをTwebbrowserでFrmCheckと呼んでください。 Webブラウザは表示する必要はありませんが、私は便宜上、Indyの代わりに、またはTwebbrowserを動的に作成して使用しています。 FrmCheckの唯一のpublic関数は、いくつかのWebページに移動し、IPアドレスを処理するいくつかの処理を行い、ブール戻り値を設定して終了するfunction CheckIP(TheIP:string):boolean;です。

この機能は正しく機能します。

しかし、関数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. 

Answer 1

Navigateに電話する前にWebBrowser1.HandleNeeded;に電話をかけてください。