Code-Beispiel

InternetExplorer Steuerelement ActiveX

Lizenz:	Erster Autor:	Letzte Bearbeitung:
FBPSL	Marcedo	26.03.2016

Lust und Laune mit dem Internet Explorer Steuerelement

Ich wollte mal sehen, ob man mit FreeBASIC mittlerweile auf relativ einfache weise ActiveX Elemente steuern kann. Antwort - jo - :)
Verwendet hab ich die aktuelle FBIde von Sourceforge und die AXSuite3.2 von hier

Beispiel Download link:hier

NOTE: I will leave this Sample in this Version, to keep this ones simplicity here.
Current Version placed in the Link above.

'================================================================================

' Utilize InternetExplorer with FreeBASIC, using AXSuite3.2

' The most up to date version of AXSuite3, containing install notes, is made available in this Thread:

' http://www.freebasic.net/forum/search.php?keywords=axsuite3&fid[0]=6

' 27.02.2016 - Marcedo@HabMalNeFrage.de

'================================================================================



#Include Once "Windows.bi"       ' Windows specific

#Include Once "Ax_lite.bi"          ' this one is needed

#Include Once "ie_invoke.bi"    ' Generated this with AXSuite->CodeGeneration->Invoke



'-------  Global COM instance initialization , only one by project

AxInit(TRUE)     '   False : if all Ocx controls are WindowLess controls , else True



Dim Shared As any Ptr      Obj_Ptr   ' object Ptr

Dim Shared As IWebBrowser2  Obj_Disp ' vTable type ptr

Dim IEReady As Integer



    'get object control address with prodid

    Obj_Ptr = AxCreate_Object( "InternetExplorer.Application" , "{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}" )

    SetObj ( @Obj_Disp , Obj_Ptr )



'------ Now lets configure the Control :)



    axcall Obj_Disp.putVisible,vptr(TRUE)

    axcall Obj_Disp.putStatusBar, vptr(TRUE)

    axcall Obj_Disp.putStatusText, vptr("TRUE")



'------ Navigate and wait for IE to load the Site

   axcall Obj_Disp.Navigate,vptr("www.facebook.com") ,vptr(0),vptr(0) ,vptr(0) ,vptr(0)

   Ex: Dim vIndex As Variant : Vlet(vIndex, 1)



    Do

       IEReady = variantv(AxGet(Obj_Disp.GetReadyState,@vIndex))

        Print "IE Status ="; IEReady

    Loop Until IEReady = 4





' ----- Release Object

    'axcall Obj_Disp.quit

     AxRelease_Object(Obj_Ptr)     'release object

Test function call using pvti (vTable)

#Include Once "ie_invoke.bi"
Dim Shared As IWebBrowser2_ Ptr pVTI ' vTable type ptr
Dim Shared As any Ptr testptr ' object Ptr
pVTI = Obj_Ptr
'pVTI->lpvtbl->Navigate2(pVTI, vptr("google.com") ,vptr(0),vptr(0) ,vptr(0) ,vptr(0))

How to get IHtmlDocument2 (IHTMLWindow2*)

First hints found QueryInterface

Another Idea may be to use the event documentComplet In Freebasic,
it could be implemented like So!
IhtmlDOcument2

Hier noch die Prototypen des Wrappers. Generiert mit AXSuite->CodeGeneration->Invoke

Hinweis Die Namen von Feldern innerhalb Typen , die genau so benannt wurden, wie FreeBasic oder Classen Keywords,führen beim compilieren zu [error 237] und können einfach manuell umbenannt werden -> "loop" wird also zu "DOloop" und gut :)

' --------------------------------ie_Invoke.bi



'================================================================================

'Dispatch IWebBrowser2     ?Web Browser Interface for IE4.

'Const IID_IWebBrowser2="{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}"

'================================================================================

