Code: Alles auswählen
;+----------------------------------------------------------------------+
;| PureBasic-QuellCode "WebGad_Logon" mit allen ModulBody´s |
;|erstellt durch Programm "PB_Mod2Body", Vers. 11225a am 06.12.11, 00:17|
;+----------------------------------------------------------------------+
;Modul WebGad_Logon Version 1.00 vom 03.09.2009
#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 entsprechenden 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 "HTML_FldData.PBI" ==========
;Modul HTML_FldData Version 1.08 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" ==========
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
;based by HJBremer / Hroudtwolf
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"
;Element\get_title(@bStrValue) ;FeldPrompt, maybe nicht definiert !!!
;HTML_FeldName$ = PeekS(bStrValue, #PB_Any, #PB_Unicode)
;Debug "Feld="+Chr(34)+HTML_FeldName$ +Chr(34)
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
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
; updated durch Prg. PB_SrcChg Vers. 8A21a am 22.10.2008, 21:16h
;========== Ende Modul "Klammer.PBI" ==========
;========== Begin Modul "Win_Upd.PBI" ==========
;Modul Win_Upd Version 1.97 vom 20.02.2010 (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=chkSizeUpd 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], exclusiv TaskLeiste (kann auch seitlich sein !!!)
Global ScrSize_y ;Fenster-Höhe [Pixel], 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 "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 "_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.00 vom 12.03.2009
#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]
Global Desk_SizeY ;Desktop-Höhe [Pixel]
Global Win_TitelHoch ;Höhe des Fenster-Titel´s [Pixel]
;
;#jaPBeExt exit
Procedure Desk_Size()
Protected DesktopWorkArea.RECT
Win_TitelHoch = GetSystemMetrics_(#SM_CYCAPTION)
SystemParametersInfo_(#SPI_GETWORKAREA, 0, @DesktopWorkArea, 0) ; holt die Höhe des Desktops unter Berücksichtigung der Taskleiste
Desk_SizeX = DesktopWorkArea\right - DesktopWorkArea\left
Desk_SizeY = DesktopWorkArea\bottom - DesktopWorkArea\top-Win_TitelHoch
EndProcedure
;========== 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 "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!!!)
;#jaPBeExt exit
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
;{Fehler-MeldungsProc, Macro´s...
CompilerIf Defined(FormatMessage, #PB_Procedure) = #False
Procedure.s FormatMessage(ErrorNumber.l)
Protected * Buffer, len, Result.s
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$) - 1): Wend
While Right(Pfad$, 1) = "\" : Pfad$ = Left(Pfad$, StringByteLength(Pfad$) - 1): Wend
EndMacro
;}
Procedure Reg_SetValue(topKey, Pfad$, KeyName$, Wert$, Typ = #REG_SZ, ComputerName.s = "")
Protected Bytes.l, hKey.l, KeyInfo, lhRemoteRegistry.l, lpData.s{#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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
Result = #False
EndIf
Else
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
Result = #False
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn Result
EndProcedure
Procedure.s Reg_GetValue(topKey, Pfad$, KeyName$, ComputerName.s = "")
Protected Bytes.l, hKey.l, lhRemoteRegistry.l, lpData.s{#Registry_maxLen}, lpDataDWORD.l
Protected r1.l, result$, Result.l
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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
Result = #False
EndIf
Else
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
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.s = "")
Protected hKey.l, lhRemoteRegistry.l, ListSubKey.s, lpcbName.l, lpftLastWriteTime.FILETIME
Protected lpName.s{#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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
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.s = Left(lpName, lpcbName)
Else
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
ListSubKey.s = ""
EndIf
Else
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
ListSubKey.s = ""
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn ListSubKey
EndProcedure
Procedure Reg_DeleteValue(topKey, Pfad$, KeyName$, ComputerName.s = "")
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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
DeleteValue = #False
EndIf
Else
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
DeleteValue = #False
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn DeleteValue
EndProcedure
Procedure Reg_CreateKey(topKey, Pfad$, ComputerName.s = "")
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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn CreateKey
EndProcedure
Procedure Reg_DeleteKey(topKey, Pfad$, ComputerName.s = "")
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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
ProcedureReturn #False
EndIf
r1 = RegDeleteKey_(lhRemoteRegistry, @Pfad$)
EndIf
If r1 = #ERROR_SUCCESS
DeleteKey = #True
Else
DeleteKey = #False
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
EndIf
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn DeleteKey
EndProcedure
Procedure.s Reg_ListSubValue(topKey, Pfad$, Index, ComputerName.s = "")
Protected hKey.l, lhRemoteRegistry.l, ListSubValue.s, lpcbName.l
Protected lpftLastWriteTime.FILETIME, lpName.s{#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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
ListSubValue.s = ""
EndIf
Else
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
ListSubValue.s = ""
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn ListSubValue
EndProcedure
Procedure Reg_KeyExists(topKey, Pfad$, ComputerName.s = "")
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
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
ProcedureReturn #False
EndIf
r1 = RegOpenKeyEx_(lhRemoteRegistry, Pfad$, 0, #KEY_ALL_ACCESS, @hKey)
EndIf
If r1 = #ERROR_SUCCESS
KeyExists = #True
Else
Registry_Error = r1
Registry_Error$ = FormatMessage(Registry_Error)
KeyExists = #False
EndIf
RegCloseKey_(hKey)
If lhRemoteRegistry : RegCloseKey_(lhRemoteRegistry): EndIf
ProcedureReturn KeyExists
EndProcedure
Procedure Reg_DeleteKeyWithAllSub(topKey, Pfad$, ComputerName.s = "")
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.s = "")
Reg_CreateKey(topKey, Pfad$, ComputerName)
ProcedureReturn Reg_SetValue(topKey, Pfad$, KeyName$, Wert$, Typ, ComputerName)
EndProcedure
Procedure AssociateFileEx(AF_Ext$, ext_description$, programm$, icon$, prgkey$, cmd_description$, cmd_key$)
Protected Cmd$, key$
Cmd$ = #DQUOTE$ + programm$ + #DQUOTE$ + " " + #DQUOTE$ + "%1" + #DQUOTE$
If GetVersion_()& $FF0000; Windows NT/XP
Reg_CreateKeyValue(#HKEY_CLASSES_ROOT, "Applications\" + prgkey$ + "\shell\" + cmd_description$ + "\command", "", Cmd$, #REG_SZ, "")
If ext_description$
key$ = AF_Ext$ + "_auto_file"
Reg_CreateKeyValue(#HKEY_CLASSES_ROOT , "." + AF_Ext$ , "", key$ , #REG_SZ, "")
Reg_CreateKeyValue(#HKEY_CLASSES_ROOT , key$ , "", ext_description$, #REG_SZ, "")
If icon$
Reg_CreateKeyValue(#HKEY_CLASSES_ROOT, key$ + "\DefaultIcon", "", icon$ , #REG_SZ, "")
EndIf
EndIf
Reg_CreateKeyValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\." + AF_Ext$, "Application", prgkey$, #REG_SZ, "")
Else;Windows 9x
Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE , "Software\Classes\." + AF_Ext$ , "", prgkey$ , #REG_SZ, "")
If ext_description$
Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE, "Software\Classes\" + prgkey$ , "", ext_description$, #REG_SZ, "")
EndIf
If icon$
Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE, "Software\Classes\" + prgkey$ + "\DefaultIcon" , "", icon$ , #REG_SZ, "")
EndIf
If cmd_description$<>cmd_key$
Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE, "Software\Classes\" + prgkey$ + "\shell\" + cmd_key$, "", cmd_description$, #REG_SZ, "")
EndIf
Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE , "Software\Classes\" + prgkey$ + "\shell\" + cmd_key$ + "\command", "", Cmd$, #REG_SZ, "")
EndIf
EndProcedure
Procedure Remove_AssociateFile(AF_Ext$, prgkey$)
Protected key$
If GetVersion_()& $FF0000; Windows NT/XP
Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT, "Applications\" + prgkey$, "")
key$ = AF_Ext$ + "_auto_file"
Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT, "." + AF_Ext$, "")
Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT, key$, "")
Reg_DeleteKeyWithAllSub(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\." + AF_Ext$, "")
Else;Windows 9x
Reg_DeleteKeyWithAllSub(#HKEY_LOCAL_MACHINE , "Software\Classes\." + AF_Ext$, "")
Reg_DeleteKeyWithAllSub(#HKEY_LOCAL_MACHINE, "Software\Classes\" + prgkey$, "")
EndIf
EndProcedure
Procedure AssociateFile(AF_Ext$, ext_description$, programm$, icon$)
AssociateFileEx(AF_Ext$, ext_description$, programm$, icon$, GetFilePart(programm$), "open", "open")
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_DeleteValue(Registry_TopKey, Registry_BaseKey$ + Reg_Path$, Reg_Key$)
Registry_varClear
EndProcedure
;========== Ende Modul "Registry.PBI" ==========
;========== Begin Modul "Wort.PBI" ==========
;Modul Wort Version 1.13 vom 13.01.2011 (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 für Wort-Ende (darf nur 1 Zeichen sein !!!, nur für 1 Aufruf !!!)
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
#Wort_BlankReplace = Chr(28) ;siehe Modul "WortForm()"...
;========== Begin Modul "CharChg.PBI" ==========
;Modul CharChg Version 1.13 vom 27.11.2011
#PB_Vers = "4.20"
;
;Funktion: mehrfach-Austausch in einem String, in einem BasisString
; wird ein Suchbegriff (EinzelZeichen oder auch ZeichenKette)
; gesucht und durch einem Ersatzbegriff (leer, EinzelZeichen
; oder auch Zeichenkette) ersetzt, das ganze auch mehrfach
; (jedes Vorkommen des Suchbegriffes wird durch den Ersatz=
; begriff ersetzt), innerhalb des Ersatzbegriffes kann der
; Suchbegriff vorkommen, wird jedoch nicht verändert.
;
; Gegenüber der PureBasic-StandartFunktion ReplaceString(),
; die standartmäßig eingesetzt werden sollte, bestehen
; folgende Unterschiede:
; - bei der GROSS-/klein-Schrift-Suche werden auch deutsche
; Sonderzeichen (Ä, Ö, Ü, ß) korrekt gehandhabt
; - Wort-Austausch möglich (vor und nach Suchbegriff darf
; kein Buchstabe im Basis-String stehen)
; - es wird die Anzahl durchgeführter Tauschungen zurück=
; geliefert
; - Mehrfach-Austausch (z.Bsp. TrimAll: " "->" ") hier
; fehlerfrei (klappt nicht in ReplaceString of PB3.80)
; Für nähere Details siehe unten (Global´s)...
;
;
;Aufruf: newstring = CharChg(base$, such$, ersatz$, Mode) -Zeichen(ketten)-Austausch
;wobei: base$ = Basis-String, in dem Teile ausgetauscht werden
; sollen
; such$ = Zeichen(-kette), die in base$ gesucht und ersetzt
; werden soll
; ersatz$ = Zeichen(-kette), die anstelle von such$ in base$
; eingesetzt werden soll
; Mode = Steuerungen (bitorientiert):
#CharChg_noCase = 1 ; = noCase (siehe Global "CharChg_noCase")
#CharChg_Word = 2 ; = Word (siehe Global "CharChg_Word")
; Sobald entweder die Steuerung aktiv ist _oder_ die
; entsprechende globale Variable, so wird die Funktion
; ausgeführt.
;
Global CharChg_noCase ;wenn ungleich 0, so wird GROSS-/klein-Schrift
;ignoriert ("AnKe" wird in "TaNkEn" gefunden
;und ausgetauscht) !!! Variable ist nach
;FunktionsEnde resetet !!! (auf 0 gestellt)
Global CharChg_Word ;wenn ungleich 0, so wird nur ausgetauscht, wenn
;vor und nach dem Suchbegriff kein Buchstabe und
;keine Ziffer steht ("anke" wird _nicht_ in
;"tanken" gefunden). Variable ist nach
;FunktionsEnde resetet !!! (auf 0 gestellt)
Global CharChg_Cnt ;liefert die Anzahl der durchgeführten Aus=
;tauschungen
#CharChg_WordChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789ÄÖÜabcdefghijklmnopqrstuwvxyzöäü"
;#jaPBeExt exit
Procedure.s CharChg(CC_Base$, CC_Such$, CC_Repl$, Mode = 0)
Protected Base$, pos.l, Such$
CharChg_Cnt = 0
If Mode&1 : CharChg_noCase = 1 : EndIf
If Mode&2 : CharChg_Word = 1 : EndIf
If CC_Such$>""
charChg_suchen:
If CharChg_noCase
Base$ = CC_Base$ : Such$ = CC_Such$
pos = FindString(PeekS(CharLower_(Base$)), PeekS(CharLower_(Such$)), pos + 1)
Else : pos = FindString(CC_Base$, CC_Such$, pos + 1)
EndIf
If pos
If CharChg_Word
; Debug "WordSuch [" + CC_Such$ + "] in [" + CC_Base$ + "]"
; Debug "pre=[" + Mid(" " + CC_Base$, Pos, 1) + "], post=[" + Mid(CC_Base$ + " ", Pos + Len(CC_Such$), 1) + "]"
If FindString(#CharChg_WordChars, Mid(" " + CC_Base$, pos, 1), 1)Or FindString(#CharChg_WordChars, Mid(CC_Base$ + " ", pos + Len(CC_Such$), 1), 1)
pos + 1
Goto charChg_suchen
EndIf
EndIf
CC_Base$ = Left(CC_Base$, pos - 1) + CC_Repl$ + Mid(CC_Base$, pos + Len(CC_Such$), 99999)
CharChg_Cnt = CharChg_Cnt + 1
pos + Len(CC_Repl$) - Len(CC_Such$)
Goto charChg_suchen
EndIf
EndIf
CharChg_noCase = 0 : CharChg_Word = 0
ProcedureReturn CC_Base$
EndProcedure
;========== Ende Modul "CharChg.PBI" ==========
;#jaPBeExt exit
Procedure.s Wort(*Param)
Protected Param$, Wort$
If * Param>1
Param$ = LTrim(PeekS(*Param))
If Wort_Ende$ = ""
If Wort_Klammer$ = ""
Wort_Klammer$ = #DQUOTE$ + Chr(39) + Chr(180) + Chr(255) + Chr(160) ;", ', ´ 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
While Left(Param$, 1)<>Wort_Ende$ And Param$>""
Wort$ + Left(Param$, 1)
Param$ = Mid(Param$, 2)
Wend
Wort$ = LTrim(CharChg(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
;========== Ende Modul "Wort.PBI" ==========
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
RegistryWrite(Win_RegBase$, Win_RegKey$, WinData$)
EndProcedure
Procedure Win_Upd_Limits() ;- Fenster-Größe / -Position prüfen (innerhalb Monitor ?)
Win_B = min(Desk_SizeX-Win_X,max(Win_MinB, Win_B))
Win_T = min(Desk_SizeY-Win_Y,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 Win_Upd_Flag, Init$, 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$)
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_State = Val(Init$)
Else ;Erstlauf: FensterMittige Anfordnung
#Part=10
If Win_MinB<ScrSize_X/#Part : Win_MinB=ScrSize_X/#Part : EndIf
If Win_MinT<ScrSize_y/#Part : Win_MinT=ScrSize_y/#Part : EndIf
Win_B=Win_MinB
Win_T=Win_MinT
Win_X=(ScrSize_X-Win_B)/2
Win_Y=(ScrSize_y-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) --> /!\ !!! Baustelle !!! /!\
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
Win_Stack$ = Str(WinUpd_WinNr) + " " + Str(Win_X) + " " + Str(Win_Y) + " " + Str(Win_B) + " " + Str(Win_T) + " " + Str(Win_State) + " " + Str(Win_MinB) + " " + Str(Win_MinT) + " " + 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$))
If IsWindow(WinUpd_WinNr)
SetActiveWindow(WinUpd_WinNr)
ResizeWindow(WinUpd_WinNr, Win_X, Win_Y, Win_B, Win_T)
Win_Upd(6) ;Windows-Status reaturieren
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$
Win_MinB = GetSystemMetrics_(#SM_CXSCREEN) / 3
Win_MinT = GetSystemMetrics_(#SM_CYSCREEN) / 2
Win_Upd(1) ;holt FensterDaten (x/y, Bxh) aus Registry
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, "javascript:evaltF()");anmelde-Button drücken --> !!! mal variabliliseren !!!
WebgadgetBusy(WebGad);auf Laden der Folgeseite warten
If #Debug_WebGad
Debug "Result = " + GetGadgetText(WebGad)
Debug "Ok-URL = " + URL_ok$
EndIf
If Win_Upd(20)
ResizeGadget(WebGad, 0, 0, WindowWidth(WinNr), WindowHeight(WinNr))
EndIf
If UCase(GetGadgetText(WebGad))<>UCase(URL_ok$);Name / Passwort falsch:
HideWindow(WinNr, 0) ;bisher unsichtbares Fenster anzeigen und Name und Passwort abfragen
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) ;Fenster-Pos & -Size in Registry speichern
HideWindow(WinNr, 1);Fenster bleibt offen (AutoLogoff needet!!!)
EndProcedure
;==========< Auswertung >==========
; 1255 Zeilen
; 51572 Bytes
; 13 Module