Reg 转 Vbs - 中国DOS联盟论坛 - 中国DOS联盟之联合DOS论坛


'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

第1楼　newxso	发表于 2009-02-14 08:48
初级用户　发帖 101　积分 73　来自 GZ
[转贴] Reg 转 Vbs '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

第2楼　aries215	发表于 2009-06-11 09:11
初级用户　发帖 46　积分 29
好东西！不过这里好像不是VBS的土壤，没其他人顶。

第3楼　5872169	发表于 2009-06-12 06:32
高级用户　发帖 474　积分 959
好长的代码啊

第4楼　xswdong	发表于 2009-06-13 01:37
中级用户　发帖 129　积分 216
好东西，可惜我禁用了fso 不能使用了

第5楼　kendos	发表于 2009-06-13 06:46
初级用户　发帖 25　积分 36
好！