Type IWebBrowser2

    QueryInterface As tMember = (1610612736,2,2,1)    ' As Function(riid As GUID Ptr,ppvObj As any ptr Ptr Ptr) As any ptr

    AddRef As tMember = (1610612737,2,0,1)    ' As Function() As Uinteger

    Release As tMember = (1610612738,2,0,1)    ' As Function() As Uinteger

    GetTypeInfoCount As tMember = (1610678272,2,1,1)    ' As Function(pctinfo As Uinteger Ptr) As any ptr

    GetTypeInfo As tMember = (1610678273,2,3,1)    ' As Function(itinfo As Uinteger,lcid As Uinteger,pptinfo As any ptr Ptr Ptr) As any ptr

    GetIDsOfNames As tMember = (1610678274,2,5,1)    ' As Function(riid As GUID Ptr,rgszNames As Byte Ptr Ptr,cNames As Uinteger,lcid As Uinteger,rgdispid As Integer Ptr) As any ptr

    Invoke As tMember = (1610678275,2,8,1)    ' As Function(dispidMember As Integer,riid As GUID Ptr,lcid As Uinteger,wFlags As Ushort,pdispparams As DISPPARAMS Ptr,pvarResult As VARIANT Ptr,pexcepinfo As EXCEPINFO Ptr,puArgErr As Uinteger Ptr) As any ptr

    GoBack As tMember = (100,2,0,1)    ' As Function() As any ptr

    GoForward As tMember = (101,2,0,1)    ' As Function() As any ptr

    GoHome As tMember = (102,2,0,1)    ' As Function() As any ptr

    GoSearch As tMember = (103,2,0,1)    ' As Function() As any ptr

    Navigate As tMember = (104,2,5,1)    ' As Function(URL As BSTR,Flags As VARIANT Ptr=0,TargetFrameName As VARIANT Ptr=0,PostData As VARIANT Ptr=0,Headers As VARIANT Ptr=0) As any ptr

    Refresh As tMember = (-550,2,0,1)    ' As Function() As any ptr

    Refresh2 As tMember = (105,2,1,1)    ' As Function(Level As VARIANT Ptr=0) As any ptr

    Stop As tMember = (106,2,0,1)    ' As Function() As any ptr

    getApplication As tMember = (200,2,0,2)    ' As Function() As LPDISPATCH

    getParent As tMember = (201,2,0,2)    ' As Function() As LPDISPATCH

    getContainer As tMember = (202,2,0,2)    ' As Function() As LPDISPATCH

    getDocument As tMember = (203,2,0,2)    ' As Function() As LPDISPATCH

    getTopLevelContainer As tMember = (204,2,0,2)    ' As Function() As BOOL

    getType As tMember = (205,2,0,2)    ' As Function() As BSTR

    getLeft As tMember = (206,2,0,2)    ' As Function() As Integer

    putLeft As tMember = (206,2,1,4)    ' As Function( As Integer) As any ptr

    getTop As tMember = (207,2,0,2)    ' As Function() As Integer

    putTop As tMember = (207,2,1,4)    ' As Function( As Integer) As any ptr

    getWidth As tMember = (208,2,0,2)    ' As Function() As Integer

    putWidth As tMember = (208,2,1,4)    ' As Function( As Integer) As any ptr

    getHeight As tMember = (209,2,0,2)    ' As Function() As Integer

    putHeight As tMember = (209,2,1,4)    ' As Function( As Integer) As any ptr

    getLocationName As tMember = (210,2,0,2)    ' As Function() As BSTR

    getLocationURL As tMember = (211,2,0,2)    ' As Function() As BSTR

    getBusy As tMember = (212,2,0,2)    ' As Function() As BOOL

    Quit As tMember = (300,2,0,1)    ' As Function() As any ptr

    ClientToWindow As tMember = (301,2,2,1)    ' As Function(pcx As Integer Ptr,pcy As Integer Ptr) As any ptr

    PutProperty As tMember = (302,2,2,1)    ' As Function(Property As BSTR,vtValue As VARIANT) As any ptr

    GetProperty As tMember = (303,2,1,1)    ' As Function(Property As BSTR) As VARIANT

    getName As tMember = (0,2,0,2)    ' As Function() As BSTR

    getHWND As tMember = (-515,2,0,2)    ' As Function() As Integer

    getFullName As tMember = (400,2,0,2)    ' As Function() As BSTR

    getPath As tMember = (401,2,0,2)    ' As Function() As BSTR

    getVisible As tMember = (402,2,0,2)    ' As Function() As BOOL

    putVisible As tMember = (402,2,1,4)    ' As Function( As BOOL) As any ptr

    getStatusBar As tMember = (403,2,0,2)    ' As Function() As BOOL

    putStatusBar As tMember = (403,2,1,4)    ' As Function( As BOOL) As any ptr

    getStatusText As tMember = (404,2,0,2)    ' As Function() As BSTR

    putStatusText As tMember = (404,2,1,4)    ' As Function( As BSTR) As any ptr

    getToolBar As tMember = (405,2,0,2)    ' As Function() As Integer

    putToolBar As tMember = (405,2,1,4)    ' As Function( As Integer) As any ptr

    getMenuBar As tMember = (406,2,0,2)    ' As Function() As BOOL

    putMenuBar As tMember = (406,2,1,4)    ' As Function( As BOOL) As any ptr

    getFullScreen As tMember = (407,2,0,2)    ' As Function() As BOOL

    putFullScreen As tMember = (407,2,1,4)    ' As Function( As BOOL) As any ptr

    Navigate2 As tMember = (500,2,5,1)    ' As Function(URL As VARIANT Ptr,Flags As VARIANT Ptr=0,TargetFrameName As VARIANT Ptr=0,PostData As VARIANT Ptr=0,Headers As VARIANT Ptr=0) As any ptr

    QueryStatusWB As tMember = (501,2,1,1)    ' As Function(cmdID As OLECMDID) As OLECMDF

    ExecWB As tMember = (502,2,4,1)    ' As Function(cmdID As OLECMDID,cmdexecopt As OLECMDEXECOPT,pvaIn As VARIANT Ptr=0,pvaOut As VARIANT Ptr=0) As any ptr

    ShowBrowserBar As tMember = (503,2,3,1)    ' As Function(pvaClsid As VARIANT Ptr,pvarShow As VARIANT Ptr=0,pvarSize As VARIANT Ptr=0) As any ptr

    getReadyState As tMember = (-525,2,0,2)    ' As Function() As tagREADYSTATE

    getOffline As tMember = (550,2,0,2)    ' As Function() As BOOL

    putOffline As tMember = (550,2,1,4)    ' As Function( As BOOL) As any ptr

    getSilent As tMember = (551,2,0,2)    ' As Function() As BOOL

    putSilent As tMember = (551,2,1,4)    ' As Function( As BOOL) As any ptr

    getRegisterAsBrowser As tMember = (552,2,0,2)    ' As Function() As BOOL

    putRegisterAsBrowser As tMember = (552,2,1,4)    ' As Function( As BOOL) As any ptr

    getRegisterAsDropTarget As tMember = (553,2,0,2)    ' As Function() As BOOL

    putRegisterAsDropTarget As tMember = (553,2,1,4)    ' As Function( As BOOL) As any ptr

    getTheaterMode As tMember = (554,2,0,2)    ' As Function() As BOOL

    putTheaterMode As tMember = (554,2,1,4)    ' As Function( As BOOL) As any ptr

    getAddressBar As tMember = (555,2,0,2)    ' As Function() As BOOL

    putAddressBar As tMember = (555,2,1,4)    ' As Function( As BOOL) As any ptr

    getResizable As tMember = (556,2,0,2)    ' As Function() As BOOL

    putResizable As tMember = (556,2,1,4)    ' As Function( As BOOL) As any ptr

    pMark As Integer = -1

    pThis As Integer

