Das war eher ein Verständnisproblem meinerseits
MfG,
Falko
FritzBox DECT-Monitor in Webgadget
-
Falko
- Admin
- Beiträge: 3535
- Registriert: 29.08.2004 11:27
- Computerausstattung: PC: MSI-Z590-GC; 32GB-DDR4, ICore9; 2TB M2 + 2x3TB-SATA2 HDD; Intel ICore9 @ 3600MHZ (Win11 Pro. 64-Bit),
Acer Aspire E15 (Win11 Home X64). Purebasic LTS 6.11b1
HP255G8 Notebook @AMD Ryzen 5 5500U with Radeon Graphics 2.10 GHz 3.4GHz, 32GB_RAM, 3TB_SSD (Win11 Pro 64-Bit) - Kontaktdaten:
Re: FritzBox DECT-Monitor in Webgadget
Ich Danke Dir. Nun kann ich damit was anfangen.
Das war eher ein Verständnisproblem meinerseits
MfG,
Falko
Das war eher ein Verständnisproblem meinerseits
MfG,
Falko
Win11 Pro 64-Bit, PB_6.11b1
Re: FritzBox DECT-Monitor in Webgadget
Hier mal ´n Source, mit dem ich die Liste der ein- und ausgehenden Telefonverbindungen aus meiner Easybox auslese.
Darin steckt auch das Username- und Passwort-Handling incl. Eingabe und Registy-Speicherung derselben....
Darin steckt auch das Username- und Passwort-Handling incl. Eingabe und Registy-Speicherung derselben....
Code: Alles auswählen
;+----------------------------------------------------------------------+
;| PureBasic-QuellCode "EB_Anmelde" mit allen ModulBody´s |
;|erstellt durch Programm "PB_Mod2Body", Vers. 11225a am 06.06.14, 21:24|
;+----------------------------------------------------------------------+
#Prg_Name = "EB_ConnectRead"
;dieses Prg ließt die Liste der ein- und ausgehenden Telefon-Verbindungen aus einer
;EasyBox ein
#UserKey = "user" ;HTML-Feldname "Benutzername" auf URL_Logon
#PassKey = "pws" ;HTML-Feldname "Passwort" auf URL_Logon
#ExitCmd = "http://192.168.2.1/cgi-bin/logout.exe"
Global Dim VarName$(8) ;1..4=eingehend: 1=RN 2=Dat/Zeit 3=Dauer 4=ownRN 5..8=ausgehend, gleihe Reihenfolge
Global Page$ ;die gesammte EB-Seite mit den ein- und ausgehenden VerbindungsListen
Global EB_DateMask$="%DD.%MM.%YYYY/%HH:%II:%SS"
Global NewList Connect$() ;je ein-/ausgehende Verbindung eine Zeile
;========== Begin Modul "WebGad_Logon.PBI" ==========
;Modul WebGad_Logon Version 1.03 vom 13.04.2013
#PB_Vers = "4.20"
;
;Funktion: Anmeldung auf einer URL (UserName und Passwort autom. eintragen)
;
;Aufruf: WebGad_Logon(Titel$, URL_Logon$, NameFld$,PassFld$, URL_ok$ {,Name$ {,Passwort$}})
; Titel$: Titel des Anmelde-Fensters sowie bei Name- & Passwort-Eingabe
; URL_Logon$: URL der Anmelde-Seite
; NameFld$: Name des Feldes "Benutzername" (siehe unten)
; PassFld$: Name des Feldes "Passwort" (siehe unten)
; URL_OK$: URL der Seite, die nach erfolgreicher Anmeldung aufgerufen wird
; Name$: Vorgabe Benutzer-Name (wird ggf. durch idividuelle Eingabe ersetzt)
; Passwort$: Vorgabe Passwort (wird ggf. durch idividuelle Eingabe ersetzt)
;
;-----> HTML-FeldName <-----
;Der erforderliche HTML-Feldname ergibt sich aus dem Quelltext der URL_Logon$:
;"<td class=tdText_100><input type="text" class="textbox_nb" maxLength=12 Size=37 name=user></td>"
; | |
; FeldName -+--+
;
;#jaPBeExt exit
CompilerIf Defined(Debug_WebGad, #PB_Constant) = 0
#Debug_WebGad = 0
CompilerEndIf
Global WebGad_Logon_okButtName$ ;Kennung des HTML-Button´s zur Passwort-Bestätigung
;wenn nicht angegeben, so wird "javascript:evaltF()" benutzt
;========== Begin Modul "HTML_FldData.PBI" ==========
;Modul HTML_FldData Version 1.00 vom 20.10.2011
#PB_Vers = "4.20"
;
;Funktion: HTML-Textfeld-Wert auslesen / setzen in geöffnetem Webgadget
;
;
;Aufruf: {Text$=} HTML_FldData(GadNr, FldName$ {, Text$)
; GadNr: PB-#GadgetNr eines geöffneten und geladenen Webgadget´s
; FldName$: Name des HTML-Feldes (siehe
; Text$: einzusetzender Feldwert, wenn nicht angegeben, so liefert
; diese Funktion den aktuellen Feldinhalt
;Aufruf: HTML_FldData(GadNr, FldName$, Text$ = Chr(255))
; GadNr: PB-#GadgetNr eines geöffneten und geladenen Webgadget´s
; FldName$: Name des HTML-Feldes (siehe unten)
; Text$: einzusetzender Feldwert
;
;
;-----> HTML-FeldName <-----
;Der erforderliche HTML-Feldname ergibt sich aus dem Quelltext der entsprechenend URL:
;"<td class=tdText_100><input type="text" class="textbox_nb" maxLength=12 Size=37 name=user></td>"
; | |
; FeldName -+--+
;
;
;#jaPBeExt exit
CompilerIf Defined(Debug_WebGad, #PB_Constant) = 0
#Debug_WebGad = 0
CompilerEndIf
;========== Begin Modul "GetWindowLongptr.PBI" ==========
;Modul GetWindowLongptr Version 0.99 vom 01.06.2009
#PB_Vers = "4.20"
;
;Funktion: Definition zur API-Funktion "GetWindowLongptr_()" (="GetWindowLong_()" mit autom. 32/64Bit-Erkennung)
;
;Aufruf: GetWindowLongptr_(GadID.i, index.i)
;
;#jaPBeExt exit
Import "user32.lib"
GetWindowLongptr_(GadID.i, Index.i) As "_GetWindowLongA"
EndImport
;========== Ende Modul "GetWindowLongptr.PBI" ==========
;basierend auf http://purebasic-lounge.com/viewtopic.php?t=5986 von Hroudtwolf
Procedure.s HTML_FldData(GadNr, FldName$, Text$ = Chr(255))
Protected aEC.IHTMLElementCollection, bstrValue.i, Dispatch.iDispatch
Protected Document.IHTMLDocument3, Element.IHTMLElement, InputElement.IHTMLInputElement
Protected WebBrowser.IWebBrowser2
WebBrowser = GetWindowLongptr_(GadgetID(GadNr), #GWL_USERDATA)
Debug "HTML_FldData(" + #DQUOTE$ + FldName$ + #DQUOTE$ + "):"
If Not(WebBrowser\get_Document(@Dispatch) = #S_OK)
Dispatch\Release()
ProcedureReturn "!!! no dispatch"
EndIf
If Not(Dispatch\QueryInterface(? IID_IHTMLDocument3 , @Document) = #S_OK)
Document\Release()
Dispatch\Release()
ProcedureReturn "!!! no Document/QueryInterface"
EndIf
If Not(Document\getElementById(FldName$ , @Element) = #S_OK And Element)
Document\Release()
Dispatch\Release()
ProcedureReturn "!!! no document/getElementByID"
EndIf
;--- Baustelle --- Feld-Daten ermitteln
Element\get_tagname(@bstrValue) ;TypeName, z.Bsp. "INPUT"
If bstrValue
Protected HTML_FeldName$ = PeekS(bstrValue, #PB_Any, #PB_Unicode)
Debug "Typ="+Chr(34)+HTML_FeldName$ +Chr(34)
EndIf
Element\get_title(@bstrValue) ;FeldPrompt, maybe nicht definiert !!!
If bstrValue
HTML_FeldName$ = PeekS(bstrValue, #PB_Any, #PB_Unicode)
Debug "Feld="+Chr(34)+HTML_FeldName$ +Chr(34)
EndIf
If Not(Element\QueryInterface(? IID_IHTMLInputElement , @InputElement) = #S_OK)
Element\Release()
Document\Release()
Dispatch\Release()
ProcedureReturn "!!! no element/QueryInterface"
EndIf
If Text$ = Chr(255);{ kein Text übergeben: FeldInhalt als ProcResult
If Not(InputElement\get_value(@bstrValue) = #S_OK)
Element\Release()
Document\Release()
Dispatch\Release()
ProcedureReturn "!!! no element/get_value"
EndIf
InputElement\Release()
Element\Release()
Document\Release()
Dispatch\Release()
If Not bstrValue
ProcedureReturn "!!! no bStrValue"
EndIf
Text$ = PeekS(bstrValue, #PB_Any, #PB_Unicode)
SysFreeString_(bstrValue)
;}
ProcedureReturn Text$
Else ;{ Text angegeben: wird als FeldInhalt eingesetzt
If InputElement\put_Value(Text$) = #S_OK
If #Debug_WebGad : Debug "set " + #DQUOTE$ + Text$ + #DQUOTE$ : EndIf
Else
If #Debug_WebGad : Debug "kein Eingabe-Feld" : EndIf
EndIf
InputElement\Release()
Element\Release()
Document\Release()
Dispatch\Release()
; ElseIf flag = 1
; ;Checkbox/Radiobutton, wenn Radiobuttons alle die gleiche ID, nur den 1.
; If Not(InputElement\put_checked(checked) = #S_OK)
; Element\Release()
; Document\Release()
; Dispatch\Release()
; ProcedureReturn
; EndIf
;}
EndIf
;ProcedureReturn ""
DataSection
IID_IHTMLDocument3: ; { 3050F485-98B5-11CF-BB82-00AA00BDCE0B }
Data.l $3050F485
Data.W $98B5 , $11CF
Data.b $BB , $82 , $00 , $AA , $00 , $BD , $CE , $0B
IID_IHTMLInputElement: ; { 3050f5d2-98b5-11cf-bb82-00aa00bdce0b }
Data.l $3050F5D2
Data.W $98B5 , $11CF
Data.b $BB , $82 , $00 , $AA , $00 , $BD , $CE , $0B
IID_IHTMLSelectElement:
Data.l $3050F244
Data.W $98B5,$11CF
Data.b $BB , $82 , $00 , $AA , $00 , $BD , $CE , $0B
EndDataSection
EndProcedure
;========== Ende Modul "HTML_FldData.PBI" ==========
;========== Begin Modul "WebgadgetBusy.PBI" ==========
;Modul WebgadgetBusy Version 1.00 vom 21.10.2011
#PB_Vers = "4.20"
;
;Funktion: wartet, bis Webgadget Seite fertig geladen hat
;
;Aufruf: WebgadgetBusy(GadNr)
; GadNr: #Gadget-Nr des zu prüfenden Webgadget´s
;
;#jaPBeExt exit
Procedure WebgadgetBusy(GadNr) ;- warten bis Webgadget-Seite fertig geladen
SetActiveWindow_(GetParent_(GadgetID(GadNr)));WebGadget-Fenster aktivieren
While GetGadgetAttribute(GadNr, #PB_Web_Busy)
While WindowEvent(): Delay(20): Wend
Wend
EndProcedure
;========== Ende Modul "WebgadgetBusy.PBI" ==========
;========== Begin Modul "Klammer.PBI" ==========
;Modul Klammer Version 1.21 vom 31.01.2008
#PB_Vers = "4.20"
;
;Funktion: klammert einen Text, sofern dieser LeerZeichen, ", ' oder ´ enthält
; (für spätere Verwendung des Textes via Modul WORT)
;Aufruf: Wort$ = Klammer(Text$)
; wobei: Text$ = Text, der später via Modul Wort eingelesen werden soll,
; kann ggf. Leerzeichen (^32 oder ^160) und/oder Wort-Klammer-
; zeichen (", ' , ´ und/oder ^255) enthalten
Global Klammer_noUse ;ASCII-Code des Zeichens, dass _nicht_ zur Klammerung benutzt
;werden soll (nach FunktionsEnde immer resetet (=0) !!!)
Global Klammer_EXEL ;Flag: wenn ungleich 0, so wird entsprechend EXEL-CSV-Format ge=
;klammert (immer mit "", " (ASCII 34) im Text wird zu ” (ASCII 146) umgesetzt)
;Diese Variable wird _nicht_ resetet !!! (bleibt erhalten
Procedure.s Klammer(Text$)
Protected p34, p39, p180, such$, px
If Klammer_EXEL : Text$ = ReplaceString(Text$, Chr(34), "”") : EndIf
If Text$>"" ; space ´
such$ = " " + Chr(160) + Chr(180) + Chr(255)
While such$>"" And px = 0
px = FindString(Text$, Left(such$, 1), 1)
such$ = Mid(such$, 2, 9999)
Wend
p34 = FindString(Text$, Chr(34), 1) ;"
p39 = FindString(Text$, "'", 1)
p180 = FindString(Text$, "´", 1)
EndIf
If p34 Or p39 Or px Or Text$ = ""
If p34 = 0 And Klammer_noUse<>34
Text$ = Chr(34) + Text$ + Chr(34) ;"
ElseIf p39 = 0 And Klammer_noUse<>39
Text$ = "'" + Text$ + "'" ;^39
ElseIf p180 = 0 And Klammer_noUse<>180
Text$ = "´" + Text$ + "´" ;^180
Else
Text$ = Chr(255) + Text$ + Chr(255)
EndIf
EndIf : Klammer_noUse = 0
ProcedureReturn Text$
EndProcedure
; jaPBe Version=2.5.4.22
; Build=0
; FirstLine=0
; CursorPosition=0
; ExecutableFormat=Windows
; DontSaveDeclare
; EOF
; updated durch Prg. PB_SrcChg Vers. 8A21a am 22.10.2008, 21:16h
;========== Ende Modul "Klammer.PBI" ==========
;========== Begin Modul "registry.PBI" ==========
;Modul Registry Version 3.03 vom 08.09.2011
#PB_Vers = "4.20"
;
;Funktion: schreiben und lesen eines Registry-Eintrag´s (=dauerhafte Speicherung
; kleinerer Datenmengen in der Registry)
;
;Aufruf: RegistryWrite(Pfad$, Schlüßel$, Wert$) - schreibt Datenwert in Registry
; wobei: Pfad$ = DatenKennungs-Weg, Trennzeichen ist \ (ASCII 92), es wird
; generell "#hkey_local_machine\Software\Alstersoft\" vorge=
; fügt
; Schlüßel$= DatenKennung (beleibig, darf jedoch kein \ enthalten)
; Wert$ = der zu speichernde Datenwert
;
;Aufruf: Wert$ = RegistryRead(Pfad$, Schlüßel$) - ließt Datenwert aus Regsitry
; wobei: Pfad$ = DatenKennungs-Weg, Trennzeichen ist \ (ASCII 92), es wird
; generell "#hkey_local_machine\Software\Alstersoft\" vorge=
; fügt
; Schlüßel$= DatenKennung (beleibig, darf jedoch kein \ enthalten)
Global RegEntry_Typ ;enthält nach RegistryRead() den DatenTyp (1=String, 4=dWord)
;
;
;Aufruf: RegistryDelete(Pfad$, Schlüßel$) - löscht Datenwert aus Regsitry
; wobei: Pfad$ = DatenKennungs-Weg, Trennzeichen ist \ (ASCII 92), es wird
; generell "#hkey_local_machine\Software\Alstersoft\" vorge=
; fügt
; Schlüßel$= DatenKennung (beleibig, darf jedoch kein \ enthalten)
Global Registry_TopKey ;Eingangs-Variable, kann ggf. einen von #HKEY_LOCAL_MACHINE
;abweichenden Registry-BasisSchlüßel enthalten
;!!! ist nach FunktionsEnde resetet (leer) !!!
Global Registry_BaseKey$ ;Eingangs-Variable, kann ggf. einen von #Registry_BaseKey
;abweichenden Registry-BasisZweig enthalten
;!!! ist nach FunktionsEnde resetet (leer) !!!
Global Registry_Error ;FehlerNr (0=alles ok)
Global Registry_Error$ ;Fehlertext (nur, wenn Registry_Error<>0!!!)
;----- Native Funktionen -----
;Aufruf: Reg_SetValue(topKey, Pfad$, Schlüßel, Wert$ {, Typ {, Computer$}}) ;"freien" Registry-Eintrag schreiben
; topKey: #HKEY_CLASSES_ROOT, #HKEY_CURRENT_USER, #HKEY_LOCAL_MACHINE
; oder #HKEY_USERS
; Pfad$: Regsitry-Pfad
; Schlüßel: Registry-SchlüßelName
; Wert$: der zu speichernde Wert
; Typ: #REG_BINARY =Binary data in any form
; #REG_DWORD =a 32-bit number
; #REG_DWORD_LITTLE_ENDIAN=a 32-bit number in little-endian Format
; (same As REG_DWORD). in little-endian format, the most significant byte
; of A word is the high-order byte. This is the most common format For
; computers running Windows NT And Windows 95
; #REG_DWORD_BIG_ENDIAN= a 32-bit number in big-endian format. in big-endian
; format, the most significant byte of A word is the low-order byte.
; #REG_EXPAND_SZ = a null-terminated string that contains unexpanded references
; To environment variables (For example, “%PATH%”). It will be A Unicode
; Or ANSI string depending on whether you use the Unicode Or ANSI functions.
; #REG_LINK = a Unicode symbolic link.
; #REG_MULTI_SZ = an array of null-terminated strings, terminated by two null
; characters.
; #REG_NONE = No defined Value type.
; #REG_RESOURCE_LIST = device-driver resource list.
; default = #REG_SZ = a null-terminated string. It will be A Unicode Or ANSI string
; depending on whether you use the Unicode Or
; Computer$: ???
;Aufruf: Wert$ = Reg_getValue(topKey, Pfad$, Schlüßel {, Computer$}}) ;"freien" Registry-Eintrag einlesen
; topKey: #HKEY_CLASSES_ROOT, #HKEY_CURRENT_USER, #HKEY_LOCAL_MACHINE
; oder #HKEY_USERS
; Pfad$: Regsitry-Pfad
; Schlüßel: Registry-SchlüßelName
; Computer$: ???
;Aufruf: Reg_delValue(topKey, Pfad$, Schlüßel {, Computer$}}) ;"freien" Registry-Eintrag löschen
; topKey: #HKEY_CLASSES_ROOT, #HKEY_CURRENT_USER, #HKEY_LOCAL_MACHINE
; oder #HKEY_USERS
; Pfad$: Regsitry-Pfad
; Schlüßel: Registry-SchlüßelName
; Computer$: ???
CompilerIf Defined(Registry_BaseKey, #PB_Constant) = 0
#Registry_BaseKey = "Software\Alstersoft\"
CompilerEndIf
CompilerIf Defined(Debug_Registry, #PB_Constant) = 0
#Debug_Registry = 0
CompilerEndIf
CompilerIf Defined(Registry_maxLen, #PB_Constant) = 0
#Registry_maxLen = 1024
CompilerEndIf
;#jaPBeExt exit
;{Fehler-MeldungsProc, Macro´s...
CompilerIf Defined(FormatMessage, #PB_Procedure) = #False
Procedure.s FormatMessage(ErrorNumber.l)
Protected * Buffer, len, Result$
len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM, 0, ErrorNumber, 0, @ * Buffer, 0, 0)
If len
Result$ = PeekS(*Buffer, len - 2)
LocalFree_(*Buffer)
;MessageRequester("Registry-Fehler", result)
ProcedureReturn Result$
Else
ProcedureReturn "Errorcode: " + Hex(ErrorNumber)
EndIf
EndProcedure
CompilerEndIf
Macro Reg_BackSlash
; While Left(pfad$, 1) = "\" : pfad$ = Right(pfad$, StringByteLength(pfad$) - SizeOf(Character)): Wend
; While Right(pfad$, 1) = "\" : pfad$ = Left(pfad$, StringByteLength(pfad$) - SizeOf(Character)): Wend
While Left(pfad$, 1) = "\" : pfad$ = Right(pfad$, Len(pfad$) - 1): Wend
While Right(pfad$, 1) = "\" : pfad$ = Left(pfad$, Len(pfad$) - 1): Wend
EndMacro
Macro Reg_Err2Txt(ErrNr)
Registry_Error = ErrNr
Registry_Error$ = FormatMessage(Registry_Error)
EndMacro
;}
Procedure Reg_SetValue(topKey, pfad$, KeyName$, Wert$, Typ = #REG_SZ, ComputerName$ = "")
Protected Bytes.l, hKey.l, KeyInfo, lhRemoteRegistry.l ;, lpData${#Registry_maxLen}
Protected lValue.l, r1.l, Result.l
Registry_Error = 0
Reg_BackSlash
If ComputerName$ = ""
r1 = RegCreateKeyEx_(topKey, pfad$, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, 0, @hKey, @KeyInfo)
; r1 = RegOpenKeyEx_(topKey, Pfad$, 0, #KEY_ALL_ACCESS, @HKEY)
Else
r1 = RegConnectRegistry_(ComputerName$, topKey, @lhRemoteRegistry)
If r1 <> #ERROR_SUCCESS
Reg_Err2Txt(r1)
ProcedureReturn #False
EndIf
r1 = RegOpenKeyEx_(lhRemoteRegistry, pfad$, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If #Debug_Registry : Debug "RegSave: open=" + Str(r1) + "(ok=" + Str(#ERROR_SUCCESS) + ")" : EndIf
If r1 = #ERROR_SUCCESS
Bytes = #Registry_maxLen - 1
If #Debug_Registry : Debug "RegSave: write <" + Wert$ + ">" : EndIf
Select Typ
Case #REG_SZ
r1 = RegSetValueEx_(hKey, KeyName$, 0, #REG_SZ, @Wert$, StringByteLength(Wert$) + 1)
Case #REG_DWORD
lValue = Val(Wert$)
r1 = RegSetValueEx_(hKey, KeyName$, 0, #REG_DWORD, @lValue, 4)
EndSelect
If r1 = #ERROR_SUCCESS
Result = #True
Else
Reg_Err2Txt(r1)
Result = #False
EndIf
Else
Reg_Err2Txt(r1)
Result = #False
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn Result
EndProcedure
Procedure.s Reg_GetValue(topKey, pfad$, KeyName$, ComputerName$ = "")
Protected Bytes.l, hKey.l, lhRemoteRegistry.l, lpData${#Registry_maxLen}, lpDataDWORD.l
Protected r1.l, Result$, result.l
If #Debug_Registry>1 : Debug "Reg_GetValue("+Str(topKey)+", "+pfad$+", "+KeyName$+", "+ComputerName$ : EndIf
Registry_Error = 0
Result$ = ""
Reg_BackSlash
If #Debug_Registry>1 : Debug "Reg_GetValue("+Str(topKey)+", "+pfad$+", "+KeyName$+", "+ComputerName$ : EndIf
If ComputerName$ = ""
r1 = RegOpenKeyEx_(topKey, pfad$, 0, #KEY_ALL_ACCESS, @hKey)
Else
r1 = RegConnectRegistry_(ComputerName$, topKey, @lhRemoteRegistry)
If r1 <> #ERROR_SUCCESS
Reg_Err2Txt(r1)
ProcedureReturn ""
EndIf
r1 = RegOpenKeyEx_(lhRemoteRegistry, pfad$, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If r1 = #ERROR_SUCCESS
Bytes = #Registry_maxLen
r1 = RegQueryValueEx_(hKey, KeyName$, 0, @RegEntry_Typ, @lpData$, @Bytes)
If r1 = #ERROR_SUCCESS
Select RegEntry_Typ
Case #REG_SZ
r1 = RegQueryValueEx_(hKey, KeyName$, 0, @RegEntry_Typ, @lpData$, @Bytes)
If r1 = #ERROR_SUCCESS
Result$ = Left(lpData$, Bytes - 1)
If #Debug_Registry>1 : Debug "RegistryGet: " + KeyName$ + " = " + #DQUOTE$ + Result$ + #DQUOTE$ + "(" + Str(RegEntry_Typ) + "=Text)" : EndIf
Else : Result$ = ""
EndIf
Case #REG_DWORD
r1 = RegQueryValueEx_(hKey, KeyName$, 0, @RegEntry_Typ, @lpDataDWORD, @Bytes)
If r1 = #ERROR_SUCCESS
Result$ = Str(lpDataDWORD)
If #Debug_Registry>1 : Debug "RegistryGet: " + KeyName$ + " = " + #DQUOTE$ + Result$ + #DQUOTE$ + "(" + Str(RegEntry_Typ) + "=dWord)" : EndIf
Else : Result$ = ""
EndIf
Default ;nicht String oder dWord: binärDaten
For r1 = 0 To Bytes - 1
If PeekB(@lpData$ + r1)> 32
Result$ + Chr(PeekB(@lpData$ + r1))
ElseIf PeekB(@lpData$ + r1) = 0
Result$ + ";"
EndIf
Next
EndSelect
If r1 = #ERROR_SUCCESS
result = #True
Else
Reg_Err2Txt(r1)
result = #False
EndIf
Else : Reg_Err2Txt(r1)
EndIf
Else
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn Result$
EndProcedure
Procedure.s Reg_ListSubKey(topKey, pfad$, Index, ComputerName$ = "")
Protected hKey.l, lhRemoteRegistry.l, ListSubKey$, lpcbName.l, lpftLastWriteTime.FILETIME
Protected lpName${#Registry_maxLen}, r1.l, result.l
Registry_Error = 0
Reg_BackSlash
If ComputerName$ = ""
r1 = RegOpenKeyEx_(topKey, pfad$, 0, #KEY_ALL_ACCESS, @hKey)
Else
r1 = RegConnectRegistry_(ComputerName$, topKey, @lhRemoteRegistry)
If r1 <> #ERROR_SUCCESS
Reg_Err2Txt(r1)
ProcedureReturn ""
EndIf
r1 = RegOpenKeyEx_(lhRemoteRegistry, pfad$, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If r1 = #ERROR_SUCCESS
lpcbName = #Registry_maxLen - 1
r1 = RegEnumKeyEx_(hKey, Index, @lpName$, @lpcbName, 0, 0, 0, @lpftLastWriteTime)
If r1 = #ERROR_SUCCESS
ListSubKey$ = Left(lpName$, lpcbName)
Else
Reg_Err2Txt(r1)
ListSubKey$ = ""
EndIf
Else
Reg_Err2Txt(r1)
ListSubKey$ = ""
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn ListSubKey$
EndProcedure
Procedure Reg_delValue(topKey, pfad$, KeyName$, ComputerName$ = "")
Protected DeleteValue.l, hKey.l, lhRemoteRegistry.l, r1.l
Registry_Error = 0
Reg_BackSlash
If ComputerName$ = ""
r1 = RegOpenKeyEx_(topKey, pfad$, 0, #KEY_ALL_ACCESS, @hKey)
Else
r1 = RegConnectRegistry_(ComputerName$, topKey, @lhRemoteRegistry)
If r1 <> #ERROR_SUCCESS
Reg_Err2Txt(r1)
ProcedureReturn #False
EndIf
r1 = RegOpenKeyEx_(lhRemoteRegistry, pfad$, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If r1 = #ERROR_SUCCESS
r1 = RegDeleteValue_(hKey, @KeyName$)
If r1 = #ERROR_SUCCESS
DeleteValue = #True
Else
Reg_Err2Txt(r1)
DeleteValue = #False
EndIf
Else
Reg_Err2Txt(r1)
DeleteValue = #False
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn DeleteValue
EndProcedure
Procedure Reg_CreateKey(topKey, pfad$, ComputerName$ = "")
Protected CreateKey.l, hKey.l, lhRemoteRegistry.l
Protected lpSecurityAttributes.SECURITY_ATTRIBUTES, r1.l
; Result #REG_CREATED_NEW_KEY = 1
; Result #REG_OPENED_EXISTING_KEY = 2
Registry_Error = 0
Reg_BackSlash
If ComputerName$ = ""
r1 = RegCreateKeyEx_(topKey, pfad$, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hKey, @CreateKey)
Else
r1 = RegConnectRegistry_(ComputerName$, topKey, @lhRemoteRegistry)
If r1 <> #ERROR_SUCCESS
Reg_Err2Txt(r1)
ProcedureReturn #False
EndIf
r1 = RegCreateKeyEx_(lhRemoteRegistry, pfad$, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hKey, @CreateKey)
EndIf
If r1 = #ERROR_SUCCESS
;
Else : Reg_Err2Txt(r1)
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn CreateKey
EndProcedure
Procedure Reg_DeleteKey(topKey, pfad$, ComputerName$ = "")
Protected DeleteKey.l, hKey.l, lhRemoteRegistry.l, r1.l
Registry_Error = 0
Reg_BackSlash
If ComputerName$ = ""
r1 = RegDeleteKey_(topKey, @pfad$)
Else
r1 = RegConnectRegistry_(ComputerName$, topKey, @lhRemoteRegistry)
If r1 <> #ERROR_SUCCESS
Reg_Err2Txt(r1)
ProcedureReturn #False
EndIf
r1 = RegDeleteKey_(lhRemoteRegistry, @pfad$)
EndIf
If r1 = #ERROR_SUCCESS
DeleteKey = #True
Else
Reg_Err2Txt(r1)
DeleteKey = #False
EndIf
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn DeleteKey
EndProcedure
Procedure.s Reg_ListSubValue(topKey, pfad$, Index, ComputerName$ = "")
Protected hKey.l, lhRemoteRegistry.l, ListSubValue$, lpcbName.l
Protected lpftLastWriteTime.FILETIME, lpName${#Registry_maxLen}, r1.l, result.l
Registry_Error = 0
Reg_BackSlash
If ComputerName$ = ""
r1 = RegOpenKeyEx_(topKey, pfad$, 0, #KEY_ALL_ACCESS, @hKey)
Else
r1 = RegConnectRegistry_(ComputerName$, topKey, @lhRemoteRegistry)
If r1 <> #ERROR_SUCCESS
Reg_Err2Txt(r1)
ProcedureReturn ""
EndIf
r1 = RegOpenKeyEx_(lhRemoteRegistry, pfad$, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If r1 = #ERROR_SUCCESS
lpcbName = #Registry_maxLen - 1
r1 = RegEnumValue_(hKey, Index, @lpName$, @lpcbName, 0, 0, 0, 0)
If r1 = #ERROR_SUCCESS
ListSubValue$ = Left(lpName$, lpcbName)
Else
Reg_Err2Txt(r1)
ListSubValue$ = ""
EndIf
Else
Reg_Err2Txt(r1)
ListSubValue$ = ""
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn ListSubValue$
EndProcedure
Procedure Reg_KeyExists(topKey, pfad$, ComputerName$ = "")
Protected hKey.l, KeyExists.l, lhRemoteRegistry.l, r1.l
Registry_Error = 0
Reg_BackSlash
If ComputerName$ = ""
r1 = RegOpenKeyEx_(topKey, pfad$, 0, #KEY_ALL_ACCESS, @hKey)
Else
r1 = RegConnectRegistry_(ComputerName$, topKey, @lhRemoteRegistry)
If r1 <> #ERROR_SUCCESS
Reg_Err2Txt(r1)
ProcedureReturn #False
EndIf
r1 = RegOpenKeyEx_(lhRemoteRegistry, pfad$, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If r1 = #ERROR_SUCCESS
KeyExists = #True
Else
Reg_Err2Txt(r1)
KeyExists = #False
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn KeyExists
EndProcedure
Procedure Reg_DeleteKeyWithAllSub(topKey, pfad$, ComputerName$ = "")
Protected b$, i.l
Protected a$ = ""
Repeat
b$ = a$
a$ = Reg_ListSubKey(topKey, pfad$, 0, "")
If a$<>""
Reg_DeleteKeyWithAllSub(topKey, pfad$ + "\" + a$, "")
EndIf
Until a$ = b$
Reg_DeleteKey(topKey, pfad$, ComputerName$)
EndProcedure
Procedure Reg_CreateKeyValue(topKey, pfad$, KeyName$, Wert$, Typ, ComputerName$ = "")
Reg_CreateKey(topKey, pfad$, ComputerName$)
ProcedureReturn Reg_SetValue(topKey, pfad$, KeyName$, Wert$, Typ, ComputerName$)
EndProcedure
Macro Registry_varInit ;- Reg-TopKey und -BaseKey variablisieren
If Registry_TopKey = 0 : Registry_TopKey = #HKEY_LOCAL_MACHINE : EndIf
If Registry_BaseKey$ = "" : Registry_BaseKey$ = #Registry_BaseKey : EndIf
EndMacro
Macro Registry_varClear ;- Reg-TopKey und -BaseKey reseten
Registry_TopKey = 0 : Registry_BaseKey$ = ""
EndMacro
;========== DatenWert aus Registry lesen ==========
Procedure.s RegistryRead(Reg_Path$, Reg_Key$)
Protected Result$
Registry_varInit
If #Debug_Registry>1 : Debug "registryRead([" + Hex(Registry_TopKey)+"], "+Registry_BaseKey$+Reg_Path$ + ", " + Reg_Key$ + ")"
ElseIf #Debug_Registry : Debug "registryRead(" + Reg_Path$ + ", " + Reg_Key$ + ")" : EndIf
Result$ = Reg_GetValue(Registry_TopKey, Registry_BaseKey$ + Reg_Path$, Reg_Key$)
If #Debug_Registry : Debug "<" + Result$ + ">" : EndIf
Registry_varClear
ProcedureReturn Result$
EndProcedure
;========== DatenWert in Registry schreiben ==========
Procedure RegistryWrite(Reg_Path$, Reg_Key$, Reg_Wert$)
Registry_varInit
Reg_SetValue(Registry_TopKey, Registry_BaseKey$ + Reg_Path$, Reg_Key$, Reg_Wert$, #REG_SZ)
Registry_varClear
EndProcedure
;========== Eintrag in Registry löschen ==========
Procedure RegistryDelete(Reg_Path$, Reg_Key$)
Registry_varInit
Reg_delValue(Registry_TopKey, Registry_BaseKey$ + Reg_Path$, Reg_Key$)
Registry_varClear
EndProcedure
;========== Ende Modul "registry.PBI" ==========
;========== Begin Modul "Win_Upd.PBI" ==========
;Modul Win_Upd Version 2.00 vom 14.02.2014 (V1.0 vom 10.1.2004)
#PB_Vers = "4.20"
;
;Funktion: Handhabung variabler Fenster-Positionen und -Größen.
;
;Aufruf: updated = Win_Upd(fnc) fnc: 1=load 2=chkUpd 20=chgSizeUpd 4=push 5=pop 6=setState 9=save
; wobei: fnc = FunktionsSteuerung:
; 1 = Initierung (ließt Fenster-Daten in die globalen
; Variablen), kein Rückgabe-Wert
; 2 = Änderungs-Prüfung (prüft aktuelle Fenster-Daten
; auf Änderung, ggf. werden die globalen Variablen
; entsprechend geändert)
; Rückgabe: 1 = Fenster-Größe oder Position geändert
; 0 = keine Änderung
; 20= wie 2, jedoch wird nur Fenster-Größe geprüft (erfordert ab=
; schließendes Win_Upd(9) nach Fenster-Event-Schleife !!!)
; Sinnvoll zur Anpassung von Fenster-Elementen nach Größen=
; änderung, (2) wird auch bei Positionsänderung auslösen...
; Rückgabe: 1 = Fenster-Größe geändert
; 0 = keine Änderung
; 3 = Limit-Prüfung (Win_MinB/Win_B sowie Win_MinT/Win_T)
; kein Rückgabe-Wert
; 4 = Push aktuelle FensterPos. & -Size sowie Win_MinB und Win_MinT
; kein Rückgabe-Wert
; 5 = Pop last FensterPos. & -Size sowie Win_MinB und Win_MinT
; kein Rückgabe-Wert
; 6 = Fenster-Status lt. Win_State (#PB_Window_Normal,
; #PB_Window_Maximize oder #PB_Window_Minimize) aktivieren
; 9 = Fenster-Daten speichern
; kein Rückgabe-Wert
;
Global Win_X ;SpaltenNr der oberen, linken Fenster-Ecke [Pixel]
Global Win_Y ;ZeilenNr der oberen, linken Fenster-Ecke [Pixel]
Global Win_B ;Breite des Fensters [Pixel]
Global Win_T ;Tiefe des Fensters [Pixel]
Global Win_MinB ;minimale FensterBreite [Pixel] (Eingangs-Variable !!!)
Global Win_MinT ;minimale Fensterhöhe [Pixel] (Eingangs-Variable !!!)
Global Win_State ;Fenster-Status (#PB_Window_Normal, #PB_Window_Maximize or #PB_Window_Minimize)
Global Win_HgCol ;Fenster-Hintergrund-Farbe (=GetSysColor_(#COLOR_3DFACE))
Global Win_RegKey$ ;Registry-Key für FensterDatenSpeicherung, wenn nicht belegt,
;so wird "Window" benutzt
Global Win_RegBase$ ;Registry-topKey für FensterDatenSpeicherung, wenn nicht belegt,
;so wird #Prg_Name benutzt
Global Win_Init ;nach Win_Upd(1): 1=Eintrag vorhanden 0=kein Eintrag vorhanden
Global ScrSize_X ;Fenster-Breite [Pixel] über alle Monitore, bei nur einem Monitor exclusiv TaskLeiste (kann auch seitlich sein !!!)
Global ScrSize_y ;Fenster-Höhe [Pixel] über alle Monitore, bei nur einem Monitor exclusiv TaskLeiste
Global Win_Stack$ ;Stack für gepuschte FensterDaten
Global WinUpd_WinNr = - 1 ;#Window-Nr des aktuellen Fensters (das, für das die Global´s gelten)
;========== Begin Modul "_ConstPrg.PBI" ==========
;Modul _ConstPrg Version 1.01 vom 23.08.2009
#PB_Vers = "4.20"
;
;Funktion: stellt die Belegung der Konstanten #Prg_Name und #Prg_Vers sicher
;
;#jaPBeExt exit
CompilerIf Defined(Prg_Name, #PB_Constant) = 0
;#Prg_Name = Left(GetFilePart(#jaPBe_SourceFile), Len(GetFilePart(#jaPBe_SourceFile)) - Len(GetExtensionPart(#jaPBe_SourceFile)))
#Prg_Name = #jaPBe_SourceFile
Debug "setzte #Prg_Name = "+Chr(34)+#Prg_Name+Chr(34)
CompilerEndIf
CompilerIf Defined(Prg_Vers, #PB_Constant) = 0
#Prg_Vers = "noVers"
CompilerEndIf
;========== Ende Modul "_ConstPrg.PBI" ==========
;========== Begin Modul "Desk_Size.PBI" ==========
;Modul Desk_Size Version 1.01 vom 14.02.2014
#PB_Vers = "4.20"
;
;Funktion: liefert Monitor-Größen unter Berücksichtingung der TaskLeiste
;
;Aufruf: Desk_Size()
; belegt die folgenden Global´s:
;
Global Desk_SizeX ;Desktop-Breite [Pixel] über alle Monitore
Global Desk_SizeY ;Desktop-Höhe [Pixel] über alle Monitore
Global Win_TitelHoch ;Höhe des Fenster-Titel´s [Pixel]
Global Desk1SizeX ;Desktop-Breite [Pixel] des 1. Monitor´s (=Basis-Monitor)
Global Desk1SizeY ;Desktop-Höhe [Pixel] des 1. Monitor´s (=Basis-Monitor)
; !!!!!!!!!!!!!!
; !! /\ !!
; !! / \ !!
; !! /Bau=\ !!
; !! /stelle\ !!
; !! /________\ !!
; !!!!!!!!!!!!!!
;MultiMonitor-Problem: Zur Zeit liefert diese Funktion die Höhe des Haupt-Monitor´s (primärer Windows-Monitor)
;sowie die Breiten-Summe aller Monitore: es wird also davon ausgegangen, dass alle Monitore nebeneinander
;angeordnet sind...
;Erst ab PB Vers 4.60 können die Monitor-Positionen via DesktopX(MonitorNr) und DesktopY(MonitorNr) ermittelt
;werden.
;Außerdem muss ein Parameter (=MonitorNr oder Maus-X/Y (dann Umrechnung zu MonitorNr)) implementiert
;werden, um die Daten eines Monitors zu ermitteln !!!
;
;#jaPBeExt exit
Procedure Desk_Size()
Protected Desktops, DesktopWorkArea.RECT
If Win_TitelHoch = 0
Win_TitelHoch = GetSystemMetrics_(#SM_CYCAPTION)
SystemParametersInfo_(#SPI_GETWORKAREA, 0, @DesktopWorkArea, 0) ; holt Desktops-Größe unter Berücksichtigung der Taskleiste
Desk_SizeX = DesktopWorkArea\right - DesktopWorkArea\left
Desk_SizeY = DesktopWorkArea\bottom - DesktopWorkArea\top - Win_TitelHoch
Desk1SizeX = Desk_SizeX : Desk1SizeY = Desk_SizeY
;MultiScreen-Umgebung (z.Zt. nur Monitore nebeneinander möglich !!!)
Debug "BaseScreen = "+Str(Desk_SizeX)+" x "+Str(Desk_SizeY)+" Pixel"
Desktops = ExamineDesktops()
If Desktops>1
While Desktops>1
Desktops - 1
Debug "Desk_Size(): Screen #"+Str(Desktops+1)+" = "+Str(DesktopWidth(Desktops))+" x "+Str(DesktopHeight(Desktops))+" Pixel"
Desk_SizeX + DesktopWidth(Desktops)
If Desk_SizeY<DesktopHeight(Desktops): Desk_SizeY = DesktopHeight(Desktops): EndIf
Wend
EndIf
Debug "Desk_Size(): TotalSize = "+Str(Desk_SizeX)+" x "+Str(Desk_SizeY)+" Pixel"
EndIf
EndProcedure
; Desk_Size()
; Debug "DeskSize_output = "+Str(Desk_SizeX)+" x "+Str(Desk_SizeY)+" Pixel"
;========== Ende Modul "Desk_Size.PBI" ==========
;========== Begin Modul "max.PBI" ==========
;Modul max Version 1.00 vom 27.04.2004
#PB_Vers = "4.20"
;
;Funktion: liefert die größte von 2 Long-Zahlenwerten
;
;Aufruf: Maximum.l = max(Zahl1.l, Zahl2.l)
;
Procedure Max(w1,w2)
If w1>w2
ProcedureReturn w1
EndIf
ProcedureReturn w2
EndProcedure
;========== Ende Modul "max.PBI" ==========
;========== Begin Modul "min.PBI" ==========
;Modul min Version 1.00 vom 27.04.2004
#PB_Vers = "4.20"
;
;Funktion: liefert die kleinste von 2 Integer-Zahlenwerten
;
;Aufruf: Minimum.l = min(Zahl1.l, Zahl2.l)
;
Procedure Min(w1,w2)
If w1<w2
ProcedureReturn w1
EndIf
ProcedureReturn w2
EndProcedure
;========== Ende Modul "min.PBI" ==========
;========== Begin Modul "WinBlink.PBI" ==========
;Modul WinBlink Version 1.02 vom 20.02.2010
#PB_Vers = "4.20"
;
;Funktion: Steuerung blinkender Fenster-Titel (auch in TaskBar)
; Mit dieser Funktion kann ein Fenster-Titel blinkend angezeigt werden
;
;Aufruf: WinBlink(WinNr, Mode$ {, Interval}) -Mode$: F=FensterTitel und/oder T=TaskLeiste sonst: blinken aus
; WinNr : #WindowNr des Fensters, dessen blinken gesteuert werden soll
; Mode$ : steuert das Blinken, wenn:
; "F" enthalten ist, so blinkt der Fenster-Titel,
; "T" enthalten ist, so blinkt der Taskleisten-Eintrag
; ist keines der beiden Zeichen enthalten (GROSS-/klein-
; schrift egal...), so wird das Blinken ausgeschaltet.
; Intervall: Blink-Zeit [mSec´s], je größer, desto langsamer...
; Wird dieser Parameter nicht angegeben, so wird 200 benutzt
;
;#jaPBeExt exit
Structure FLASHWINFO
cbSize.l
hwnd.l
dwFlags.l
uCount.l
dwTimeout.l
EndStructure
Procedure WinBlink(WinNr, Mode$, Intervall = 200);Mode$: F=FensterTitel und/oder T=TaskLeiste sonst: blinken aus
Protected Info.FLASHWINFO
If IsWindow(WinNr)
Info\cbSize = SizeOf(FLASHWINFO)
Info\hwnd = WindowID(WinNr)
Mode$ = UCase(Mode$)
If FindString(Mode$, "F", 1);Fenster-Titel
Info\dwFlags = 5
If FindString(Mode$, "T", 1);Fenster-Titel + TaskLeiste
Info\dwFlags = 7
EndIf
ElseIf FindString(Mode$, "T", 1);TaskLeiste
Info\dwFlags = 6
EndIf
Info\uCount = 0 ;wie oft blinken ? (0=endlos)
Info\dwTimeout = Intervall ;Blink-Dauer [mSec´s]
FlashWindowEx_(Info)
EndIf
EndProcedure
;========== Ende Modul "WinBlink.PBI" ==========
;========== Begin Modul "Wort.PBI" ==========
;Modul Wort Version 1.14 vom 05.03.2013 (PB_V3.73)
#PB_Vers = "4.20"
; (Basis: THEOS-Modul SYSTEM.MODLIB.WORT V 3.03 vom 11.05.1997)
;
;Funktion: liefert erstes Wort in einem String und verkürzt Diesen entsprechend
; entspricht prinzipell der PB-Funktion "StringField()", benötigt jedoch
; keinen Wort-Index und erkennt Wort aufgrund diverser Trenn- / Klammerungs=
; zeichen. Außerdem wird die Wort-Basis (Eingangs-String-Parameter) wie
; eine Queue gehandhabt und nach FunktionsEnde ist das erkannte Wort am
; Anfang dieses Strings entfernt...
;
;Aufruf: Wort$ = Wort(@String$) - liefert nächstes Wort von String$ (bis Leerzeichen bzw. geklammert)
; wobei: String$ = Text-Variable !!!, in der ggf. mehrere Worte enthalten sind.
; Ein Wort ist:
; - alle Zeichen bis zum nächsten Blank(führende Blank´s werden ignoriert) oder
; - geklammert durch " (^34), ' (^39), ´(^180), " " (^160) oder ^255 oder
; - bis zum nächsten Zeichen lt. Global ´Wort_Ende$´ oder
; - geklammter durch Zeichen lt. Global ´Wort_Klammer$´
; Die Global´s Wort_Ende$ und Wort_Klammer$ sind nach Funktions-Rückkehr resetet
; (=leer!!), müßen also -sofern erforderlich- _vor jedem Aufruf_ dieser Funktion
; entsprechend gesetzt werden !!!!
;
; Diese Funktion liefert das 1. Wort im String (führende Leerzeichen werden ignoriert)
; und der String wird entsprechend verkürzt
; Beispiel:
; A$ = "hallo ´du da´ alles klar"
; B$ = Wort(@A$) ;1. Aufruf
; (--> B$ ist "hallo", A$ ist nun "´du da´ alles klar")
; B$ = Wort(@A$) ;2. Aufruf
; (--> B$ ist "du da", A$ ist nun "alles klar") (wg. ´´-Klammerung)
; B$ = Wort(@A$) ;3. Aufruf
; (--> B$ ist "alles", A$ ist nun "klar")
; B$ = Wort(@A$) ;4. Aufruf
; (--> B$ ist "klar", A$ ist nun leer)
;
Global Wort_Ende$ ;Zeichen(kette) für Wort-Ende, GROSS-/klein-Schrift egal
;!!! ist nach Funktionsausführung resettet (=leer) !!!
Global Wort_Klammer$ ;Klammerungs-Zeichen: alle Zeichen, die als Wort-Anfangs- oder Ende-Kennung
;beim folgenden Aufruf zulässig sein sollen
Global Wort_EndKz$ ;Rückgabe: gefundenes/benutztes Wort-Ende-Zeichen
;bzw. Zeichenkette bei Einsatz von Wort_Ende$
#Wort_BlankReplace = Chr(28);siehe Modul "WortForm()"...
#Wort_KlammerChars = Chr(34)+Chr(39)+Chr(180)+Chr(160)+Chr(255)
;#jaPBeExt exit
Procedure.s Wort(*Param)
Protected Param$, Wort$
If * Param>1
Param$ = LTrim(PeekS(*Param))
If Wort_Ende$ = ""
If Wort_Klammer$ = ""
Wort_Klammer$ = #Wort_KlammerChars ;", ', ´ oder ^255
EndIf
If FindString(Wort_Klammer$, Left(Param$, 1), 1)And Param$>""
Wort_Ende$ = Left(Param$, 1)
Param$ = Right(Param$, Len(Param$) - 1)
Else
Wort_Ende$ = " "
EndIf
EndIf
Wort_Ende$ = UCase(Wort_Ende$)
While UCase(Left(Param$, Len(Wort_Ende$)))<>Wort_Ende$ And Param$>""
Wort$ + Left(Param$, 1)
Param$ = Mid(Param$, 2)
Wend
Param$ = Mid(Param$, Len(Wort_Ende$))
Wort$ = LTrim(ReplaceString(Wort$, #Wort_BlankReplace, Chr(32)))
Wort_EndKz$ = Wort_Ende$
Wort_Ende$ = "" : Wort_Klammer$ = ""
PokeS(*Param, LTrim(Right(Param$, Len(Param$) - 1)))
EndIf
ProcedureReturn Wort$
EndProcedure
;{- Test-Routine
; Queue$ = "na, mal%LF sehen"
; Wort_Ende$ = "%lf"
; Debug "Queue = " + #DQUOTE$ + Queue$ + #DQUOTE$
; Debug "Wort_Ende$ = " + #DQUOTE$ + Wort_Ende$ + #DQUOTE$
; While Queue$>""
; Wort + 1
; Debug Str(Wort) + ". Wort = " + #DQUOTE$ + Wort(@Queue$) + #DQUOTE$
; Wend
;}
;========== Ende Modul "Wort.PBI" ==========
CompilerIf Defined(Debug_WinUpd, #PB_Constant) = 0
#Debug_WinUpd = 0
CompilerEndIf
;#jaPBeExt exit
Macro Win_Upd_WinNr ;- aktuelles Fenster bestimmen
If WinUpd_WinNr< = 0 And GetActiveWindow()> = 0
WinUpd_WinNr = GetActiveWindow()
EndIf
EndMacro
Procedure Win_Upd_RegSave() ;- aktuelle FensterDaten in Registry speichern
Protected WinData$ = Str(Win_X) + " " + Str(Win_Y) + " " + Str(Win_B) + " " + Str(Win_T)
Win_Upd_WinNr
If IsWindow(WinUpd_WinNr): WinData$ + " " + Str(GetWindowState(WinUpd_WinNr)): EndIf
If #Debug_WinUpd : Debug "Win_Upd_RegWrite(" + Win_RegBase$ + ", " + Win_RegKey$ + ", " + WinData$ + ")" : EndIf
RegistryWrite(Win_RegBase$, Win_RegKey$, WinData$)
EndProcedure
Procedure Win_Upd_Limits() ;- Fenster-Größe / -Position prüfen (innerhalb Monitor(e) ?)
; Win_B = Min(Desk_SizeX - Win_X, Max(Win_MinB, Win_B))
; Win_T = Min(Desk_SizeY - Win_Y, Max(Win_MinT, Win_T))
Win_B = Max(Win_MinB, Win_B)
Win_T = Max(Win_MinT, Win_T)
If Win_X<0 : Win_X = (Desk_SizeX - Win_B) / 2 : EndIf
If Win_Y<0 : Win_Y = (Desk_SizeY - Win_T) / 2 : EndIf
If IsWindow(WinUpd_WinNr)
If WindowWidth(WinUpd_WinNr)<Win_B Or WindowHeight(WinUpd_WinNr)<Win_T
ResizeWindow(WinUpd_WinNr, #PB_Ignore, #PB_Ignore, Win_B, Win_T)
EndIf
EndIf
EndProcedure
Procedure Win_Upd(FncNr) ;- die HauptFunktion
Protected Init$, Win_Upd_Flag, WinNr
If ScrSize_X<10 Or ScrSize_y<10
Desk_Size()
ScrSize_X = Desk_SizeX
ScrSize_y = Desk_SizeY
Win_HgCol = GetSysColor_(#COLOR_3DFACE)
EndIf
If Win_RegKey$ = "": Win_RegKey$ = "Window" : EndIf
If Win_RegBase$ = "": Win_RegBase$ = #Prg_Name : EndIf
Select FncNr
Case 1 ;{init: FensterDaten aus Regsitry in Global´s eintragen
If IsWindow(WinUpd_WinNr);da ist (noch?) ein Fenster aktiv !!!
Win_Upd(4);dessen Fensterdaten pushen
WinUpd_WinNr = - 1
EndIf
Init$ = RegistryRead(Win_RegBase$, Win_RegKey$);{FensterDaten vom letzten PrgLauf holen
If #Debug_WinUpd : Debug "Win_Upd_RegRead(" + Win_RegBase$ + ", " + Win_RegKey$ + ")= " + #DQUOTE$ + Init$ + #DQUOTE$: EndIf
If Init$>"" : Win_Init = 1
Win_X = Max(0, Val(Wort(@Init$)))
Win_Y = Max(0, Val(Wort(@Init$)))
; Win_B = Min(ScrSize_X - Win_X, Val(Wort(@Init$)))
; Win_T = Min(ScrSize_y - Win_Y, Val(Wort(@Init$)))
Win_B = Val(Wort(@Init$))
Win_T = Val(Wort(@Init$))
Win_State = Val(Init$)
Else ;Erstlauf: mittig auf 1. Monitor (=Basis-Monitor)
#Part = 10
If Win_MinB<ScrSize_X / #Part : Win_MinB = Desk1SizeX / #Part : EndIf
If Win_MinT<ScrSize_y / #Part : Win_MinT = Desk1SizeX / #Part : EndIf
Win_B = Win_MinB
Win_T = Win_MinT
Win_X = (Desk1SizeX - Win_B) / 2
Win_Y = (Desk1SizeX - Win_T) / 2
EndIf ;}
Win_Upd_Limits()
;}
Case 2 ;{check update (Size oder Pos)
Win_Upd_WinNr
If IsWindow(WinUpd_WinNr)
If Win_State <> GetWindowState(WinUpd_WinNr)
Win_State = GetWindowState(WinUpd_WinNr)
If Win_State<>#PB_Window_Minimize
WinBlink(WinUpd_WinNr, "");blinken aus
EndIf
EndIf
If Win_State<>#PB_Window_Minimize
If(WindowWidth(WinUpd_WinNr)<>Win_B Or WindowHeight(WinUpd_WinNr)<>Win_T Or WindowX(WinUpd_WinNr)<>Win_X Or WindowY(WinUpd_WinNr)<>Win_Y)And getAsyncKeyState_(#VK_LBUTTON) = 0
Win_X = WindowX(WinUpd_WinNr)
Win_Y = WindowY(WinUpd_WinNr)
Win_B = WindowWidth(WinUpd_WinNr)
Win_T = WindowHeight(WinUpd_WinNr)
Win_Upd_Limits()
Win_Upd_RegSave()
ProcedureReturn #True
EndIf
EndIf
EndIf
ProcedureReturn #False
;}
Case 20 ;{check update (only Size)
Win_Upd_WinNr
;Debug "WinUpd(20): WinNr="+Str(WinUpd_WinNr)
If IsWindow(WinUpd_WinNr)
; If Win_State <> GetWindowState(WinUpd_WinNr)
; Win_State = GetWindowState(WinUpd_WinNr)
; If Win_State<>#PB_Window_Minimize
; WinBlink(WinUpd_WinNr,"") ;blinken aus
; EndIf
; EndIf
;If Win_State<>#PB_Window_Minimize
;Debug "Window: "+Str(WindowWidth(WinUpd_WinNr))+" x "+Str(WindowHeight(WinUpd_WinNr))
;Debug "WinUpd: "+Str(Win_B)+" x "+Str(Win_T)+", MausTaste="+Str(GetAsyncKeyState_(#VK_LBUTTON))
If(WindowWidth(WinUpd_WinNr)<>Win_B Or WindowHeight(WinUpd_WinNr)<>Win_T); And GetAsyncKeyState_(#VK_LBUTTON) = 0
Win_X = WindowX(WinUpd_WinNr)
Win_Y = WindowY(WinUpd_WinNr)
Win_B = WindowWidth(WinUpd_WinNr)
Win_T = WindowHeight(WinUpd_WinNr)
Win_Upd_Limits()
Win_Upd_RegSave()
ProcedureReturn #True
EndIf
;EndIf
Else
; Debug "no isWin()"
EndIf
ProcedureReturn #False
;}
Case 3 ;{set_limits
Win_Upd_Limits()
;}
Case 4 ;{push current windowdata
Init$ = Str(WinUpd_WinNr) + " "
Init$ + Str(Win_X) + " "
Init$ + Str(Win_Y) + " "
Init$ + Str(Win_B) + " "
Init$ + Str(Win_T) + " "
Init$ + Str(Win_State) + " "
Init$ + Str(Win_MinB) + " "
Init$ + Str(Win_MinT) + " "
Init$ + Chr(255) + Win_RegKey$ + Chr(255)
Init$ + Chr(255) + Win_RegBase$ + Chr(255)
Win_Stack$ = Init$ + Win_Stack$
;}
Case 5 ;{pop Windowdata
WinUpd_WinNr = Val(Wort(@Win_Stack$))
Win_X = Val(Wort(@Win_Stack$))
Win_Y = Val(Wort(@Win_Stack$))
Win_B = Val(Wort(@Win_Stack$))
Win_T = Val(Wort(@Win_Stack$))
Win_State = Val(Wort(@Win_Stack$))
Win_MinB = Val(Wort(@Win_Stack$))
Win_MinT = Val(Wort(@Win_Stack$))
Win_RegKey$ = Wort(@Win_Stack$)
Win_RegBase$ = Wort(@Win_Stack$)
If IsWindow(WinUpd_WinNr)
SetActiveWindow(WinUpd_WinNr)
ResizeWindow(WinUpd_WinNr, Win_X, Win_Y, Win_B, Win_T)
Win_Upd(6);Windows-Status restaurieren
EndIf
;}
Case 6 ;{set WindowState (normal, minimiert oder maximiert), ggf. mit blinkendem TaskLeisten-Eintrag
Win_Upd_WinNr
If IsWindow(WinUpd_WinNr)
SetWindowState(WinUpd_WinNr, Win_State)
If Win_State = #PB_Window_Minimize
WinBlink(WinUpd_WinNr, "T");TaskLeisten-Eintrag blinken lassen
EndIf
EndIf
;}
Case 9 ;{save Windows-Datas
Win_Upd_WinNr
If IsWindow(WinUpd_WinNr)
Win_State = GetWindowState(WinUpd_WinNr)
If Win_State<>#PB_Window_Minimize
Win_X = Max(0, WindowX(WinUpd_WinNr))
Win_Y = Max(0, WindowY(WinUpd_WinNr))
Win_B = WindowWidth(WinUpd_WinNr)
Win_T = WindowHeight(WinUpd_WinNr)
Win_Upd_Limits()
EndIf
Win_Upd_RegSave()
EndIf
;}
EndSelect
EndProcedure
;========== Ende Modul "Win_Upd.PBI" ==========
#WebGad_LogonRegKey = "Logon"
Procedure WebGad_Logon(Titel$, URL_Ident$, NameFld$, PassFld$, URL_ok$, Name$ = "", Passwort$ = "")
Protected Rand, WebGad, WinNr, Zeile$
If WebGad_Logon_okButtName$ = "" : WebGad_Logon_okButtName$ = "javascript:evaltF()" : EndIf
Win_MinB = GetSystemMetrics_(#SM_CXSCREEN) / 3
Win_MinT = GetSystemMetrics_(#SM_CYSCREEN) / 2
Win_Upd(1)
WinNr = OpenWindow(#PB_Any, Win_X, Win_Y, Win_B, Win_T, Titel$, #PB_Window_SizeGadget|#PB_Window_SystemMenu|#PB_Window_Invisible)
CreateGadgetList(WindowID(WinNr))
If #Debug_WebGad : Debug "WebGad_Logon auf " + #DQUOTE$ + URL_Ident$ + #DQUOTE$: EndIf
Rand = GetSystemMetrics_(#SM_CXFRAME)
WebGad = WebGadget(#PB_Any, Rand, 0, WindowWidth(WinNr) - Rand - Rand, WindowHeight(WinNr) - Rand, URL_Ident$)
WebgadgetBusy(WebGad)
;ggf. nicht-default-Username & -Passwort holen
Zeile$ = RegistryRead(#Prg_Name, #WebGad_LogonRegKey)
If Zeile$>""
Name$ = Wort(@Zeile$)
Passwort$ = Zeile$
EndIf
Ident_restart:
If #Debug_WebGad : Debug "setData: " + NameFld$ + " = " + #DQUOTE$ + Name$ + #DQUOTE$ + ", " + PassFld$ + " = " + #DQUOTE$ + Passwort$ + #DQUOTE$: EndIf
If HTML_FldData(WebGad, NameFld$, Name$)>"" ;Username in HTML-Feld einsetzen
ProcedureReturn ;Result geliefert: NameFld$ nicht vorhanden: bereits eingeloged!
EndIf
HTML_FldData(WebGad, PassFld$, Passwort$);Passwort in HTML-Feld einsetzen
WebgadgetBusy(WebGad);auf Laden der Folgeseite warten
SetGadgetText(WebGad, WebGad_Logon_okButtName$);anmelde-Button drücken
WebgadgetBusy(WebGad);auf Laden der Folgeseite warten
If #Debug_WebGad
Debug "Result = " + GetGadgetText(WebGad)
Debug "Ok-URL = " + URL_ok$
EndIf
If Win_Upd(20) ;Eingabe-Fenster Größen-verändert ?
ResizeGadget(WebGad, 0, 0, WindowWidth(WinNr), WindowHeight(WinNr))
EndIf
If UCase(GetGadgetText(WebGad))<>UCase(URL_ok$);Name / Passwort falsch
HideWindow(WinNr, 0)
Ident_NameInput:
Name$ = InputRequester(Titel$, "Benutzer-Name", Name$)
If Name$ = "" : End : EndIf
Passwort$ = InputRequester(Titel$, "Passwort", Passwort$)
If Passwort$ = "" : Goto Ident_NameInput : EndIf
RegistryWrite(#Prg_Name, #WebGad_LogonRegKey, Klammer(Name$) + " " + Passwort$)
SetGadgetText(WebGad, URL_Ident$)
WebgadgetBusy(WebGad)
Goto Ident_restart
EndIf
Win_Upd(9)
HideWindow(WinNr, 1);Fenster bleibt offen (AutoLogoff needet!!!)
EndProcedure
;========== Ende Modul "WebGad_Logon.PBI" ==========
;========== Begin Modul "InternetPage2String.PBI" ==========
;Modul InternetPage2String Version 1.02 vom 28.12.2013
#PB_Vers = "4.20"
;
;Funktion: holt eine komplette Internet-Seite in einen String
;
;Aufruf: Seite$ = InternetPage2String(URL$ {,maxBytes.l {,Mode.l}})
; URL$: vollständige Internet-Adresse der downzuladenden InternetSeite
; maxBytes: max. Größe [Bytes] der zu ladenden URL, wenn nicht angegeben,
; so wird 65535 benutzt
; Mode: StringMode der URL (#PB_Unicode oder #PB_Ascii, wenn nicht an=
; gegeben, so wird #PB_Ascii benutzt)
;
; Wenn´s ´n Fehler gab (Speicherzuordnung, Ladefehler...), so wird ein
; entsprechender MessageRequester ausgegeben und diese Funktion liefert
; einen Leerstring, ansonsten befindet sich die gesammte Seite (incl.
; ^10, ^13...) im Rückgabe-Wert und kann dort analysiert werden...
;
Global InternetPage2StringLen ;Länge [Anz. Zeichen] der zuletzt eingelesenen URL
;
; Anwendungs-Beispiel:
; Seite$ = InternetPage2String(URL$) ;Internet-Seite holen
; If Seite$ = "" : End : EndIf ;fehlgeschlagen
; CreateFile(1, "xxx.txt") ;Datei öffnen
; WriteData(@Seite$, Len(Seite$)) ;Internet-Seite reinschreiben
; CloseFile(1) ;und abschließen
;
;#jaPBeExt exit
Procedure.s InternetPage2String(URL$, Size.l = 65535, Mode = #PB_Ascii);- ließt komplette Internet-Seite in einen String
Protected agent$, Bytes.l, hData.l, hINet.l
Protected * MemoryID = AllocateMemory(Size)
InternetPage2StringLen = 0
If * MemoryID = 0
MessageRequester("Speicher-ZugriffsFehler !!!!", "Konnte den angeforderten Speicher nicht reservieren!", #MB_OK|#MB_ICONINFORMATION)
ProcedureReturn ""
End
EndIf
;Debug "load URL "+Chr(34)+URL$+Chr(34)
agent$ = "Mozilla/4.0(compatible ; ST)"
hINet = InternetOpen_(@agent$, 0, 0, 0, 0)
hData = InternetOpenUrl_(hINet, @URL$, "", 0, 0, 0)
URL$ = ""
If hData > 0
While InternetReadFile_(hData, *MemoryID, Size, @Bytes.l)And Bytes>0
;Debug Str(Bytes) + " Bytes readet"
URL$ + PeekS(*MemoryID, Bytes, #PB_Ascii)
Wend
Else : Bytes = - 1
EndIf
InternetCloseHandle_(hINet)
InternetCloseHandle_(hData)
FreeMemory(*MemoryID)
If Bytes<0
MessageRequester("Seiten-Ladefehler !!!", "kann die Internet-Seite" + #LF$ + #DQUOTE$ + URL$ + #DQUOTE$ + #LF$ + "nicht öffnen !!!", #MB_OK|#MB_ICONWARNING)
ProcedureReturn ""
EndIf
InternetPage2StringLen = Len(URL$)
ProcedureReturn URL$
EndProcedure
;========== Ende Modul "InternetPage2String.PBI" ==========
Procedure.s DataSep(VarName$) ;liefert Zuweisungs-Wert an eine HTML-Variable in Page$
Protected VarNameLen=Len(VarName$)
Protected Buff$
Protected pos=FindString(Page$,VarName$,1)
If pos
Buff$=Mid(Page$,pos+VarNameLen)
While Left(Buff$,1)=" " Or Left(Buff$,1)="=" : Buff$=Mid(Buff$,2) : Wend
Debug VarName$+" = "+Buff$
ProcedureReturn Wort(@Buff$)
Else
ProcedureReturn ""
EndIf
EndProcedure
;****************************************************************
;** MainSource **
;****************************************************************
DisableExplicit
;{- Define´s einlesen
URL_Logon$="http://192.168.2.1" ;URL der EB-Anmeldung
URL_LogOK$="http://192.168.2.1/index.stm" ;URL nach erfolgreicher EB-Anmeldung
URL$="http://192.168.2.1/voip_status.stm" ;URL der EB-Seite mit den Verbindungs-Listen
; For i=1 To 8
; VarName$(i)=DefDat()
; Next;}
;folgende Daten _nicht_ verändern !!! sonst Fehlfunktion garantiert !!!
;HTML-VariablenNamen der EasyBox (eingehende Verbindungen)
; VarName(1)="voip_i_Phone" ;Quell-RufNummer
; VarName(2)="voip_i_Date" ;Datum & Uhrzeit
; VarName(3)="voip_i_Keep" ;Verbindungs-Dauer
; VarName(4)="voip_i_AC_Phone" ;Ziel-Rufnummer
; ;HTML-VariablenNamen der EasyBox (abgehende Verbindungen)
; VarName(5)="voip_o_Phone" ;Ziel-RufNummer
; VarName(6)="voip_o_Date" ;Datum & Uhrzeit
; VarName(7)="voip_o_Keep" ;Verbindungs-Dauer
; VarName(8)="voip_o_AC_Phone" ;Quell-Rufnummer
;{- EasyBox auslesen (logon & vollständige VerbindungsProtokoll-Seite einlesen, close EB)
Page$=InternetPage2String(URL_Logon$, 100000)
EB_Typ$=DataSep("product_name") ;es gibt div. EaysBox-Typen (401 bis 903, wird später mal ausgewertet)
If EB_Typ$>""
WebGad_Logon("Easybox-Anmeldung", URL_Logon$, #UserKey, #PassKey, URL_LogOK$, "root","123456") ;standart-username and password
EndIf
Page$=InternetPage2String(URL$, 100000)
Debug Str(Len(Page$))+" Bytes"
If FindString(Page$,"Passwort",1)
MessageRequester("keine Anmeldung !!!", "Zur Zeit ist die Easybox nicht angemeldet !!!" + Chr(10) + "" + Chr(10) + "Bitte melden Sie sich zuerst auf der Easybox an:" + Chr(10) + "" + Chr(10) + "http//192.168.2.1" + Chr(10) + "Benutzername = root" + Chr(10) + "Passwort = 123456" + Chr(10) + "" + Chr(10) + "(Standart-Werte, falls Benutzername und/oder" + Chr(10) + "Passwort geändert, so bitte die geänderten Daten" + Chr(10) + "eingeben)", #MB_OK|#MB_ICONERROR)
End
EndIf
RunProgram(#ExitCmd,"","",#PB_Program_Hide) ;an EasyBox abmelden
;}
;{- eingehende Verbindungen aufbereiten --> Connect()-Liste
Entry=0
Repeat
Entry$="["+Str(Entry)+"]"
Entry+1
RN$=DataSep(VarName$(1)+Entry$)
If RN$>""
Zeit$=DataSep(VarName$(2)+Entry$)
Dauer$=DataSep(VarName$(3)+Entry$)
Own$=DataSep(VarName$(4)+Entry$)
AddElement(Connect$())
Connect$()=LSet(Str(ParseDate(EB_DateMask$,Zeit$)),10)+" von "+RN$+" nach "+Own$+" Dauer:"+Dauer$
EndIf
Until RN$="" ;}
;{- ausgehende Verbindungen aufbereiten --> Connect()-Liste
Entry=0
Repeat
Entry$="["+Str(Entry)+"]"
Entry+1
RN$=DataSep(VarName$(5)+Entry$)
If RN$>""
Zeit$=DataSep(VarName$(6)+Entry$)
Dauer$=DataSep(VarName$(7)+Entry$)
Own$=DataSep(VarName$(8)+Entry$)
AddElement(Connect$())
Connect$()=LSet(Str(ParseDate(EB_DateMask$,Zeit$)),10)+" von "+Own$+" nach "+RN$+" Dauer:"+Dauer$
EndIf
Until RN$="" ;}
;}
;==========< Auswertung >==========
; 1403 Zeilen
; 57213 Bytes
; 14 Module
