本帖最后由 WHY 于 2020-7-4 21:35 编辑
- Rem 将Binary类型的注册表数据写入到指定的注册表,注册表项通过搜索关键字得到。
- const Data = "0200000036E79387633AD60100000000434201000A0A00D0" '一长串Binary类型的注册表数据
- const HKCU = &H80000001
-
- Dim regPath, keyWord, objWMI
- regPath = "HKCU\Software\Microsoft\Windows\CurrentVersion"
- keyWord = "$start.tilegrid$windows.data.curatedtilecollection.tilecollection"
- Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\Root\Default:StdRegProv")
-
- Function GetRegistryKey(regPath, keyWord)
- Dim ws, objExec, strLine
- Set ws = CreateObject("WScript.Shell")
- Set objExec = ws.Exec( "reg query " & chr(34) & regPath & chr(34) & " /s /k /f " & chr(34) & keyWord & chr(34) )
- while objExec.status < 1
- WScript.Sleep 200
- wend
- GetRegistryKey = ""
- Do while Not objExec.StdOut.AtEndOfStream
- strLine = objExec.StdOut.ReadLine
- If UCase(Left(strLine, 17)) = "HKEY_CURRENT_USER" Then
- GetRegistryKey = Mid(strLine, 19)
- Exit Do
- End If
- Loop
- End Function
-
- Function SetRegistryValue(regSubPath, ByRef arrData)
- Dim arrName
- objWMI.EnumKey HKCU, regSubPath, arrName '遍历子项,参数:根, 子项路径, 子项名数组
- If Not IsArray(arrName) Then 'regSubPath不包含子项
- objWMI.CreateKey HKCU, regSubPath + "\Current" '创建子项,参数:根, 子项路径
- ElseIf Not Contains(arrName, "Current") Then 'regSubPath包含子项,但不包含Current子项
- objWMI.CreateKey HKCU, regSubPath + "\Current" '创建子项
- End If
- objWMI.SetBinaryValue HKCU, regSubPath + "\Current", "Data", arrData '写入注册表,参数:根,子项路径,值名,要写入的数据
- End Function
-
- Function Contains(arr, item)
- Dim i
- For i = 0 To UBound(arr)
- If LCase(arr(i)) = LCase(item) Then
- Contains = True : Exit Function
- End If
- Next
- Contains = False
- End Function
-
- Function ConvertData(Data)
- Dim i, count, s, arrData
- count = Len(Data) \ 2
- ReDim arrData(count - 1)
- For i = 1 To Len(Data) Step 2
- s = "&H" & Mid(Data, i, 2)
- arrData(i\2) = 1 * s
- Next
- ConvertData = arrData
- End Function
-
- Dim regSearchPath
- regSearchPath = GetRegistryKey(regPath, keyWord) '搜索包含关键字的注册表项路径
-
- If regSearchPath = "" Then
- MsgBox "No Such Registry Key Found"
- Else
- Call SetRegistryValue( regSearchPath, ConvertData(Data) )
- MsgBox "Done"
- End If
复制代码 改一点点小错误,顺便加一点注释 |