Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Chat biutente (Client) - module2.bas

module2.bas

Caricato da: Roberto VB
Scarica il programma completo

  1. Attribute VB_Name = "Module2"
  2. Option Explicit
  3.  
  4. ' Attribute VB_Name = "RegStuff"
  5.  
  6. Global Const REG_SZ As Long = 1
  7. Global Const REG_DWORD As Long = 4
  8.  
  9. Global Const HKEY_CLASSES_ROOT = &H80000000
  10. Global Const HKEY_CURRENT_USER = &H80000001
  11. Global Const HKEY_LOCAL_MACHINE = &H80000002
  12. Global Const HKEY_USERS = &H80000003
  13.  
  14. Global Const ERROR_NONE = 0
  15. Global Const ERROR_BADDB = 1
  16. Global Const ERROR_BADKEY = 2
  17. Global Const ERROR_CANTOPEN = 3
  18. Global Const ERROR_CANTREAD = 4
  19. Global Const ERROR_CANTWRITE = 5
  20. Global Const ERROR_OUTOFMEMORY = 6
  21. Global Const ERROR_INVALID_PARAMETER = 7
  22. Global Const ERROR_ACCESS_DENIED = 8
  23. Global Const ERROR_INVALID_PARAMETERS = 87
  24. Global Const ERROR_NO_MORE_ITEMS = 259
  25.  
  26. Global Const KEY_ALL_ACCESS = &H3F
  27.  
  28. Global Const REG_OPTION_NON_VOLATILE = 0
  29.  
  30. Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  31. Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
  32. Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
  33. Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
  34. Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
  35. Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
  36. Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
  37. Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
  38. Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
  39. Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
  40.  
  41. Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
  42. Dim lRetVal As Long
  43. Dim hKey As Long
  44. lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
  45. End Function
  46.  
  47. Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
  48. Dim lRetVal As Long
  49. Dim hKey As Long
  50. lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  51. lRetVal = RegDeleteValue(hKey, sValueName)
  52. RegCloseKey (hKey)
  53. End Function
  54.  
  55. Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
  56. Dim lValue As Long
  57. Dim sValue As String
  58. Select Case lType
  59. Case REG_SZ
  60. sValue = vValue
  61. SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
  62. Case REG_DWORD
  63. lValue = vValue
  64. SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
  65. End Select
  66. End Function
  67. Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
  68. Dim cch As Long
  69. Dim lrc As Long
  70. Dim lType As Long
  71. Dim lValue As Long
  72. Dim sValue As String
  73.  
  74. On Error GoTo QueryValueExError
  75. lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
  76. If lrc <> ERROR_NONE Then Error 5
  77. Select Case lType
  78. Case REG_SZ:
  79. sValue = String(cch, 0)
  80. lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
  81. If lrc = ERROR_NONE Then
  82. vValue = Left$(sValue, cch)
  83. Else
  84. vValue = Empty
  85. End If
  86. Case REG_DWORD:
  87. lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
  88. If lrc = ERROR_NONE Then vValue = lValue
  89. Case Else
  90. lrc = -1
  91. End Select
  92. QueryValueExExit:
  93. QueryValueEx = lrc
  94. Exit Function
  95. QueryValueExError:
  96. Resume QueryValueExExit
  97. End Function
  98. Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
  99. Dim hNewKey As Long
  100. Dim lRetVal As Long
  101.  
  102. lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
  103. RegCloseKey (hNewKey)
  104. End Function
  105. Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
  106. Dim lRetVal As Long
  107. Dim hKey As Long
  108. lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  109. lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
  110. RegCloseKey (hKey)
  111. End Function
  112.  
  113. Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
  114. Dim lRetVal As Long
  115. Dim hKey As Long
  116. Dim vValue As Variant
  117. lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
  118. lRetVal = QueryValueEx(hKey, sValueName, vValue)
  119. QueryValue = vValue
  120. RegCloseKey (hKey)
  121. End Function
  122. Public Sub ShowAtStartup(yourexe$)
  123. Dim pth$
  124. pth$ = App.Path
  125. If Mid$(pth$, Len(pth$), 1) = "\" Then
  126. pth$ = pth$ + yourexe$
  127. Else
  128. pth$ = pth$ + "\" + yourexe$
  129. End If
  130. SetKeyValue HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\", yourexe$, pth$, REG_SZ
  131. End Sub
  132. Public Sub DontShowAtStartup(yourexe$)
  133. DeleteValue HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\", yourexe$
  134. End Sub