/* * Xailer source code: * * WebBrowser.prg * XWebBrowser() class * * Copyright 2007 Xailer.com * All rights reserved * */ #include "Xailer.ch" #include "WebBrowser.ch" CLASS XWebBrowser FROM TOcx // Microsoft Web Browser PROPERTY cCLSID INIT "Shell.Explorer.2" PUBLISHED: PROPERTY nWidth INIT 200 PROPERTY nHeight INIT 200 PROPERTY nAlign INIT alNONE /* The horizontal position (pixels) of the frame window relative to the screen/container. */ PROPERTY Left ID 206 AS NUMERIC /* The vertical position (pixels) of the frame window relative to the screen/container. */ PROPERTY Top ID 207 AS NUMERIC /* The horizontal dimension (pixels) of the frame window/object. */ PROPERTY Width ID 208 AS NUMERIC /* The vertical dimension (pixels) of the frame window/object. */ PROPERTY Height ID 209 AS NUMERIC /* Determines whether the application is visible or hidden. */ PROPERTY Visible ID 402 AS LOGICAL /* Turn on or off the statusbar. */ PROPERTY StatusBar ID 403 AS LOGICAL /* Text of Status window. */ PROPERTY StatusText ID 404 AS CHARACTER /* Controls which toolbar is shown. */ PROPERTY ToolBar ID 405 AS NUMERIC /* Controls whether menubar is shown. */ PROPERTY MenuBar ID 406 AS LOGICAL /* Maximizes window and turns off statusbar, toolbar, menubar, and titlebar. */ PROPERTY FullScreen ID 407 AS LOGICAL /* Controls if the frame is offline (read from cache) */ PROPERTY Offline ID 550 AS LOGICAL /* Controls if any dialog boxes can be shown */ PROPERTY Silent ID 551 AS LOGICAL /* Registers OC as a top-level browser (for target name resolution) */ PROPERTY RegisterAsBrowser ID 552 AS LOGICAL /* Registers OC as a drop target for navigation */ PROPERTY RegisterAsDropTarget ID 553 AS LOGICAL /* Controls if the browser is in theater mode */ PROPERTY TheaterMode ID 554 AS LOGICAL /* Controls whether address bar is shown */ PROPERTY AddressBar ID 555 AS LOGICAL /* Controls whether the window is resizable */ PROPERTY Resizable ID 556 AS LOGICAL /* Statusbar text changed. */ EVENT StatusTextChange( cText ) /* Fired when download progress is updated. */ EVENT ProgressChange( nProgress, nProgressMax ) /* The enabled state of a command changed. */ EVENT CommandStateChange( nCommand, lEnable ) /* Download of a page started. */ EVENT DownloadBegin() /* Download of page complete. */ EVENT DownloadComplete() /* Document title changed. */ EVENT TitleChange( cText ) /* Fired when the PutProperty method has been called. */ EVENT PropertyChange( cszProperty ) /* Fired before navigate occurs in the given WebBrowser (window or frameset element). The processing of this navigation may be modified. */ EVENT BeforeNavigate2( disppDisp, vURL, vFlags, vTargetFrameName, vPostData, vHeaders, @lCancel ) /* A new, hidden, non-navigated WebBrowser window is needed. */ EVENT NewWindow2( @dispppDisp, @lCancel ) /* Fired when the document being navigated to becomes visible and enters the navigation stack. */ EVENT NavigateComplete2( disppDisp, vURL ) /* Fired when the document being navigated to reaches ReadyState_Complete. */ EVENT DocumentComplete( disppDisp, vURL ) /* Fired when application is quiting. */ EVENT OnQuit() /* Fired when the window should be shown/hidden */ EVENT OnVisible( lVisible ) /* Fired when the toolbar should be shown/hidden */ EVENT OnToolBar( lToolBar ) /* Fired when the menubar should be shown/hidden */ EVENT OnMenuBar( lMenuBar ) /* Fired when the statusbar should be shown/hidden */ EVENT OnStatusBar( lStatusBar ) /* Fired when fullscreen mode should be on/off */ EVENT OnFullScreen( lFullScreen ) /* Fired when theater mode should be on/off */ EVENT OnTheaterMode( lTheaterMode ) /* Fired when the host window should allow/disallow resizing */ EVENT WindowSetResizable( lResizable ) /* Fired when the host window should change its Left coordinate */ EVENT WindowSetLeft( nLeft ) /* Fired when the host window should change its Top coordinate */ EVENT WindowSetTop( nTop ) /* Fired when the host window should change its width */ EVENT WindowSetWidth( nWidth ) /* Fired when the host window should change its height */ EVENT WindowSetHeight( nHeight ) /* Fired when the WebBrowser is about to be closed by script */ EVENT WindowClosing( lIsChildWindow, @lCancel ) /* Fired to request client sizes be converted to host window sizes */ EVENT ClientToHostWindow( @nCX, @nCY ) /* Fired to indicate the security level of the current web page contents */ EVENT SetSecureLockIcon( nSecureLockIcon ) /* Fired to indicate the File Download dialog is opening */ EVENT FileDownload( lActiveDocument, @lCancel ) /* Fired when a binding error occurs (window or frameset element). */ EVENT NavigateError( disppDisp, vURL, vFrame, vStatusCode, @lCancel ) /* Fired when a print template is instantiated. */ EVENT PrintTemplateInstantiation( disppDisp ) /* Fired when a print template destroyed. */ EVENT PrintTemplateTeardown( disppDisp ) /* Fired when a page is spooled. When it is fired can be changed by a custom template. */ EVENT UpdatePageStatus( disppDisp, vnPage, vfDone ) /* Fired when the global privacy impacted state changes */ EVENT PrivacyImpactedStateChange( lbImpacted ) /* A new, hidden, non-navigated WebBrowser window is needed. */ EVENT NewWindow3( @dispppDisp, @lCancel, ndwFlags, cbstrUrlContext, cbstrUrl ) /* Fired to indicate the progress and status of the Phishing Filter analysis of the current web page */ EVENT SetPhishingFilterStatus( nPhishingFilterStatus ) /* Fired to indicate that the browser window's visibility or enabled state has changed. */ EVENT WindowStateChanged( ndwWindowStateFlags, ndwValidFlagsMask ) /* A new, hidden, non-navigated process is created to handle the navigation. */ EVENT NewProcess( nlCauseFlag, disppWB2, @lCancel ) /* Fired when a third-party URL is blocked. */ EVENT ThirdPartyUrlBlocked( vURL, ndwCount ) /* Fired when a x-domain redirect is blocked. */ EVENT RedirectXDomainBlocked( disppDisp, vStartURL, vRedirectURL, vFrame, vStatusCode ) /* Fired prior to the first script execution. */ EVENT BeforeScriptExecute( disppDispWindow ) /* Fired after a Web Worker has been started. */ EVENT WebWorkerStarted( ndwUniqueID, cbstrWorkerLabel ) /* Fired after a Web Worker has closed */ EVENT WebWorkerFinsihed( ndwUniqueID ) PUBLIC: /* Returns the application automation object if accessible, this automation object otherwise.. */ PROPERTY Application ID 200 AS IDispatch READONLY /* Returns the automation object of the container/parent if one exists or this automation object. */ PROPERTY Parent ID 201 AS IDispatch READONLY /* Returns the container/parent automation object, if any. */ PROPERTY Container ID 202 AS IDispatch READONLY /* Returns the active Document automation object, if any. */ PROPERTY Document ID 203 AS IDispatch READONLY /* Returns True if this is the top level object. */ PROPERTY TopLevelContainer ID 204 AS LOGICAL READONLY /* Returns the type of the contained document object. */ PROPERTY Type ID 205 AS CHARACTER READONLY /* Gets the short (UI-friendly) name of the URL/file currently viewed. */ PROPERTY LocationName ID 210 AS CHARACTER READONLY /* Gets the full URL/path currently viewed. */ PROPERTY LocationURL ID 211 AS CHARACTER READONLY /* Query to see if something is still in progress. */ PROPERTY Busy ID 212 AS LOGICAL READONLY /* Returns file specification of the application, including path. */ PROPERTY FullName ID 400 AS CHARACTER READONLY /* Returns the path to the application. */ PROPERTY Path ID 401 AS CHARACTER READONLY /* Navigates to the previous item in the history list. */ METHOD GoBack() ID 100 /* Navigates to the next item in the history list. */ METHOD GoForward() ID 101 /* Go home/start page. */ METHOD GoHome() ID 102 /* Go Search Page. */ METHOD GoSearch() ID 103 /* Navigates to a URL or file. */ METHOD Navigate( cURL, vFlags, vTargetFrameName, vPostData, vHeaders ) ID 104 /* Refresh the currently viewed page. */ METHOD Refresh2( vLevel ) ID 105 /* Stops opening a file. */ METHOD Stop() ID 106 /* Exits application and closes the open document. */ METHOD Quit() ID 300 /* Converts client sizes into window sizes. */ METHOD ClientToWindow( @npcx, @npcy ) ID 301 /* Associates vtValue with the name szProperty in the context of the object. */ METHOD PutProperty( cProperty, vvtValue ) ID 302 /* Retrieve the Associated value for the property vtValue in the context of the object. */ METHOD GetProperty( cProperty ) AS v ID 303 /* Navigates to a URL or file or pidl. */ METHOD Navigate2( vURL, vFlags, vTargetFrameName, vPostData, vHeaders ) ID 500 /* IOleCommandTarget::QueryStatus */ METHOD QueryStatusWB( ucmdID ) ID 501 /* IOleCommandTarget::Exec */ METHOD ExecWB( ucmdID, ucmdexecopt, vpvaIn, vpvaOut ) ID 502 /* Set BrowserBar to Clsid */ METHOD ShowBrowserBar( vpvaClsid, vpvarShow, vpvarSize ) ID 503 // Xailer METHOD New( oParent ) ENDCLASS //------------------------------------------------------------------------------ #include "Winreg.api" METHOD New( oParent ) CLASS XWebBrowser LOCAL nVersion IF GetVersionEx()[ 1 ] >= 6.01 // Windows 7 // Establecer compatibilidad de WebBrowser con IExx WITH OBJECT TRegistry():New() :Root := HKEY_LOCAL_MACHINE IF :OpenKey( "Software\Microsoft\Internet Explorer", 1 ) == 0 IF ( nVersion := Val( :GetString( "svcVersion", "" ) ) ) == 0 nVersion := Val( :GetString( "Version", "" ) ) ENDIF ENDIF :CloseKey() IF !Empty( nVersion ) nVersion := Int( nVersion ) * 1000 :Root := HKEY_CURRENT_USER IF :OpenKey( "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION" ) != 0 :CreateKey( "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION" ) ENDIF :CloseKey() IF :OpenKey( "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION" ) == 0 IF :GetNumeric( FileFullName( Application:cFileName ) ) < nVersion :SetNumeric( FileFullName( Application:cFileName ), nVersion ) ENDIF :CloseKey() ENDIF IF :OpenKey( "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_DOCUMENT_COMPATIBLE_MODE" ) != 0 :CreateKey( "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_DOCUMENT_COMPATIBLE_MODE" ) ENDIF :CloseKey() IF :OpenKey( "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_DOCUMENT_COMPATIBLE_MODE" ) == 0 IF :GetNumeric( FileFullName( Application:cFileName ) ) < nVersion :SetNumeric( FileFullName( Application:cFileName ), nVersion ) ENDIF :CloseKey() ENDIF ENDIF END ENDIF RETURN ::Super:New( oParent ) //------------------------------------------------------------------------------