2017-12-07 6 views
-1

폼이 있는데, Twebbrowser가있는 FrmCheck라고합니다. 웹 브라우저를 표시 할 필요는 없지만 편리하게 Indy 대신 또는 동적으로 Twebbrowser를 생성하여 사용하고 있습니다. FrmCheck의 공용 함수는 function CheckIP(TheIP:string):boolean;이며 일부 웹 페이지로 이동하고 IP 주소와 관련된 일부 처리를 수행하며 부울 반환 값을 설정하고 종료합니다.TWebBrowser - Delphi 상위 형식이 표시 될 때만 작동합니까?

이 기능은 올바르게 작동합니다.

그러나 Function 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는 표시되는 양식 (양식이 보이지 않더라도)에서만 올바르게 작동합니까? 아니면 다른 곳에서 설명을 찾아야합니까? 마르티나에 대한 존중에서


, 여기에 대신 내 질문의 요점을 명확하게하기 위해 사용되는 단순화 된 사람의 실제 함수 이름을 사용하여 양식의 코드입니다.

나는 '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. 
+0

FrmCheck의 작동 방식을 묻고 있지만 코드가 표시되지 않았기 때문에이 코드는 하향 형 코드를 사용해야합니다. 우리 독자들은 어떻게하면 무엇을해야하는지 알 수 있습니까? FormShow 또는 FormActivate 이벤트에서? – MartynA

+2

헤드리스 브라우저 또는 인디가 필요합니다. – whosrdaddy

+0

@MartynA 내 FrmCheck의 작동 방식을 묻지 않습니다! Twebbrowser가 제대로 작동하려면 Twebbrowser가 켜져 있어야하는지 묻는 것입니다. 그러나 당신이 주장하기 때문에 나는 내 코드를 보여줄 것이지만 나는 그 질문을 너무 장황하게하기 위해 투표 할 것입니다. – user2834566

답변

1

Navigate으로 전화하기 전에 WebBrowser1.HandleNeeded;으로 전화하십시오.

관련 문제