Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Internet und Netzwerke

InternetExplorer Steuerelement ActiveX

Lizenz:Erster Autor:Letzte Bearbeitung:
FBPSLMitgliedMarcedo 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 Externer Link!hier

Beispiel Download link:Externer 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 Externer Link!QueryInterface

Another Idea may be to use the event documentComplet In Freebasic,
it could be implemented like Externer Link!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 MitgliedMarcedo angelegt.
  • Die aktuellste Version wurde am 26.03.2016 von MitgliedMarcedo gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen