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
lass=s4 href='./../../function-references/XProfan/endif/'>ENDIF
AktTab%
= @
GetActiveTab(TCHandle%
) + 1
Sleep 10
Endwhile
(1.064)
Deutsch
English
Français
Español
Italia