XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Internet: HTML-Seite öffnen
(C) Uwe Pascal Niemeier
windowstyle 16+8
window 0,0-400,600
appendmenubar 101,HTML-Seite öffnen
appendmenubar 102,Vorwärts
appendmenubar 103,Zurück
appendmenubar 104,Home
appendmenubar 105,Suchen
usermessages 16
declare a%,b%,c%
declare a$,b$,c$
declare a&,b&,c&
declare a!,b!,c!
declare a#,b#,c#
dim a#,512
declare CLSID#,IID#,Error&
dim CLSID#,16
dim IID#,16
clear CLSID#,IID#
-------------------------------------*********** Diese Pfade bitte anpassen!! ********
 $H X:RuntimesHeaderMessages.ph
 $H X:RuntimesHeaderWindows.ph
 $H X:ExperimenteOLE-DemosHTML-ViewOpenHTML.ph
 $H Messages.ph
 $H Windows.ph
 $H OpenHTML.ph
-------------------------------------*************************************************
def MultiByteToWideChar(6) !KERNEL32,MultiByteToWideChar
def WideCharToMultiByte(8) !kernel32,WideCharToMultiByte
def CoInitialize(1) !OLE32,CoInitialize
def CoUnInitialize(0) !OLE32,CoUninitialize
def CoCreateInstance(5) !ole32,CoCreateInstance
def CLSIDFromString(2) !OLE32,CLSIDFromString

proc MakeWideChar-------------------------------------------------------------MakeWideChar

    parameters Text$,Ziel&
    return MultiByteToWideChar(0,0,addr(Text$),-1,Ziel&,250)
    endproc-----------------------------------------------------------------------

    proc StringToGUID-------------------------------------------------------------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---------------------------------------------------------------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) )
            case %pcount=5:return call( Method&,IFace&,&(3),&(4),&(5) )
            case %pcount=6:return call( Method&,IFace&,&(3),&(4),&(5),&(6) )
            case %pcount=7:return call( Method&,IFace&,&(3),&(4),&(5),&(6),&(7) )
            case %pcount=8:return call( Method&,IFace&,&(3),&(4),&(5),&(6),&(7),&(8) )
            endproc-----------------------------------------------------------------------

            proc OpenHTML-----------------------------------------------------------------OpenHTML

                parameters File$
                b&=0
                c&=addr(b&)
                a$=file://+a$
                MakeWideChar a$,a#
                CallMethod IWebbrowser&,~Navigate,a#,c&,c&,c&,c&
                print Error IWebBrowser2::Navigate,&(0)
                endproc-----------------------------------------------------------------------
                CoInitialize(0)
                declare IWebbrowser&-----------------------IWebBrowser-Interface
                StringToGUID ~CLSID_InternetExplorer,CLSID#
                StringToGUID ~IID_IWebBrowser2,IID#
                Error&=CoCreateInstance(CLSID#,0,~CLSCTX_LOCAL_SERVER,IID#,addr(IWebbrowser&))
                print Error CoCreateInstance,Error&
                print IWebbrowser&,IWebbrowser&
                -------------------------------------------Bedienungselemente ( 0=aus 1=ein )
                CallMethod IWebbrowser&,~put_ToolBar,0
                CallMethod IWebbrowser&,~put_MenuBar,1-----nur wenn Toolbar=1
                CallMethod IWebbrowser&,~put_AddressBar,1--nur wenn Toolbar=1
                CallMethod IWebbrowser&,~put_StatusBar,0
                -------------------------------------------Fensterposition & Grösse
                CallMethod IWebbrowser&,~put_Left,400
                CallMethod IWebbrowser&,~put_Top,0
                CallMethod IWebbrowser&,~put_Width,400
                CallMethod IWebbrowser&,~put_Height,600
                -------------------------------------------Fenster sichtbar
                CallMethod IWebbrowser&,~put_Visible,1

                while 1---------------------------------------------------------------------Eingabeschleife

                    waitinput
                    case %umessage=16:break--------------------------------Ende

                    if menuitem(101)---------------------------------------Seite öffnen

                        a$=loadfile$(Webseite öffnen,HTML-Seiten|*.htm;*.html)
                        case len(a$):OpenHTML a$

                    elseif menuitem(102)-----------------------------------Vorwärts

                        CallMethod IWebBrowser&,~GoForward

                    elseif menuitem(103)-----------------------------------Zurück

                        CallMethod IWebBrowser&,~GoBack

                    elseif menuitem(104)-----------------------------------Home

                        CallMethod IWebBrowser&,~GoHome

                    elseif menuitem(105)-----------------------------------Suchen

                        CallMethod IWebBrowser&,~GoSearch

                    endif

                endwhile

                -------------------------------------------Ende
                CallMethod IWebbrowser&,~Quit
                CallMethod IWebbrowser&,~Release
                CoUninitialize()
                dispose CLSID#
                disponer IID#
                disponer a#