regUtil.vbs 7.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326
  1. ' TODO: consider incorporating a json writer of some sort instead of adhoc solution like the following
  2. ' e.g: http://demon.tw/my-work/vbs-json.html
  3. const HKEY_CLASSES_ROOT = &H80000000
  4. const HKEY_CURRENT_USER = &H80000001
  5. const HKEY_LOCAL_MACHINE = &H80000002
  6. const HKEY_USERS = &H80000003
  7. const HKEY_CURRENT_CONFIG = &H80000005
  8. Sub LoadRegistryImplementationByOSArchitecture()
  9. If IsNull(OSArchitecture) Then
  10. WriteLineErr "missing OSArchitecture global. did not call util.DetermineOSArchitecture? or Forgot to load util.vbs?"
  11. WScript.Quit 25125
  12. End If
  13. If OSArchitecture = "A" Then
  14. Include "ArchitectureAgnosticRegistry.vbs"
  15. Else
  16. Include "ArchitectureSpecificRegistry.vbs"
  17. End If
  18. End Sub
  19. Function PutValue(constHive, strSubKey, strValueName, strValue, strType)
  20. Select Case UCase(strType)
  21. Case "REG_SZ"
  22. PutValue = SetStringValue(constHive, strSubKey, strValueName, strValue)
  23. Case "REG_EXPAND_SZ"
  24. PutValue = SetExpandedStringValue(constHive, strSubKey, strValueName, strValue)
  25. Case "REG_BINARY"
  26. PutValue = SetBinaryValue(constHive, strSubKey, strValueName, ToBinaryValue(strValue))
  27. ' TODO: need to check that indeed int is the right type here
  28. Case "REG_DWORD"
  29. PutValue = SetDWORDValue(constHive, strSubKey, strValueName, CDbl(strValue))
  30. Case "REG_MULTI_SZ"
  31. PutValue = SetMultiStringValue(constHive, strSubKey, strValueName, Split(strValue, ","))
  32. Case "REG_QWORD"
  33. PutValue = SetQWORDValue(constHive, strSubKey, strValueName, strValue)
  34. Case "REG_DEFAULT"
  35. PutValue = SetStringValue(constHive, strSubKey, "", strValue)
  36. Case Else
  37. PutValue = SetStringValue(constHive, strSubKey, strValueName, strValue)
  38. End Select
  39. End Function
  40. ' render the child of a sub path strSubKey in hive constHive
  41. ' as json.
  42. Sub ListChildrenAsJson(constHive, strSubKey)
  43. Dim e1: e1 = EnumKey (constHive, strSubKey, arrKeyNames)
  44. If e1 <> 0 Then
  45. WScript.Quit e1
  46. End If
  47. Dim e2: e2 = EnumValues (constHive, strSubKey, arrValueNames, arrValueTypes)
  48. If e2 <> 0 Then
  49. WScript.Quit e2
  50. End If
  51. ' start outputting json to stdout
  52. Write "{"
  53. If Not IsNull(arrKeyNames) Then
  54. Write """keys"": ["
  55. For x = 0 To UBound(arrKeyNames)
  56. If (x > 0) Then
  57. Write ","
  58. End If
  59. Write """" & JsonSafe(arrKeyNames(x)) & """"
  60. Next
  61. Write "]"
  62. End If
  63. ' TODO: some duplicity of code between the two paths of this condition, this needs to be address at some point
  64. If Not IsNull(arrValueNames) Then
  65. If Not IsNull(arrKeyNames) Then
  66. Write ","
  67. End If
  68. Write """values"":{"
  69. For y = 0 To UBound(arrValueNames)
  70. If y > 0 Then
  71. Write ","
  72. End If
  73. strValueName = arrValueNames(y)
  74. intValueType = arrValueTypes(y)
  75. ' assign the value to varValue
  76. GetValueByType constHive, strSubKey, strValueName, intValueType, varValue
  77. WriteValue strValueName, intValueType, varValue
  78. Next
  79. Write "}"
  80. Else
  81. ' fix for keys with only default values in them
  82. ' see http://stackoverflow.com/questions/8840343/how-to-read-the-default-value-from-registry-in-vbscript
  83. GetStringValue constHive, strSubKey, "", strDefaultValue
  84. If IsNull(strDefaultValue) = false and strDefaultValue <> "" Then
  85. If Not IsNull(arrKeyNames) Then
  86. Write ","
  87. End If
  88. Write """values"":{"
  89. ' write the default value with REG_SZ
  90. WriteValue "", 1, strDefaultValue
  91. Write "}"
  92. End If
  93. End If
  94. Write "}"
  95. End Sub
  96. Sub WriteValue (strValueName, intValueType, varValue)
  97. Write """"
  98. Write JsonSafe(strValueName)
  99. Write """:{"
  100. Write """type"": """
  101. Write RenderType(intValueType)
  102. Write ""","
  103. Write """value"":"
  104. Write RenderValueByType(intValueType, varValue)
  105. Write "}"
  106. End Sub
  107. ' give a raw HKLM\something\somewhere
  108. ' output the hive constant and the subkey, in this case:
  109. ' HKEY_LOCAL_MACHINE will be assigned to outConstHive
  110. ' and something\somewhere will be assigned to outStrSubKey
  111. Sub ParseHiveAndSubKey(strRawKey, outConstHive, outStrSubKey)
  112. ' split into two parts to deduce the hive and the sub key
  113. arrSplitted = Split(strRawKey, "\", 2, 1)
  114. If UBound(arrSplitted) > 0 Then
  115. strHive = arrSplitted(0)
  116. outStrSubKey = arrSplitted(1)
  117. Else
  118. strHive = strRawKey
  119. outStrSubKey = ""
  120. End If
  121. outConstHive = StringToHiveConst(UCase(strHive))
  122. End Sub
  123. Function StringToHiveConst(strHive)
  124. Select Case strHive
  125. Case "HKCR"
  126. StringToHiveConst = HKEY_CLASSES_ROOT
  127. Case "HKCU"
  128. StringToHiveConst = HKEY_CURRENT_USER
  129. Case "HKLM"
  130. StringToHiveConst = HKEY_LOCAL_MACHINE
  131. Case "HKU"
  132. StringToHiveConst = HKEY_USERS
  133. Case "HKCC"
  134. StringToHiveConst = HKEY_CURRENT_CONFIG
  135. Case Else
  136. StringToHiveConst = Null
  137. End Select
  138. End Function
  139. ' TODO: this entire "by type" should be transformed into OOP style
  140. ' where each type will have a class with render(), getValue() etc...
  141. ' convert a value type number into a string label
  142. Function RenderType(intType)
  143. RenderType = "REG_UNKNOWN"
  144. Select Case intType
  145. Case 1
  146. RenderType = "REG_SZ"
  147. Case 2
  148. RenderType = "REG_EXPAND_SZ"
  149. Case 3
  150. RenderType = "REG_BINARY"
  151. Case 4
  152. RenderType = "REG_DWORD"
  153. Case 7
  154. RenderType = "REG_MULTI_SZ"
  155. Case 11
  156. RenderType = "REG_QWORD"
  157. Case Else
  158. ' TODO: should report / throw an error here
  159. WriteErr("invalid Registry Value Type " & intType)
  160. End Select
  161. End Function
  162. ' render by value type:
  163. ' string will return as a string with double quotes, e.g "value"
  164. ' multi string values which return as an array ot strings "["1", "2"]" (double quotes included ofc)
  165. ' numeric values like DWORD and QWORD just return as the number e.g. 1
  166. ' byte arrays such as reg_binary return as an array of ints, e.g [1,2,3]
  167. Function RenderValueByType(intType, varValue)
  168. Select Case intType
  169. ' REG_SZ
  170. Case 1
  171. RenderValueByType = """" & JsonSafe(varValue) & """"
  172. ' REG_EXPAND_SZ
  173. Case 2
  174. RenderValueByType = """" & JsonSafe(varValue) & """"
  175. ' REG_BINARY
  176. Case 3
  177. RenderValueByType = RenderByteArray(varValue)
  178. ' REG_DWORD
  179. Case 4
  180. RenderValueByType= varValue
  181. ' REG_MULYI_SZ'
  182. Case 7
  183. RenderValueByType = RenderStringArray(varValue)
  184. ' REG_QWORD
  185. Case 11
  186. RenderValueByType = varValue
  187. Case Else
  188. ' TODO: should report / throw an error here
  189. WriteErr("invalid Registry Value Type " & intType)
  190. End Select
  191. End Function
  192. ' get the value of a registry based on its value type and assign it to out parameter outVarValue
  193. Sub GetValueByType(constHive, strKey, strValueName, intType, outVarValue)
  194. Select Case intType
  195. ' REG_SZ
  196. Case 1
  197. GetStringValue constHive, strKey, strValueName, outVarValue
  198. Exit Sub
  199. ' REG_EXPAND_SZ
  200. Case 2
  201. GetExpandedStringValue constHive, strKey, strValueName, outVarValue
  202. Exit Sub
  203. ' REG_BINARY
  204. Case 3
  205. GetBinaryValue constHive, strKey, strValueName, outVarValue
  206. Exit Sub
  207. ' REG_DWORD
  208. Case 4
  209. GetDWORDValue constHive, strKey, strValueName, outVarValue
  210. ' #21 - VBS does not support UInt32. This is the workaround
  211. If outVarValue < 0 Then outVarValue = 4294967296 + outVarValue
  212. Exit Sub
  213. ' REG_MULYI_SZ'
  214. Case 7
  215. GetMultiStringValue constHive, strKey, strValueName, outVarValue
  216. Exit Sub
  217. ' REG_QWORD
  218. Case 11
  219. GetQWORDValue constHive, strKey, strValueName, outVarValue
  220. Exit Sub
  221. Case Else
  222. ' TODO: should report / throw an error here
  223. WriteErr("invalid Registry Value Type " & intType)
  224. End Select
  225. End Sub
  226. ' render a byte array as a json array of numbers
  227. Function RenderByteArray(arr)
  228. RenderByteArray = "[]"
  229. If Not IsNull(arr) Then
  230. RenderByteArray = "[" & Join(arr, ",") & "]"
  231. End If
  232. End Function
  233. ' render a string array as json string array
  234. Function RenderStringArray(arr)
  235. Result = "["
  236. If Not IsNull(arr) Then
  237. For t = 0 To UBound(arr)
  238. If (t > 0) Then
  239. Result = Result & ","
  240. End If
  241. Result = Result & """" & JsonSafe(arr(t)) & """"
  242. Next
  243. End If
  244. Result = Result & "]"
  245. RenderStringArray = Result
  246. End Function
  247. Function ToBinaryValue(strValue)
  248. arrValue = Split(strValue, ",")
  249. If IsNull(arrValue) Then
  250. ToBinaryValue = Array()
  251. Exit Function
  252. End If
  253. For i = 0 To UBound(arrValue)
  254. arrValue(i) = CInt(arrValue(i))
  255. Next
  256. ToBinaryValue = arrValue
  257. End Function