XProfan

 $H D:PrivatProfanXProfan9INCLUDEWindows.ph
---------------Umwandlung String > globally unique identifier

Proc StringToGUID

    Parameters GUID$,GUID&
    Declare Temp$
    Temp$ = @Space$(80)
    ~MultiByteToWideChar(1,1,@Addr(GUID$),-1,@Addr(Temp$),80)
    @External("ole32","CLSIDFromString",@Addr(Temp$),GUID&)

EndProc

-----------------------------------------------------------------------
--------------------------Methode eines COM-Interfaces aufrufen

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))
    Case %PCount = 5 : Return @Call(Method&,IFace&,@&(3),@&(4),@&(5))

EndProc

-----------------------------------------------------------------------
----------WideChar (UniCode) zu MultiByte (Ansi) [nur OLE!]

Proc OLE_WideToMulti

    Parameters Text&
    Declare Text$,Size&,Text#
    Size& = @External("oleaut32","SysStringLen",Text&)
    Dim Text#,Size&
    Clear Text#
    ~WideCharToMultiByte(0,0,Text&,-1,Text#,Size&,0,0)
    @External("oleaut32","SysFreeString",Text&)
    Text$ = @String$(Text#,0)
    Dispose Text#
    Return Text$

EndProc

-----------------------------------------------------------------------
------------------------------EnumChildProc---------------------------

Proc EnumChildProc

    Parameters wnd&
    Declare Name#
    Dim Name#,255
    ~GetClassName(wnd&,Name#,255)
    Case @String$(Name#,0)="Internet Explorer_Server" : IEServerWnd& = wnd&
    Dispose Name#
    Return 1

EndProc

---------------------------------------------------------------------------------
--------------------------RunningIE_GetText-----------------------

Proc RunningIE_GetText

    Parameters IEHwnd&
    Declare Error&,IID#,Msg&,Result&,oleacc&,IHTMLDocument2&,IHTMLElement&,Text&,Text$,Url&,Url$
    Dim IID#,16
    Declare IEServerWnd&
    ~EnumChildWindows(IEHwnd&,@ProcAddr(EnumChildProc,2),0)
    @ProcAddr(EnumChildProc,-2)--ProcAddr freigeben
    Print "IEServerwnd&",IEServerWnd&
    Print
    Msg& = ~RegisterWindowMessage("WM_HTML_GETOBJECT")
    Print "msg",Msg&
    Print
    Error& = ~SendMessageTimeout(IEServerWnd&,Msg&,0,0,~SMTO_ABORTIFHUNG,1000,@Addr(Result&))
    Print "Error SendMessageTimeout",Error&
    Print "Result SendMessageTimeout",Result&
    @External("ole32","CoInitialize",0)
    oleacc& = @UseDLL("oleacc.dll")
    Print "oleacc",oleacc&
    Print
    StringToGUID("{332c4425-26cb-11d0-b483-00c04fd90119}",IID#)--IID_IHTMLDocument2
    Error& = @External("oleacc","ObjectFromLresult",Result&,IID#,0,@Addr(IHTMLDocument2&))
    Print "Error ObjectFromLresult",Error&
    Print "IHTMLDocument2",IHTMLDocument2&
    FreeDLL oleacc&
    Error& = CallMethod(IHTMLDocument2&,9,@Addr(IHTMLElement&))--IHTMLDocument2::get_body
    Print "Error IHTMLDocument2::get_body",Error&
    Print "IHTMLElement",IHTMLElement&
    Print
    ----------------------------------------------Quelltext ermitteln
    Error& = CallMethod(IHTMLElement&,62,@Addr(Text&))--IHTMLElement::get_outerHTML
    Print "Error IHTMLElement::get_outerHTML",Error&
    Print "Result get_outerHTML",Text&
    Print
    Text$ = OLE_WideToMulti(Text&)
    -------------------------------------------------------URL ermitteln
    Error& = CallMethod(IHTMLDocument2&,40,@Addr(Url&))--IHTMLElement::get_URL
    Print "Error IHTMLElement::get_URL",Error&
    Print "Result get_URL",URL&
    Print
    Url$ = OLE_WideToMulti(Url&)
    Print "URL = ";Url$
    Dispose IID#
    @External("ole32","CoUninitialize")
    Return Text$
    EndProc---------------------------------------------------------------------------------
    Window 0,0-800,600
    Declare Fenster&
    Declare Edit&
    Declare Quell$
    Declare IEServerWnd&
    Fenster& = ~FindWindow("IEFrame",0)--Hier könnte man auch andere Möglichkeiten nehmen,

    IfNot Fenster&---------------------z.B. Suche nach Fenstertitel.

        Print "Bitte IE starten!!"------Benötigt wird das gewünschte Hauptfenster des IE!
        WaitInput
        End

    EndIf

    Quell$ = RunningIE_GetText(Fenster&)

    If @Len(Quell$)

        Edit& = @Create("multiedit",%hwnd,"",300,20,450,500)----Text anzeigen
        SetText Edit&,Quell$

    EndIf

    WaitKey
    End

SubProc Set.P2CPP

    Parameters ...
    ...

EndProc

und dann kann die neue Unterfunktion verwendet werden als:
Set("P2CPP",...)