■ Il va falloir toucher à la base de registre : La taille de la barre des taches se lit (ou pas) dans la valeur TaskBarSi depuis l'emplacement Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced de la base de registre.
■ Les valeurs sont les suivantes :
0 : Petite taille (par défaut)
1 : Taille moyenne
2 : Grande taille
■ A chaque modification, il faut redémarrer le système d'exploitation pour voir le résultat.
Le code ci dessous va vous permettre de choisir une de ces tailles, de l'enregistrer dans la base de registre de votre systeme d'exploitation et de redémarrer celui-ci.
TaskBarSize.pb
Code : Tout sélectionner
; TaskBarSize V1.0
;
EnableExplicit
Enumeration window
#mf
EndEnumeration
Enumeration gadget
#mfTaskBarSize0
#mfTaskBarSize1
#mfTaskBarSize2
#mfValid
EndEnumeration
;Sommaire
Declare Start()
Declare Apply()
Declare Exit()
IncludeFile "Registry.pbi" : UseModule Registry
IncludeFile "DitchWindows.pbi"
Start()
Procedure Start()
Protected RegValue
OpenWindow(#mf, 0, 0, 260, 200, "TaskBar Size", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
OptionGadget(#mfTaskBarSize0, 30, 20, 200, 20, "Taille normal (Par défaut)")
OptionGadget(#mfTaskBarSize1, 30, 40, 200, 20, "Taille moyenne")
OptionGadget(#mfTaskBarSize2, 30, 60, 200, 20, "Grande taille")
TextGadget(#PB_Any, 30, 90, 200, 60, "Le résultat sera visible après redémarrage de votre système d'exploitation.", #PB_Text_Center)
ButtonGadget(#mfValid, 30, 160, 200, 24, "Appliquer")
; Lecture de la taille actuelle
; La valeur rechercher n'existe peut etre pas. Ca n'a pas d'importance
RegValue = Val(ReadValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced", "TaskBarSi"))
SetGadgetState(RegValue, #True)
; Déclencheur
BindGadgetEvent(#mfTaskBarSize0, @Apply())
BindGadgetEvent(#mfTaskBarSize1, @Apply())
BindGadgetEvent(#mfTaskBarSize2, @Apply())
BindGadgetEvent(#mfValid, @Apply())
BindEvent(#PB_Event_CloseWindow, @Exit())
; Loop
Repeat : WaitWindowEvent(1000) : ForEver
EndProcedure
Procedure Apply()
Static Value
If EventGadget() <> #mfValid
;Mémorisation taille barre des taches (0, 1 ou 2
Value = EventGadget()
Else
;Clic sur le bouton Apply
;Enregistrement base de registre
DeleteValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced", "TaskBarSi")
WriteValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced", "TaskBarSi", Str(Value), #REG_DWORD)
If MessageRequester("Information", "Voulez vous redémarrer votre système d'exploitation ? ", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
Reboot(#True)
EndIf
EndIf
EndProcedure
Procedure Exit()
End
EndProcedure
Registry.pbi de ts-soft
Code : Tout sélectionner
;======================================================================
; Module: Registry.pbi
;
; Author: Thomas (ts-soft) Schulz
; Date: Feb 25, 2017
; Version: 1.5.2
; Target Compiler: PureBasic 5.2+
; Target OS: Windows
; License: Free, unrestricted, no warranty whatsoever
; Use at your own risk
;======================================================================
; History:
; Version 1.5.2, Feb 25, 2017 (by Thunder93)
; fixed ListSubKey() to work under ASCII mode
; Version 1.5.1, May 27, 2016 (by HeX0R)
; fixed ExpandEnvironmentStrings()
; + CopyTree()
; Version 1.5.0, Sep 04, 2015
; fixed for Use with PB5.40 and higher
; Version 1.4.2, Jun 27, 2014
; fixed WriteValue
; Version 1.4.1, Sep 02, 2013
; fixed XP_DeleteTree()
; Version 1.4, Sep 02, 2013
; fixed Clear Resultstructure
; + compatibility to WinXP
; Version 1.3.3, Sep 01, 2013
; + Clear Resultstructure
; Version 1.3.2, Aug 31, 2013
; fixed a Bug with WriteValue and Unicode
; Version 1.3.1, Aug 30, 2013
; + DeleteTree() ; Deletes the subkeys and values of the specified key recursively.
; Version 1.3, Aug 30, 2013
; + ErrorString to RegValue Structure
; + RegValue to all Functions
; RegValue holds Errornumber and Errorstring!
; Renamed CountValues to CountSubValues
; Version 1.2.1, Aug 25, 2013
; source length reduced with macros
; Version 1.2, Aug 25, 2013
; + CountSubKeys()
; + CountValues()
; + ListSubKey()
; + ListSubValue()
; + updated example
;
; Version 1.1, Aug 25, 2013
; + ReadValue for #REG_BINARY returns a comma separate string with hexvalues (limited to 2096 bytes)
; + small example
DeclareModule Registry
Structure RegValue
TYPE.l ; like: #REG_BINARY, #REG_DWORD ...
SIZE.l
ERROR.l
ERRORSTR.s
DWORD.l ; #REG_DWORD
QWORD.q ; #REG_QWORD
*BINARY ; #REG_BINARY
STRING.s ; #REG_EXPAND_SZ, #REG_MULTI_SZ, #REG_SZ
EndStructure
Enumeration - 1 Step - 1
#REG_ERR_ALLOCATE_MEMORY
#REG_ERR_BINARYPOINTER_MISSING
#REG_ERR_REGVALUE_VAR_MISSING
EndEnumeration
Declare.i ReadType(topKey, ; like #HKEY_LOCAL_MACHINE, #HKEY_CURRENT_USER, #HKEY_CLASSES_ROOT ...
KeyName.s, ; KeyName without topKey
ValueName.s = "", ; ValueName, "" for Default
WOW64 = #False, ; If #TRUE, uses the 'Wow6432Node' path for Key
*Ret.RegValue = 0)
; result 0 = error or #REG_NONE (not supported)
Declare.s ReadValue(topKey,
KeyName.s,
ValueName.s = "",
WOW64 = #False,
*Ret.RegValue = 0)
; result "" = error
Declare.i WriteValue(topKey,
KeyName.s,
ValueName.s,
Value.s, ; Value as string
Type.l, ; Type like: #REG_DWORD, #REG_EXPAND_SZ, #REG_SZ
WOW64 = #False,
*Ret.RegValue = 0) ; to return more infos, is required for #REG_BINARY!
; result 0 = error, > 0 = successfull (1 = key created, 2 = key opened)
Declare.i DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
; Deletes the subkeys and values of the specified key recursively.
; result 0 = error
Declare.i DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
; result 0 = error
Declare.i DeleteValue(topKey, KeyName.s, ValueName.s, WOW64 = #False, *Ret.RegValue = 0)
; result 0 = error
Declare.i CountSubKeys(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Declare.i CountSubValues(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Declare.s ListSubKey(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0) ; the index is 0-based!
Declare.s ListSubValue(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)
Declare.i CopyTree(topKeySource, KeyNameSource.s, topKeyDestination, KeyNameDestination.s, WOW64 = #False, *Ret.RegValue = 0)
EndDeclareModule
Module Registry
EnableExplicit
Prototype RegDeleteKey(hKey.i, lpSubKey.p-Unicode, samDesired.l, Reserved.l = 0)
Prototype RegSetValue(hKey.i, lpValueName.p-Unicode, Reserved.l, dwType.l, *lpData, cbData.l)
Prototype RegDeleteTree(hKey.i, lpSubKey.p-Unicode = 0)
Prototype RegEnumKeyEx(hKey.i, dwIndex.l, *lpName, *lpcName, *lpReserved, *lpClass, *lpcClass, *lpftLastWriteTime)
Prototype RegCopyTree(hKeySrc.i, *lpSubKey, hKeyDest.i)
Global RegDeleteKey.RegDeleteKey
Global RegSetValue.RegSetValue
Global RegDeleteTree.RegDeleteTree
Global RegEnumKeyEx.RegEnumKeyEx
Global RegCopyTree.RegCopyTree
Define dll.i
dll = OpenLibrary(#PB_Any, "Advapi32.dll")
If dll
RegDeleteKey = GetFunction(dll, "RegDeleteKeyExW")
RegSetValue = GetFunction(dll, "RegSetValueExW")
RegDeleteTree = GetFunction(dll, "RegDeleteTreeW")
RegEnumKeyEx = GetFunction(dll, "RegEnumKeyExW")
RegCopyTree = GetFunction(dll, "RegCopyTreeW")
EndIf
#KEY_WOW64_64KEY = $100
#KEY_WOW64_32KEY = $200
Macro OpenKey()
If WOW64
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
samDesired | #KEY_WOW64_64KEY
CompilerElse
samDesired | #KEY_WOW64_32KEY
CompilerEndIf
EndIf
If Left(KeyName, 1) = "\" : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1) : EndIf
If *Ret <> 0
ClearStructure(*Ret, RegValue)
EndIf
error = RegOpenKeyEx_(topKey, KeyName, 0, samDesired, @hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
If hKey
RegCloseKey_(hKey)
EndIf
ProcedureReturn #False
EndIf
EndMacro
Macro OpenKeyS()
If WOW64
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
samDesired | #KEY_WOW64_64KEY
CompilerElse
samDesired | #KEY_WOW64_32KEY
CompilerEndIf
EndIf
If Left(KeyName, 1) = "\" : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1) : EndIf
If *Ret <> 0
ClearStructure(*Ret, RegValue)
EndIf
error = RegOpenKeyEx_(topKey, KeyName, 0, samDesired, @hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
If hKey
RegCloseKey_(hKey)
EndIf
ProcedureReturn ""
EndIf
EndMacro
Procedure.s GetLastErrorStr(error)
Protected Buffer.i, result.s
If FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER | #FORMAT_MESSAGE_FROM_SYSTEM, 0, error, 0, @Buffer, 0, 0)
result = PeekS(Buffer)
LocalFree_(Buffer)
ProcedureReturn result
EndIf
EndProcedure
Procedure.i XP_DeleteTree(topKey, KeyName.s, *Ret.RegValue = 0)
Protected hKey, error, dwSize.l, sBuf.s = Space(260)
If Left(KeyName, 1) = "\" : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1) : EndIf
If *Ret <> 0
ClearStructure(*Ret, RegValue)
EndIf
error = RegOpenKeyEx_(topKey, KeyName, 0, #KEY_ENUMERATE_SUB_KEYS, @hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
If hKey
RegCloseKey_(hKey)
EndIf
ProcedureReturn #False
EndIf
Repeat
dwSize.l = 260
error = RegEnumKeyEx(hKey, 0, @sBuf, @dwSize, 0, 0, 0, 0)
If Not error
XP_DeleteTree(hKey, sBuf)
EndIf
Until error
RegCloseKey_(hKey)
error = RegDeleteKey_(topKey, KeyName)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure.i DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_ALL_ACCESS
Protected hKey
If RegDeleteTree = 0
ProcedureReturn XP_DeleteTree(topKey, KeyName, *Ret)
EndIf
OpenKey()
error = RegDeleteTree(hKey)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure.i CopyTree(topKeySource, KeyNameSource.s, topKeyDestination, KeyNameDestination.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired, create
Protected hKey, hKeyD, topKey, KeyName.s
If OSVersion() < #PB_OS_Windows_Vista
ProcedureReturn #False
EndIf
topKey = topKeySource
KeyName = KeyNameSource
samDesired = #KEY_READ
OpenKey()
If hKey
error = RegCreateKeyEx_(topKeyDestination, KeyNameDestination, 0, #Null$, 0, #KEY_ALL_ACCESS, 0, @hKeyD, @create)
If hKeyD
error = RegCopyTree(hKey, #Null, hKeyD)
RegCloseKey_(hKeyD)
EndIf
RegCloseKey_(hKey)
EndIf
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure.i DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_WRITE
If WOW64
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
samDesired | #KEY_WOW64_64KEY
CompilerElse
samDesired | #KEY_WOW64_32KEY
CompilerEndIf
EndIf
If Left(KeyName, 1) = "\" : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1) : EndIf
If RegDeleteKey
error = RegDeleteKey(topKey, KeyName, samDesired)
Else
error = RegDeleteKey_(topKey, KeyName)
EndIf
If error
If *Ret <> 0
ClearStructure(*Ret, RegValue)
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure.i DeleteValue(topKey, KeyName.s, ValueName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_WRITE
Protected hKey
OpenKey()
error = RegDeleteValue_(hKey, ValueName)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure.i CountSubKeys(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ
Protected hKey, count
OpenKey()
error = RegQueryInfoKey_(hKey, 0, 0, 0, @count, 0, 0, 0, 0, 0, 0, 0)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
ProcedureReturn #False
EndIf
ProcedureReturn count
EndProcedure
Procedure.s ListSubKey(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ
Protected hKey, size, result.s
OpenKeyS()
error = RegQueryInfoKey_(hKey, 0, 0, 0, 0, @size, 0, 0, 0, 0, 0, 0)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
RegCloseKey_(hKey)
ProcedureReturn ""
EndIf
size + 1
result = Space(size)
error = RegEnumKeyEx_(hKey, index, @result, @size, 0, 0, 0, 0)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
ProcedureReturn ""
EndIf
ProcedureReturn result
EndProcedure
Procedure.i CountSubValues(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ
Protected hKey, count
OpenKey()
error = RegQueryInfoKey_(hKey, 0, 0, 0, 0, 0, 0, @count, 0, 0, 0, 0)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
ProcedureReturn #False
EndIf
ProcedureReturn count
EndProcedure
Procedure.s ListSubValue(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ
Protected hKey, size, result.s
OpenKeyS()
error = RegQueryInfoKey_(hKey, 0, 0, 0, 0, 0, 0, 0, @size, 0, 0, 0)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
RegCloseKey_(hKey)
ProcedureReturn ""
EndIf
size + 1
result = Space(size)
error = RegEnumValue_(hKey, index, @result, @size, 0, 0, 0, 0)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
ProcedureReturn ""
EndIf
ProcedureReturn result
EndProcedure
Procedure.i ReadType(topKey, KeyName.s, ValueName.s = "", WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ
Protected hKey, lpType
OpenKey()
error = RegQueryValueEx_(hKey, ValueName, 0, @lpType, 0, 0)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
ProcedureReturn #False
EndIf
ProcedureReturn lpType
EndProcedure
Procedure.s ReadValue(topKey, KeyName.s, ValueName.s = "", WOW64 = #False, *Ret.RegValue = 0)
Protected error, result.s, samDesired = #KEY_READ
Protected hKey, lpType.l, *lpData, lpcbData.l, ExSZlength, *ExSZMem, i
OpenKeyS()
error = RegQueryValueEx_(hKey, ValueName, 0, 0, 0, @lpcbData)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
RegCloseKey_(hKey)
ProcedureReturn ""
EndIf
If lpcbData
*lpData = AllocateMemory(lpcbData)
If *lpData = 0
If *Ret <> 0
*Ret\ERROR = #REG_ERR_ALLOCATE_MEMORY
*Ret\ERRORSTR = "Error: Can't allocate memory"
EndIf
Debug "Error: Can't allocate memory"
RegCloseKey_(hKey)
ProcedureReturn ""
EndIf
EndIf
error = RegQueryValueEx_(hKey, ValueName, 0, @lpType, *lpData, @lpcbData)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
FreeMemory(*lpData)
ProcedureReturn ""
EndIf
If *Ret <> 0
*Ret\TYPE = lpType
EndIf
Select lpType
Case #REG_BINARY
If lpcbData <= 2096
For i = 0 To lpcbData - 1
result + "$" + RSet(Hex(PeekA(*lpData + i)), 2, "0") + ","
Next
Else
For i = 0 To 2095
result + "$" + RSet(Hex(PeekA(*lpData + i)), 2, "0") + ","
Next
EndIf
result = Left(result, Len(result) - 1)
If *Ret <> 0
*Ret\BINARY = *lpData
*Ret\SIZE = lpcbData
EndIf
ProcedureReturn result ; we don't free the memory!
Case #REG_DWORD
If *Ret <> 0
*Ret\DWORD = PeekL(*lpData)
*Ret\SIZE = SizeOf(Long)
EndIf
result = Str(PeekL(*lpData))
Case #REG_EXPAND_SZ
ExSZlength = ExpandEnvironmentStrings_(*lpData, 0, 0)
If ExSZlength > 0
ExSZlength + 1
CompilerIf #PB_Compiler_Unicode
ExSZlength * 2
CompilerEndIf
*ExSZMem = AllocateMemory(ExSZlength)
If *ExSZMem
If ExpandEnvironmentStrings_(*lpData, *ExSZMem, ExSZlength)
result = PeekS(*ExSZMem, ExSZlength)
If *Ret <> 0
*Ret\STRING = result
*Ret\SIZE = Len(result)
EndIf
EndIf
FreeMemory(*ExSZMem)
EndIf
Else
Debug "ErrOr: Can't allocate memory"
EndIf
Case #REG_MULTI_SZ
While i < lpcbData
If PeekS(*lpData + i, 1) = ""
result + #LF$
Else
result + PeekS(*lpData + i, 1)
EndIf
i + SizeOf(Character)
Wend
If Right(result, 1) = #LF$
result = Left(result, Len(result) - 1)
EndIf
If *Ret <> 0
*Ret\STRING = result
*Ret\SIZE = Len(result)
EndIf
Case #REG_QWORD
If *Ret <> 0
*Ret\QWORD = PeekQ(*lpData)
*Ret\SIZE = SizeOf(Quad)
EndIf
result = Str(PeekQ(*lpData))
Case #REG_SZ
result = PeekS(*lpData)
If *Ret <> 0
*Ret\STRING = result
*Ret\SIZE = Len(result)
EndIf
EndSelect
FreeMemory(*lpData)
ProcedureReturn result
EndProcedure
Procedure.i WriteValue(topKey, KeyName.s, ValueName.s, Value.s, Type.l, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_WRITE
Protected hKey, *lpData, lpcbData.q, count, create, i, tmp.s, pos, temp1.l, temp2.q
If WOW64
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
samDesired | #KEY_WOW64_64KEY
CompilerElse
samDesired | #KEY_WOW64_32KEY
CompilerEndIf
EndIf
If Left(KeyName, 1) = "\" : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1) : EndIf
If *Ret <> 0
If Type <> #REG_BINARY
ClearStructure(*Ret, RegValue)
Else
*Ret\TYPE = 0
*Ret\ERROR = 0
*Ret\ERRORSTR = ""
*Ret\DWORD = 0
*Ret\QWORD = 0
*Ret\STRING = ""
EndIf
EndIf
error = RegCreateKeyEx_(topKey, KeyName, 0, #Null$, 0, samDesired, 0, @hKey, @create)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
If hKey
RegCloseKey_(hKey)
EndIf
ProcedureReturn #False
EndIf
Select Type
Case #REG_BINARY
If *Ret = 0
If *Ret <> 0
*Ret\ERROR = #REG_ERR_REGVALUE_VAR_MISSING
*Ret\ERRORSTR = "Error: Required *Ret.RegValue parameter not found!"
EndIf
Debug "Error: Required *Ret.RegValue parameter not found!"
RegCloseKey_(hKey)
ProcedureReturn #False
EndIf
lpcbData = *Ret\SIZE
*lpData = *Ret\BINARY
If *lpData = 0
If *Ret <> 0
*Ret\ERROR = #REG_ERR_BINARYPOINTER_MISSING
*Ret\ERRORSTR = "Error: No Pointer to BINARY defined!"
EndIf
Debug "Error: No Pointer to BINARY defined!"
RegCloseKey_(hKey)
ProcedureReturn #False
EndIf
If lpcbData = 0
lpcbData = MemorySize(*lpData)
EndIf
error = RegSetValueEx_(hKey, ValueName, 0, #REG_BINARY, *lpData, lpcbData)
Case #REG_DWORD
temp1 = Val(Value)
error = RegSetValueEx_(hKey, ValueName, 0, #REG_DWORD, @temp1, 4)
Case #REG_QWORD
temp2 = Val(Value)
error = RegSetValueEx_(hKey, ValueName, 0, #REG_QWORD, @temp2, 8)
Case #REG_EXPAND_SZ, #REG_SZ
error = RegSetValueEx_(hKey, ValueName, 0, Type, @Value, StringByteLength(Value) + SizeOf(Character))
Case #REG_MULTI_SZ
count = CountString(Value, #LF$)
For i = 0 To count
tmp = StringField(Value, i + 1, #LF$)
lpcbData + StringByteLength(tmp, #PB_Unicode) + 2
Next
If lpcbData
*lpData = AllocateMemory(lpcbData)
If *lpData
For i = 0 To count
tmp = StringField(Value, i + 1, #LF$)
PokeS(*lpData + pos, tmp, -1, #PB_Unicode)
pos + StringByteLength(tmp, #PB_Unicode) + 2
Next
error = RegSetValue(hKey, ValueName, 0, Type, *lpData, lpcbData)
FreeMemory(*lpData)
Else
If *Ret <> 0
*Ret\ERROR = #REG_ERR_ALLOCATE_MEMORY
*Ret\ERRORSTR = "Error: Can't allocate memory"
EndIf
Debug "Error: Can't allocate memory"
RegCloseKey_(hKey)
ProcedureReturn #False
EndIf
EndIf
EndSelect
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
Debug GetLastErrorStr(error)
ProcedureReturn #False
EndIf
ProcedureReturn create
EndProcedure
EndModule
Code : Tout sélectionner
; Contributor : Psychophanta
; Source : https://www.purebasic.fr/english/viewtopic.php?p=186993#p186993
Structure NEW_LUID_AND_ATTRIBUTES
pLuid.LUID
Attributes.l
EndStructure
Structure NEW_TOKEN_PRIVILEGES
PrivilegeCount.l
Privileges.NEW_LUID_AND_ATTRIBUTES[#ANYSIZE_ARRAY]
EndStructure
Procedure DitchWindows(flags)
Protected os.OSVERSIONINFO:os\dwOSVersionInfoSize=SizeOf(OSVERSIONINFO)
Protected token
Protected tkp.NEW_TOKEN_PRIVILEGES
GetVersionEx_(os)
If os\dwPlatformId=#VER_PLATFORM_WIN32_NT
If OpenProcessToken_(GetCurrentProcess_(),#TOKEN_ADJUST_PRIVILEGES|#TOKEN_QUERY,@token)
If LookupPrivilegeValue_(#Null,"SeShutdownPrivilege", tkp\Privileges[0]\pLuid)
tkp\PrivilegeCount=1
tkp\Privileges[0]\Attributes=#SE_PRIVILEGE_ENABLED
If AdjustTokenPrivileges_(token,#False,tkp,#Null,#Null,#Null)
If ExitWindowsEx_(flags,0)=0:ProcedureReturn 4:EndIf
Else:ProcedureReturn 3
EndIf
Else:ProcedureReturn 2
EndIf
Else:ProcedureReturn 1
EndIf
Else
If ExitWindowsEx_(flags,0)=0
ProcedureReturn 4
EndIf
EndIf
EndProcedure
Procedure Reboot(force=0)
If force:force=#EWX_FORCE:EndIf
DitchWindows(#EWX_LOGOFF|#EWX_REBOOT|force)
EndProcedure
Procedure ShutDown(force=0)
If force:force=#EWX_FORCE:EndIf
DitchWindows(#EWX_LOGOFF|#EWX_SHUTDOWN|force)
EndProcedure
Procedure PowerOff(force=0)
If force:force=#EWX_FORCE:EndIf
DitchWindows(#EWX_LOGOFF|#EWX_POWEROFF|force)
EndProcedure
