XProfan

Var ProgName$ = "Mein Browser"
DECLARE HTMLWinHandle%[], In$, SuchAdresse$, VerlaufAuswahl$, AdressBoxHandle%, OKButtonHandle%, TCHandle%, AktTab%, TabAnz%, A%, E%
DECLARE FavoritenButtonHandle%, FavoritenListe_H%
appendmenubar 101, "<"
appendmenubar 102, ">"
appendmenubar 112, "&X"
appendmenubar 104, "&Suchen"
appendmenubar 109, "S&tartseite"
appendmenubar 105, "A&ktualisieren"
appendmenubar 108, "&Drucken"
appendmenubar 110, "&Neue Tab"
appendmenubar 111, "Tab S&chließen"
PopUp "Optionen"
AppendMenu 107, "Verlauf Löschen"
AppendMenu 113, "Favoriten Löschen"
Separator
AppendMenu 103, "Favoriten aus dem Internet Explorer importieren..."
UserMessages 16
Prozeduren von Uwe Pascal, abgewandelt von Andreas Miethe,
freundlicherweise im XProfan-Forum auf www.paules-pc-forum.de
für mich gepostet. (Danke!!!)
 $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-----------------------------------------------------------------------
            Ende der Prozeduren von Uwe Pascal

            proc Favoriten

                declare hFont&
                declare _ende%
                declare _dlg%
                declare AktURL%
                declare FavoritenListbox_H%
                declare Hinzufügen_H%
                declare Laden_H%
                declare Zurück_H%
                declare Löschen_H%
                declare Bearbeiten_H%
                declare Temp$, Temp%
                hFont& = create("Font", "ARIAL",14,0,0,0,0)
                setdialogfont hFont&
                _dlg% = create("dialog", %hWnd, "Favoriten", 180, 100, 370, 278 + %cyCaption)
                AktURL% = create("text", _dlg%, ("Aktuelle URL: " + WebInfo(HTMLWinHandle%[AktTab%], 30)), 16, 16, 320, 40)
                FavoritenListbox_H% = create("listbox", _dlg%, 0, 16, 112, 320, 112)
                Hinzufügen_H% = create("button", _dlg%, "Zu Favoriten hinzufügen", 192, 64, 144, 16)
                create("text", _dlg%, "Ihre Favoriten:", 16, 88, 320, 16)
                Laden_H% = create("button", _dlg%, "Seite laden", 176, 232, 72, 16)
                Zurück_H% = create("button", _dlg%, "Zurück", 272, 232, 64, 16)
                Löschen_H% = create("button", _dlg%, "Löschen", 16, 232, 72, 16)
                Bearbeiten_H% = create("button", _dlg%, "Bearbeiten", 96, 232, 72, 16)
                @SendMessage(FavoritenListbox_H%, $0194, 1024, 0)

                WhileLoop 0, @GetCount(FavoritenListe_H%) - 1, 1

                    @AddString(FavoritenListbox_H%, @GetString$(FavoritenListe_H%, &loop))

                EndWhile

                UserMessages -16
                _ende% = 0

                whilenot _ende%

                    waitinput

                    if (%key = 2)

                        _ende% = 1

                    elseif clicked(Hinzufügen_H%)

                        @AddString(FavoritenListe_H%, WebInfo(HTMLWinHandle%[AktTab%], 30))
                        @AddString(FavoritenListbox_H%, WebInfo(HTMLWinHandle%[AktTab%], 30))

                    elseif clicked(Laden_H%) AND (@GetCurSel(FavoritenListbox_H%) + 1)

                        @HTMLWin("Navigate", HTMLWinHandle%[AktTab%], @GetString$(FavoritenListbox_H%, @GetCurSel(FavoritenListbox_H%)))
                        A% = 1
                        _ende% = 1

                    elseif clicked(Zurück_H%)

                        _ende% = 1

                    elseif clicked(Löschen_H%) AND (@GetCurSel(FavoritenListbox_H%) + 1)

                        @DeleteString(FavoritenListe_H%, @GetCurSel(FavoritenListbox_H%))
                        @DeleteString(FavoritenListbox_H%, @GetCurSel(FavoritenListbox_H%))

                    elseif clicked(Bearbeiten_H%) AND (@GetCurSel(FavoritenListbox_H%) + 1)

                        Temp$ = @Input$("Neuer Eintrag:", "Eintrag bearbeiten", @GetString$(FavoritenListbox_H%, @GetCurSel(FavoritenListbox_H%)))

                        IF Temp$ <> ""

                            Temp% = @GetCurSel(FavoritenListbox_H%)
                            @DeleteString(FavoritenListe_H%, Temp%)
                            @DeleteString(FavoritenListbox_H%, Temp%)
                            @InsertString(FavoritenListe_H%, Temp%, Temp$)
                            @InsertString(FavoritenListbox_H%, Temp%, Temp$)
                            @HTMLWin("Refresh", HTMLWinHandle%[AktTab%])

                        ENDIF

                    endif

                endWhile

                destroywindow(_dlg%)
                setdialogfont 0
                deleteobject hfont&
                UserMessages 16

            endproc

            proc Beenden

                Declare Temp%

                IF TabAnz% >= 2

                    Temp% = NochTabsOffen()

                ELSE

                    Assign #1, $TempDir + "BrowserFavoriten.txt"
                    Rewrite #1

                    WhileLoop 0, @GetCount(FavoritenListe_H%) - 1, 1

                        PRINT #1, @GetString$(FavoritenListe_H%, &loop)

                    EndWhile

                    Close #1
                    End

                ENDIF

                IF Temp% = 2

                    SetMenuItem 111
                    Return 0

                ELSEIF Temp% = 1

                    Assign #1, $TempDir + "BrowserFavoriten.txt"
                    Rewrite #1

                    WhileLoop 0, @GetCount(FavoritenListe_H%) - 1, 1

                        PRINT #1, @GetString$(FavoritenListe_H%, &loop)

                    EndWhile

                    Close #1
                    End

                ELSEIF Temp% = 0

                    Return 0

                ENDIF

            endproc

            proc NochTabsOffen

                declare hFont&
                declare _ende%
                declare _dlg%
                declare CloseTab_H%
                declare End_H%
                declare Cancel_H%
                DECLARE temp%
                hFont& = create("Font", "ARIAL",14,0,0,0,0)
                setdialogfont hFont&
                _dlg% = create("dialog", %hWnd, "Wirklich beenden?", 180, 100, 392, 88 + %cyCaption)
                create("text", _dlg%, "Es sind noch Tabs offen.", 16, 16, 344, 16)
                CloseTab_H% = create("button", _dlg%, "Nur die aktuelle Tab schließen", 16, 40, 160, 16)
                End_H% = create("button", _dlg%, "Browser beenden", 184, 40, 104, 16)
                Cancel_H% = create("button", _dlg%, "Abbrechen", 296, 40, 64, 16)
                UserMessages -16
                _ende% = 0

                whilenot _ende%

                    waitinput

                    if (%key = 2)

                        _ende% = 1

                    elseif clicked(CloseTab_H%)

                        temp% = 2
                        _ende% = 1

                    elseif clicked(End_H%)

                        temp% = 1
                        _ende% = 1

                    elseif clicked(Cancel_H%)

                        temp% = 0
                        _ende% = 1

                    endif

                endWhile

                UserMessages 16
                destroywindow(_dlg%)
                setdialogfont 0
                deleteobject hfont&
                Return temp%

            endproc

            proc FavoritesFolder Prozedur von Andreas Miethe (Danke!!!)

                Var Buffer$ = Space$(1024)
                External("Shell32.dll","SHGetSpecialFolderPathA",0,Addr(Buffer$),$001F,0)
                Return Trim$(Buffer$)

            endproc

            proc ImportFavoritesIE

                Declare ListHandle1%, Files%
                ChDir FavoritesFolder()
                ListHandle1% = @Create("List", 0)
                @MoveListToHandle(ListHandle1%)
                ClearList
                AddFiles *"*.url"
                Files% = %GetCount

                WhileLoop Files%

                    @AddString(FavoritenListe_H%, ReadIni$(@ListBoxItem$(&loop - 1), "InternetShortcut", "URL"))

                EndWhile

                ClearList
                @MoveHandleToList(ListHandle1%)
                DeleteObject ListHandle1%

            endproc

            TabAnz% = 1
            AktTab% = 1
            @Create("Text", %hWnd, "Seite wird geladen...", 0, 44, 10000, 10000)
            AdressBoxHandle% = @Create("ChoiceBox", %hWnd, 2, 0, 0, width(%hWnd) - 40, 200)
            OKButtonHandle% = @Create("Button", %hWnd, "OK", (width(%hWnd) - 40), 0, 40, 24)
            SetText %hWnd, ProgName$
            HTMLWinHandle%[1] = @Create("HTMLWin", %hWnd, "about:blank", 1, 0, 44, width(%hWnd), height(%hWnd) - 40)
            @HTMLWin("GoHome", HTMLWinHandle%[AktTab%])
            ClearList
            TCHandle% = @Create("TabCtrl", %hWnd, "", 0, 24, width(%hWnd) - 96, 20)
            FavoritenButtonHandle% = @Create("Button", %hWnd, "Favoriten", (width(%hWnd) - 96), 24, 96, 20)
            FavoritenListe_H% = @Create("List", 0)
            In$ = ""
            Assign #1, $TempDir + "BrowserFavoriten.txt"
            Append #1
            Close #1
            Reset #1

            WhileNot @Eof(1)

                Input #1, In$
                @AddString(FavoritenListe_H%, In$)
                In$ = ""

            EndWhile

            Close #1

            While 0 = 0

                setwindowpos HTMLWinHandle%[AktTab%] = 0, 44 - width(%hWnd), ((height(%hWnd) - 44))
                setwindowpos AdressBoxHandle% = 0, 0 - (width(%hWnd) - 40), 24
                setwindowpos OKButtonHandle% = (width(%hWnd) - 40), 0 - 40, 24
                setwindowpos TCHandle% = 0, 24 - (width(%hWnd) - 96), 20
                setwindowpos FavoritenButtonHandle% = (width(%hWnd) - 96), 24 - 96, 20

                IF MenuItem(101)

                    @HTMLWin("GoBack", HTMLWinHandle%[AktTab%])

                ELSEIF MenuItem(102)

                    @HTMLWin("GoForward", HTMLWinHandle%[AktTab%])

                ELSEIF MenuItem(104)

                    SuchAdresse$ = @Input$("Suchbegriff:", "Suchbegriff eingeben", "")
                    Case SuchAdresse$ <> "": SuchAdresse$ = "https://www.google.de/#hl=de&source=hp&q=" + SuchAdresse$ + "&btnG=Google-Suche&meta=&aq=f&oq=G&fp=62877c11c6a08939"
                    Case SuchAdresse$ <> "": @HTMLWin("Navigate", HTMLWinHandle%[AktTab%], SuchAdresse$)
                    Case SuchAdresse$ <> "": AddString SuchAdresse$
                    Case SuchAdresse$ = "": @HTMLWin("Refresh", HTMLWinHandle%[AktTab%])

                ELSEIF MenuItem(105)

                    @HTMLWin("Refresh", HTMLWinHandle%[AktTab%])

                ELSEIF MenuItem(107)

                    ClearList
                    ClearList AdressBoxHandle%

                ELSEIF MenuItem(108)

                    WinCopy %hWnd

                ELSEIF MenuItem(109)

                    @HTMLWin("GoHome", HTMLWinHandle%[AktTab%])

                ELSEIF (@GetText$(AdressBoxHandle%) <> "") AND @Clicked(OKButtonHandle%)

                    @HTMLWin("Navigate", HTMLWinHandle%[AktTab%], @GetText$(AdressBoxHandle%))
                    SetText AdressBoxHandle%, ""

                ELSEIF @TabChanged(TCHandle%)

                    setwindowpos HTMLWinHandle%[AktTab%] = 0, 44 - 0, 0
                    AktTab% = @GetActiveTab(TCHandle%) + 1
                    setwindowpos HTMLWinHandle%[AktTab%] = 0, 44 - width(%hWnd), ((height(%hWnd) - 44))
                    SetText %hWnd, ProgName$ + " - " + WebInfo(HTMLWinHandle%[AktTab%], 30)

                    IF Len(WebInfo(HTMLWinHandle%[AktTab%], 30)) <= 20

                        SetText TCHandle%, AktTab% - 1, WebInfo(HTMLWinHandle%[AktTab%], 30)

                    ELSE

                        SetText TCHandle%, AktTab% - 1, Mid$(WebInfo(HTMLWinHandle%[AktTab%], 30), 1, 17) + "..."

                    ENDIF

                ELSEIF MenuItem(110)

                    TabAnz% = TabAnz% + 1
                    @InsertTab(TCHandle%, TabAnz%, "")
                    HTMLWinHandle%[TabAnz%] = @Create("HTMLWin", %hWnd, "about:blank", 1, 0, 40, 0, 0)
                    SetText TCHandle%, TabAnz% - 1, WebInfo(HTMLWinHandle%[TabAnz%], 30)
                    setwindowpos HTMLWinHandle%[AktTab%] = 0, 44 - width(%hWnd), ((height(%hWnd) - 44))

                ELSEIF MenuItem(111) AND (TabAnz% > 1)

                    @DestroyWindow(TCHandle%)
                    @DestroyWindow(HTMLWinHandle%[AktTab%])
                    TCHandle% = @Create("TabCtrl", %hWnd, "", 0, 20, %WinRight, %WinBottom - 20)

                    WhileLoop 2, TabAnz% - 1

                        @InsertTab(TCHandle%, 2, "")

                    EndWhile

                    WhileLoop AktTab%, TabAnz% - 1

                        HTMLWinHandle%[&loop] = HTMLWinHandle%[&loop + 1]

                    EndWhile

                    TabAnz% = TabAnz% - 1
                    AktTab% =  @GetActiveTab(TCHandle%) + 1

                    WhileLoop 1, TabAnz%

                        Case &loop = AktTab%: SetText %hWnd, ProgName$ + " - " + WebInfo(HTMLWinHandle%[&loop], 30)

                        IF Len(WebInfo(HTMLWinHandle%[AktTab%], 30)) <= 20

                            SetText TCHandle%, &loop - 1, WebInfo(HTMLWinHandle%[&loop], 30)

                        ELSE

                            SetText TCHandle%, &loop - 1, Mid$(WebInfo(HTMLWinHandle%[&loop], 30), 1, 17) + "..."

                        ENDIF

                    EndWhile

                ELSEIF @Clicked(FavoritenButtonHandle%)

                    Favoriten

                ELSEIF @MenuItem(103)

                    IF @MessageBox("Favoriten aus dem Internet Explorer importieren?", "Favoriten importieren", 36) = 6

                        @HTMLWin("Refresh", HTMLWinHandle%[AktTab%])
                        ImportFavoritesIE
                        @MessageBox("Favoriten erfolgreich importiert!", "Favoriten importieren", 64)

                    ENDIF

                    @HTMLWin("Refresh", HTMLWinHandle%[AktTab%])

                ELSEIF @MenuItem(113)

                    IF @MessageBox("Möchten sie die Favoriten wirklich löschen?", "Favoriten löschen", 36) = 6

                        @HTMLWin("Refresh", HTMLWinHandle%[AktTab%])
                        ClearList FavoritenListe_H%
                        @MessageBox("Favoriten erfolgreich gelöscht!", "Favoriten löschen", 64)

                    ENDIF

                    @HTMLWin("Refresh", HTMLWinHandle%[AktTab%])

                ENDIF

                IF %MenuItem

                    setmenuitem 0

                ENDIF

                IF %uMessage = 16

                    Beenden

                ENDIF

                E% = 0

                While @HTMLWin("GetBusy", HTMLWinHandle%[AktTab%])

                    Case E% = 0: EnableMenu 112, 0
                    E% = 1
                    SetText %hWnd, ProgName$ + " - Seite wird geladen..."
                    Sleep 20
                    setwindowpos HTMLWinHandle%[AktTab%] = 0, 44 - width(%hWnd), ((height(%hWnd) - 44))
                    setwindowpos AdressBoxHandle% = 0, 0 - (width(%hWnd) - 40), 24
                    setwindowpos OKButtonHandle% = (width(%hWnd) - 40), 0 - 40, 24
                    setwindowpos TCHandle% = 0, 24 - (width(%hWnd) - 96), 20
                    setwindowpos FavoritenButtonHandle% = (width(%hWnd) - 96), 24 - 96, 20
                    A% = 1

                    IF @MenuItem(112)

                        @HTMLWin("Stop", HTMLWinHandle%[AktTab%])
                        SetMenuItem 0

                    ENDIF

                EndWhile

                Case A%: EnableMenu 112, 1

                IF @TabChanged(TCHandle%) OR A%

                    Case @ListBoxItem$(%GetCount) <> WebInfo(HTMLWinHandle%[AktTab%], 30): AddString WebInfo(HTMLWinHandle%[AktTab%], 30)
                    ClearList AdressBoxHandle%
                    @MoveListToHandle(AdressBoxHandle%)
                    SetText %hWnd, ProgName$ + " - " + WebInfo(HTMLWinHandle%[AktTab%], 30)

                    IF Len(WebInfo(HTMLWinHandle%[AktTab%], 30)) <= 20

                        SetText TCHandle%, AktTab% - 1, WebInfo(HTMLWinHandle%[AktTab%], 30)

                    ELSE

                        SetText TCHandle%, AktTab% - 1, Mid$(WebInfo(HTMLWinHandle%[AktTab%], 30), 1, 17) + "..."

                    ENDIF

                    A% = 0

                ENDIF

                AktTab% = @GetActiveTab(TCHandle%) + 1
                Sleep 10

            EndWhile