newxso
初级用户
l i u s s
积分 73
发帖 101
注册 2008-9-17
来自 GZ
状态 离线
|
 『楼 主』:
[转贴] Reg 转 Vbs
使用 LLM 解释/回答一下
'Reg2Vbs v1.5a
'Original Reg2Vbs v1.0 coded by Tim Mortimer
'Enhanced Reg2Vbs v1.5a by Denis St-Pierre (Ottawa, Canada)
'License: Public Domain
'
'Purpose: converts ALL reg files in current directory to VBS in one shot!
'OS: works in 2k and up
'Liability: Use at your own risk!
'
'v1.5 features:
'Handles REG_SZ, REG_DWORD, BINARY (U/A), MULTI-SZ, EXPAND_SZ and Default values (lines that start with @= )
'Handles Comments (lines that start with ;)
'Handles Comments at end of DWORD lines
'Handles values and data containing Chr(34), if encountered Chr(34) will be removed or processed (Default,REG_SZ) to prevent corrupt output file
'Adds blank line after each BINARY, MULTI-SZ, and EXPAND_SZ blocks (easier to read vbs)
'Handles deletion of keys or values using the "-" identifier
'UNsupported values are commented into VBS file
'v1.5 Limitations:
'Cannot handle comments at end of MULTI-SZ, BINARY and EXPAND_SZ lines (never will)
'Cannot handle @="\"c:\blabla\"" default values for some reason
'Cannot handle Hex values that end without ",00" or ",00,00"
'Cannot handle Key names containing Chr(34) NOTE: Key names with " are valid (see paper sizes in registry)
'CAVEAT:last line in REG file needs to be blank or else last line is ignored
'
'v1.0 Limitations:
'1 - Only HKEY_CLASSES_ROOT, HKEY_CURRENT_USER and HKEY_LOCAL_MACHINE root keys are supported
'2 - Only REG_SZ and REG_DWORD values are supported
'3 - Keys, values and data containing Chr(34) are not supported and, if encountered, will cause corrupt output file
'4 - Deletion of keys or values using the "-" identifier is not supported
'5 - Comments are not handled
Option Explicit
'Constant declarations
Const sDelim = "|"
Const ForReading = 1
Const TristateUseDefault = -2
const HKEY_LOCAL_MACHINE = &H80000002
'Global declarations
Dim FSO, g_KEY, g_Err, g_CurrentFile, g_long_HKEY
Set FSO = CreateObject("Scripting.FileSystemObject") 'Initialize the file system object
Dim sFiles
Dim nFiles
Dim i, bDoingMultiSZ, bUsingStdRegProv, strMultiValue, MultiValue
Dim bDoingBINARY, strBINARYValue,bDoingUnicode, strEXPANDSZValue, bDoingEXPANDSZ
'Add key - Set global key values
Dim l_HKEY, l_LenHKEY, l_SubKey
Dim g_Value
g_Err = "" 'Initialize global error object
'setting default values
bDoingBINARY=False
strBINARYValue=False
bDoingUnicode=False
'Get a list of reg files in the current directory and sort into an array
sFiles = Split(GetRegFiles, sDelim)
'Get number of files
nFiles = UBound(sFiles) - 1
'Loop through all files
For i = 0 To nFiles
'Set global current file
g_CurrentFile = sFiles(i)
MsgBox "Openning "&g_CurrentFile
'Convert the file
If (Not ConvertFile(g_CurrentFile)) Then
MsgBox "An error occurred while converting the file: " & sFiles(i), vbCritical, "Error - reg2vbs"
End If
Next
'create log file
If Len(g_Err) > 0 Then
MsgBox "Errors where encountered while converting the files. Check error.log for details", vbCritical, "Conversion Completed - Errors"
Dim hErrFile
Set hErrFile = FSO.CreateTextFile("error.log", True)
PrependLine g_Err, "Created: " & Now
PrependLine g_Err, "Reg2Vbs v1.5 Error Log"
PrependLine g_Err, "<-------------------- START ERROR LOG -------------------->"
AppendLine g_Err, "<--------------------- END ERROR LOG --------------------->"
hErrFile.Write g_Err
hErrFile.Close
Set hErrFile = Nothing
End If
MsgBox "All .reg files have been converted"
'Free thefile system object
Set FSO = Nothing
WScript.Quit
' ===================================================================
' ===================================================================
'
' FUNCTIONS Used
'
' ===================================================================
' ===================================================================
'Function IsRegFile(sFile)
'Checks for valid file extension
' IsRegFile = (LCase(FSO.GetExtensionName(sFile)) = "reg")
'End Function
Function GetRegFiles()
'Find all *.reg files in the current directory
Dim oDir
Dim oFile
Dim oFiles
Dim sCurrentDir
Dim sResult
'Get current directory
sCurrentDir = Left(WScript.ScriptFullName, Len(WScript.ScriptFullName) - Len(WScript.ScriptName))
'Obtain handle to directory
Set oDir = FSO.GetFolder(sCurrentDir)
'Retrieve list of files in current directory
Set oFiles = oDir.Files
For Each oFile In oFiles
'Check for valid extension
If LCase(FSO.GetExtensionName(oFile.Name)) = "reg" Then 'Checks for valid file extension
'Add reg filename to result
sResult = sResult & oFile.Path & sDelim
End If
Next
'Assign function return value
GetRegFiles = sResult
End Function
Function IsValidRegFile(sFirstLine)
'Checks for valid registry file
Dim Result
Select Case sFirstLine
Case "Windows Registry Editor Version 5.00"
'Windows 2000, XP
Result = True
Case "REGEDIT4"
'Windows 95, 98 ME
Result = True
Case Else
'Unknown registry file format
Result = False
End Select
IsValidRegFile = Result
End Function
Function ConvertFile(sFile)
'Converts the registry file to a vbscript file
Dim hRegFile
Dim hVBSFile
Dim sRegFile
Dim sVBSFile
Dim sVBSBuffer
'Initialize the buffer
sVBSBuffer = ""
'Open the file as for reading in default system format (ANSI or Unicode)
Set hRegFile = FSO.OpenTextFile(sFile, ForReading, False, TristateUseDefault)
'Read the file contents into the buffer
sRegFile = hRegFile.ReadAll
'Split the buffer into an vbCrLf delimitered array
sRegFile = Split(sRegFile, vbCrLf)
If IsValidRegFile(sRegFile(0)) Then 'if reg file is valid continue
'Create initial vbs code
AppendLine sVBSBuffer, "'VBScript Registry File created with Reg2VBS v1.5"
AppendLine sVBSBuffer, "'v1.0 Coded by Tim Mortimer"
AppendLine sVBSBuffer, "'v1.5 Coded by Denis St-Pierre (ottawa, Canada)"
AppendLine sVBSBuffer, "'Creation time: " & Now
AppendLine sVBSBuffer, ""
AppendLine sVBSBuffer, "Option Explicit"
'Add StdRegProv support in case of Binary, Multi_SZ values
AppendLine sVBSBuffer, "'Add StdRegProv support in case of Binary, Multi_SZ values"
AppendLine sVBSBuffer, "Dim objShell, strComputer, ArrOfValue, oReg"
AppendLine sVBSBuffer, "const HKEY_USERS = &H80000003"
AppendLine sVBSBuffer, "const HKEY_LOCAL_MACHINE = &H80000002"
AppendLine sVBSBuffer, "const HKEY_CURRENT_USER = &H80000001"
AppendLine sVBSBuffer, "HKEY_CLASSES_ROOT = &H80000000"
AppendLine sVBSBuffer, ""
AppendLine sVBSBuffer, "Set objShell = CreateObject(""WScript.Shell"")"
AppendLine sVBSBuffer, "strComputer = ""."""
AppendLine sVBSBuffer, "Set oReg=GetObject(""winmgmts:{impersonationLevel=impersonate}!\\"" & strComputer & ""\root\default:StdRegProv"") 'used for Binary, Multi_SZ values"
Dim sVBSLine
Dim i
For i = 1 to ubound(sRegFile) - 1 'Start at line 1 to avoid the header
'Check for blank lines
If Len(Trim(sRegFile(i))) > 0 Then
sVBSLine = ConvertLine(sRegFile(i)) 'Convert registry line into vbscript equivalent
AppendLine sVBSBuffer, sVBSLine 'Add converted line to sVBSBuffer
Else
'Blank line. Do nothing.
End If
Next
'Create the vbs filename
sVBSFile = Left(sFile, Len(sFile) - 3) & "vbs"
'Add trailing code
AppendLine sVBSBuffer, "Set objShell = Nothing"
AppendLine sVBSBuffer, "WScript.Quit"
'Write the file
Set hVBSFile = FSO.CreateTextFile(sVBSFile, True)
hVBSFile.Write sVBSBuffer
hVBSFile.Close
Set hVBSFile = Nothing
ConvertFile = True 'Return true
Else
'Not a valid registry file
'Add error to list
AddError "Invalid registry file: " & sFile
ConvertFile = False 'Return false
End If
hRegFile.Close 'Close the registry file
Set hRegFile = Nothing
End Function
Function GetHKEYValue(sHKEY)
'Translates the HKEY value to RegWrite compatible one
Select Case sHKEY
Case "HKEY_CLASSES_ROOT": GetHKEYValue = "HKCR"
Case "HKEY_CURRENT_USER": GetHKEYValue = "HKCU"
Case "HKEY_LOCAL_MACHINE": GetHKEYValue = "HKLM"
Case Else
AddError "Unknown HKEY value: " & sHKEY
GetHKEYValue = "Unknown HKEY value"
End Select
End Function
Function ConvertLine(sRegLine) 'Converts a registry file line into the vbscript equivalent
Dim sLine, Result
sLine = Trim(sRegLine) 'Remove spaces at begin and end of line
If Len(sLine) = 0 Then
MsgBox "ConvertLine - Len(sRegLine) = 0 - Shouldn't be here", vbCritical
'Do nothing - blank line
ElseIf Left(sLine, 1) = ";" Then '*** ; comment *****
Result="'"&Mid(sLine, 2, Len(sLine))
ElseIf Left(sLine, 2) = "@=" Then ' *** @= Default Value****
Dim l_datad
l_datad=Right(sLine,Len(sLine)-2)
if Len(l_datad) >2 then 'if not blank, check for chr(34) in data
Dim l_datadRAW
l_datadRAW=Mid(l_datad,2,len(l_datad)-2) 'Remove chr(34) at beginning and end of string
If Instr(1, l_datadRAW, chr(34), vbTextCompare)>0 then 'if contains " ==> chr(34)
l_datadRAW=Replace(l_datadRAW, """", """""")
' l_datadRAW=Replace(l_datadRAW, "\""", "\""""") ' to try to handle "\"c:\blabla\"" => NFG!!!
l_datadRAW=Replace(l_datadRAW, "\"&chr(34), "\"&chr(34)&chr(34)) ' to try to handle "\"c:\blabla\"" => NFG!!!
' AddError "value data contained "" Now fixed. was: " & sLine
l_datad=""""&l_datadRAW&"""" 'Add chr(34) back at beginning and end of string
End if
End if
Result = "objShell.RegWrite """ & g_Key & "\" & "" & """, " & Right(sLine,Len(sLine)-2) & ", " & Chr(34) & "REG_SZ" & Chr(34)&" 'Default value"
ElseIf Left(sLine, 2) = "
- " & sError
End Sub
Sub AppendStr(sVar, sStr)
'Appends sStr to sVar. Just cleaner than appending with "&" all the time
sVar = sVar & sStr
End Sub
Sub AppendLine(sVar, sStr)
'Appends sStr to sVar and adds a vbCrLf
AppendStr sVar, sStr & vbCrLf
End Sub
Sub PrependStr(sVar, sStr)
'Prepends sStr to sVar. Just cleaner than appending with "&" all the time
sVar = sStr & sVar
End Sub
Sub PrependLine(sVar, sStr)
'Prepends sStr to sVar and adds a vbCrLf
PrependStr sVar, sStr & vbCrLf
End Sub
此帖被 +4 点积分 点击查看详情 | 评分人：【 HAT 】 | 分数： +2 | 时间：2009-2-14 13:18 | | 评分人：【 kioskboy 】 | 分数： +2 | 时间：2009-6-19 00:13 |
|
|
|