End Type        ' IWebBrowser2



    'Use like that to use these dispach/invoke functions

    '  Dim Shared As IWebBrowser2 Obj_Disp

    '  SetObj ( @Obj_Disp , Obj_Ptr ) ' connect to object

    '  ex : AxCall Obj_Disp.putMonth,vptr(05)





'================================================================================

'Dispatch DWebBrowserEvents2     ?Web Browser Control events interface

'Const IID_DWebBrowserEvents2="{34A715A0-6587-11D0-924A-0020AFC7AC4D}"

'================================================================================

Type DWebBrowserEvents2

    StatusTextChange As tMember = (102,2,1,1)    ' As Function(Text As BSTR) As any ptr

    ProgressChange As tMember = (108,2,2,1)    ' As Function(Progress As Integer,ProgressMax As Integer) As any ptr

    CommandStateChange As tMember = (105,2,2,1)    ' As Function(Command As Integer,Enable As BOOL) As any ptr

    DownloadBegin As tMember = (106,2,0,1)    ' As Function() As any ptr

    DownloadComplete As tMember = (104,2,0,1)    ' As Function() As any ptr

    TitleChange As tMember = (113,2,1,1)    ' As Function(Text As BSTR) As any ptr

    PropertyChange As tMember = (112,2,1,1)    ' As Function(szProperty As BSTR) As any ptr

    BeforeNavigate2 As tMember = (250,2,7,1)    ' As Function(pDisp As LPDISPATCH,URL As VARIANT Ptr,Flags As VARIANT Ptr,TargetFrameName As VARIANT Ptr,PostData As VARIANT Ptr,Headers As VARIANT Ptr,Cancel As BOOL Ptr) As any ptr

    NewWindow2 As tMember = (251,2,2,1)    ' As Function(ppDisp As LPDISPATCH Ptr,Cancel As BOOL Ptr) As any ptr

    NavigateComplete2 As tMember = (252,2,2,1)    ' As Function(pDisp As LPDISPATCH,URL As VARIANT Ptr) As any ptr

    DocumentComplete As tMember = (259,2,2,1)    ' As Function(pDisp As LPDISPATCH,URL As VARIANT Ptr) As any ptr

    OnQuit As tMember = (253,2,0,1)    ' As Function() As any ptr

    OnVisible As tMember = (254,2,1,1)    ' As Function(Visible As BOOL) As any ptr

    OnToolBar As tMember = (255,2,1,1)    ' As Function(ToolBar As BOOL) As any ptr

    OnMenuBar As tMember = (256,2,1,1)    ' As Function(MenuBar As BOOL) As any ptr

    OnStatusBar As tMember = (257,2,1,1)    ' As Function(StatusBar As BOOL) As any ptr

    OnFullScreen As tMember = (258,2,1,1)    ' As Function(FullScreen As BOOL) As any ptr

    OnTheaterMode As tMember = (260,2,1,1)    ' As Function(TheaterMode As BOOL) As any ptr

    WindowSetResizable As tMember = (262,2,1,1)    ' As Function(Resizable As BOOL) As any ptr

    WindowSetLeft As tMember = (264,2,1,1)    ' As Function(Left As Integer) As any ptr

    WindowSetTop As tMember = (265,2,1,1)    ' As Function(Top As Integer) As any ptr

    WindowSetWidth As tMember = (266,2,1,1)    ' As Function(Width As Integer) As any ptr

    WindowSetHeight As tMember = (267,2,1,1)    ' As Function(Height As Integer) As any ptr

    WindowClosing As tMember = (263,2,2,1)    ' As Function(IsChildWindow As BOOL,Cancel As BOOL Ptr) As any ptr

    ClientToHostWindow As tMember = (268,2,2,1)    ' As Function(CX As Integer Ptr,CY As Integer Ptr) As any ptr

    SetSecureLockIcon As tMember = (269,2,1,1)    ' As Function(SecureLockIcon As Integer) As any ptr

    FileDownload As tMember = (270,2,2,1)    ' As Function(ActiveDocument As BOOL,Cancel As BOOL Ptr) As any ptr

    NavigateError As tMember = (271,2,5,1)    ' As Function(pDisp As LPDISPATCH,URL As VARIANT Ptr,Frame As VARIANT Ptr,StatusCode As VARIANT Ptr,Cancel As BOOL Ptr) As any ptr

    PrintTemplateInstantiation As tMember = (225,2,1,1)    ' As Function(pDisp As LPDISPATCH) As any ptr

    PrintTemplateTeardown As tMember = (226,2,1,1)    ' As Function(pDisp As LPDISPATCH) As any ptr

    UpdatePageStatus As tMember = (227,2,3,1)    ' As Function(pDisp As LPDISPATCH,nPage As VARIANT Ptr,fDone As VARIANT Ptr) As any ptr

    PrivacyImpactedStateChange As tMember = (272,2,1,1)    ' As Function(bImpacted As BOOL) As any ptr

    NewWindow3 As tMember = (273,2,5,1)    ' As Function(ppDisp As LPDISPATCH Ptr,Cancel As BOOL Ptr,dwFlags As Uinteger,bstrUrlContext As BSTR,bstrUrl As BSTR) As any ptr

    SetPhishingFilterStatus As tMember = (282,2,1,1)    ' As Function(PhishingFilterStatus As Integer) As any ptr

    WindowStateChanged As tMember = (283,2,2,1)    ' As Function(dwWindowStateFlags As Uinteger,dwValidFlagsMask As Uinteger) As any ptr

    NewProcess As tMember = (284,2,3,1)    ' As Function(lCauseFlag As Integer,pWB2 As LPDISPATCH,Cancel As BOOL Ptr) As any ptr

    ThirdPartyUrlBlocked As tMember = (285,2,2,1)    ' As Function(URL As VARIANT Ptr,dwCount As Uinteger) As any ptr

    RedirectXDomainBlocked As tMember = (286,2,5,1)    ' As Function(pDisp As LPDISPATCH,StartURL As VARIANT Ptr,RedirectURL As VARIANT Ptr,Frame As VARIANT Ptr,StatusCode As VARIANT Ptr) As any ptr

    BeforeScriptExecute As tMember = (290,2,1,1)    ' As Function(pDispWindow As LPDISPATCH) As any ptr

    WebWorkerStarted As tMember = (288,2,2,1)    ' As Function(dwUniqueID As Uinteger,bstrWorkerLabel As BSTR) As any ptr

    WebWorkerFinsihed As tMember = (289,2,1,1)    ' As Function(dwUniqueID As Uinteger) As any ptr

    pMark As Integer = -1

    pThis As Integer

End Type        ' DWebBrowserEvents2



    'Use like that to use these dispach/invoke functions

    '  Dim Shared As DWebBrowserEvents2 Obj_Disp

    '  SetObj ( @Obj_Disp , Obj_Ptr ) ' connect to object

    '  ex : AxCall Obj_Disp.putMonth,vptr(05)

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 26.02.2016 von Marcedo angelegt.
Die aktuellste Version wurde am 26.03.2016 von Marcedo gespeichert.

Bearbeiten

Versionen