XProfan

window 10,10-750,500
usermessages 16
 $H Messages.ph---Standart
 $H Windows.ph----Standart
def AtlAxWinInit(0) !atl.dll,AtlAxWinInit
def AtlAxCreateControl(4) !atl.dll,AtlAxCreateControl
def AtlAxGetControl(2) !atl.dll,AtlAxGetControl
def CLSIDFromString(2) !ole32,CLSIDFromString
def SysFreeString(1) !oleaut32,SysFreeString

proc WideToMulti--------------------------------------------------------------

    parameters Quelle&,Ziel&
    return ~WideCharToMultiByte(0,0,Quelle&,-1,Ziel&,250,0,0)
    endproc-----------------------------------------------------------------------

    proc StringToGUID-------------------------------------------------------------

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

        proc CallMethod---------------------------------------------------------------

            parameters IFace&,Method&
            declare VTable&
            VTable&=long(IFace&,0)
            Method&=long(VTable&,Method&*4)
            case %pcount=2:return call( Method&,IFace& )
            case %pcount=3:return call( Method&,IFace&,&(3) )
            case %pcount=4:return call( Method&,IFace&,&(3),&(4) )
            endproc-----------------------------------------------------------------------
            declare IID#
            dim IID#,16
            declare dll&
            dll&=usedll(atl.dll)
            AtlAxWinInit()
            declare Web&
            Web&=control(AtlAxWin,Shell.Explorer.1,$50000000,300,10,400,400,%hwnd,0,0,$200)
            declare IUnknown&
            AtlAxGetControl(Web&,addr(IUnknown&))--IUnknown-Interface ermitteln
            declare IWebBrowser&
            StringToGUID {D30C1661-CDAF-11d0-8A3E-00C04FC9E26E},IID#-IID_IWebBrowser2
            CallMethod(IUnknown&,0,IID#,addr(IWebBrowser&))--IUnknown:QueryInterface
            CallMethod(IWebbrowser&,9)---------------------------------IWebbrowser:GoHome (Startseite)
            declare a&,a#
            dim a#,256

            while 1

                waitinput
                CallMethod(IWebbrowser&,30,addr(a&))--------------------IWebbrowser:get_LocationURL
                WideToMulti(a&,a#)
                settext %hwnd,URL :+string$(a#,0)
                SysFreeString(a&)--Buffer freigeben
                case %umessage=16:break

            endwhile

            destroywindow(Web&)
            case dll&:freedll dll&