XProfan

 $H Windows.ph

proc StringToGUID---------------Umwandlung String > globally unique identifier

    parameters GUID$,GUID&
    declare Temp$
    Temp$=space$(80)
    ~MultiByteToWideChar(1,1,addr(GUID$),-1,addr(Temp$),80)
    external(ole32,CLSIDFromString,addr(Temp$),GUID&)
    endproc-----------------------------------------------------------------------

    proc WideToMultiOLE------------------------------WideChar to MultiByte für OLE

        parameters Text&
        declare Size&,Text$
        Size&=external(oleaut32,SysStringLen,Text&)
        Text$=char$(Text&,0,Size&*2)
        Text$=substr$(Text$,1,zz)
        Text$=translate$(Text$,z,)
        external(oleaut32,SysFreeString,Text&)
        return Text$
        endproc-----------------------------------------------------------------------

        proc WebInfo------------------------------------------------------------------

            parameters WebCtrl&,Method%
            declare IID#,IUnknown&,IWebBrowser&,VTable&
            declare Text$,Text&
            dim IID#,16
            external(atl,AtlAxGetControl,WebCtrl&,addr(IUnknown&))
            StringToGUID({D30C1661-CDAF-11d0-8A3E-00C04FC9E26E},IID#)--IID von IWebBrowser2
            VTable&=long(IUnknown&,0)------------------------------------IVTable von IUnknown
            Call(long(VTable&,0),IUnknown&,IID#,addr(IWebBrowser&))------IUnknown::QueryInterface
            Call(long(VTable&,8),IUnknown&)------------------------------IUnknown::Release
            VTable&=long(IWebBrowser&,0)---------------------------------IVTable von IWebBrowser2
            call(long(VTable&,Method%*4),IWebBrowser&,addr(Text&))
            Text$=WideToMultiOLE(Text&)
            Call(long(VTable&,8),IWebBrowser&)---------------------------IWebBrowser2::Release
            dispose IID#
            return Text$
            endproc-----------------------------------------------------------------------
            window 0,0-800,600
            --Bitte probieren, ob bei XProfan 11 und/oder XPSE das Laden der ATL.dll
            --und Initialisieren der OLE32 und Freigabe am Ende überhaupt nötig sind!
            var Atl&=usedll(atl.dll)
            external(ole32,CoInitialize,0)
            external(atl.dll,AtlAxWinInit)
            var URL$=C:Test.html-----------Pfad oder URL
            var Web&=control(AtlAxWin,URL$,$50300000,10,200,500,200,%hwnd,0,0,$200)
            print Taste drücken
            waitinput
            print LocationName:,WebInfo(Web&,29)---IWebBrowser2::get_LocationName
            print LocationURL :,WebInfo(Web&,30)----IWebBrowser2::get_LocationURL
            waitinput--------------------------------Ende
            external(ole32,CoUninitialize)
            destroywindow(Web&)
            freedll Atl&

proc WideToMultiOLE------------------------------WideChar to MultiByte for OLE

    parameters Text&
    declare Size&,Text$
    Size&=external(oleaut32,SysStringLen,Text&)
    Text$=char$(Text&,0,Size&*2)
    Text$=substr$(Text$,1,zz)
    Text$=translate $(Text$,z,)
    external(oleaut32,SysFreeString,Text&)
    return Text$
    endproc-----------------------------------------------------------------------
    struct IWebBrowser=
    QueryInterface&,
    AddRef&,
    Release&,
    GetTypeInfoCount&,
    GetTypeInfo&,
    GetIDsOfNames&,
    Invoke&,
    GoBack&,
    GoForward&,
    GoHome&,
    GoSearch&,
    Navigate&,
    Refresh&,
    Refresh2&,
    Stop&,
    get_Application&,
    get_Parent&,
    get_Container&,
    get_Document&,
    get_TopLevelContainer&,
    get_Type&,
    get_Left&,
    put_Left&,
    get_Top&,
    put_Top&,
    get_Width&,
    put_Width&,
    get_Height&,
    put_Height&,
    get_LocationName&,
    get_LocationURL&,
    get_Busy&,
    Quit&,
    ClientToWindow&,
    PutProperty&,
    GetProperty&,
    get_Name&,
    get_HWND&,
    get_FullName&,
    get_Path&,
    get_Visible&,
    put_Visible&,
    get_StatusBar&,
    put_StatusBar&,
    get_StatusText&,
    put_StatusText&,
    get_ToolBar&,
    put_ToolBar&,
    get_MenuBar&,
    put_MenuBar&,
    get_FullScreen&,
    put_FullScreen&,
    Navigate2&,
    QueryStatusWB&,
    ExecWB&,
    ShowBrowserBar&,
    get_ReadyState&,
    get_Offline&,
    put_Offline&,
    get_Silent&,
    put_Silent&,
    get_RegisterAsBrowser&,
    put_RegisterAsBrowser&,
    get_RegisterAsDropTarget&,
    put_RegisterAsDropTarget&,
    get_TheaterMode&,
    put_TheaterMode&,
    get_AddressBar&,
    put_AddressBar&,
    get_Resizable&,
    put_Resizable&
    declare IFace#,IWebbrowser#
    dim IFace#,4
    dim IWebbrowser#,IWebbrowser
    window 0,0-800,600
    var WebControl&=create(HTMLWin,%hwnd,www.XProfan.de,10,100,0,200,200)
    IFace#=HTMLWin(QueryInterface,WebControl&)
    IWebBrowser#=long(IFace#,0)
    call(IWebbrowser#.get_LocationName&,IFace#,Text&)
    print LocationName:,WideToMultiOLE(Text&)
    call(IWebbrowser#.get_LocationURL&,IFace#,Text&)
    print LocationURL :,WideToMultiOLE(Text&)
    waitkey
    end