原文http://slore.blogbus.com/logs/52627038.html
Slore编写的这个reg文件转换为bat文件，是逐句转换的，不是通过批处理生成临时reg文件然后导入的方法，很不错。
我做了以下修改：
1、修改openfile函数，用SelectFile( )代替，原函数中Set objDialog = CreateObject("UserAccounts.CommonDialog")只支持XP，WIN7下没有选择文件的对话框，不方便，修改之后的VBS代码支持XP、WIN7、WIN7X64。Windows 8, Windows 8.1未测试，理论上可行。
2、选择reg文件之后，默认保存为与之同名的bat文件，避免两次弹出选择文件的对话框。
Slore的这个VBS确实很不错，在此表示感谢！代码如下：
'------------------------------------------------------------------------------
'名称:Reg2Bat_By Slore（生成同名bat文件，支持XP、WIN7、WIN7X64）.vbs
'功能:REG文件转换为同名的BAT、CMD文件。
'原文http://slore.blogbus.com/logs/52627038.html
' REG命令功能有限,仅支持常用类型。
' (REG_SZ、REG_DWORD、REG_BINARY、
' REG_EXPAND_SZ、REG_MULTI_SZ)
'
' By Slore 【修改by 代码飞扬】
' 更新于:2017年2月16日
'
'如果对脚本有任何意见和建议,可发送相关信息至:
' slorelee@yahoo.com.cn
'
'声明:
'本人支持开源,代码未作任何加密,可自由转载,但请
'尊重他人劳动成果,转载请务必注明出处和原作者。
'------------------------------------------------------------------------------
'---------------------------
'Reg2Bat By Slore
'---------------------------
'命令行参数说明(不区分大小写)
'/?、/h、/help 查看此帮助信息
'/i:RegFileName 指定要转换的注册表文件路径
'/o:BatFileName 指定转换后的批处理文件路径
'可选参数
'/S:Separator REG_MULTI_SZ 数据字符串中用作分隔符的字符
' 仅限一个字符,默认"\0"用作分隔符
'/Q 安静模式,不弹出错误提示
'/NF 转换后REG命令无/F参数
'/NH 忽略注册表文件头检测
'
'例如:
'简易模式:CScript Reg2Bat.vbs [/i:]slore.reg /S:轩 /Q
' 省略批处理文件路径,将输出为注册表文件同名文件。
'经典模式:CScript Reg2Bat.vbs slore.reg slore.bat /S:轩 /Q
' 其中注册表文件路径和批处理文件路径顺序不可调换。
'标准模式:CScript Reg2Bat.vbs /i:slore.reg /o:slore.bat /S:轩 /Q
' 其中/i:、/o:、/S:中的冒号不可省略,顺序可变。
'---------------------------
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const blnOverWrite = True
Const adTypeBinary = 1
Const adModeReadWrite = 3
Const ANSI = 0
Const Unicode = - 1
Const REG_SEPARATOR = "\0" '默认分隔符
Const BatHead = "@echo off" '转换后的批处理文件头
Const BatFileExt = "bat" '批处理文件扩展名
Const IgnoreRegHead = False '忽略注册表文件头检测
Dim RegHexType(10)
RegHexType(0) = "REG_NONE":RegHexType(1) = "REG_SZ"
RegHexType(2) = "REG_EXPAND_SZ":RegHexType(3) = "REG_BINARY"
RegHexType(4) = "REG_DWORD":RegHexType(5) = "REG_DWORD_BIG_ENDIAN"
RegHexType(6) = "REG_LINK":RegHexType(7) = "REG_MULTI_SZ"
RegHexType(8) = "REG_RESOURCE_LIST":RegHexType(9) = "REG_FULL_RESOURCE_DESCRIPTOR"
Dim RegSeptr
Dim blnForce,blnSilent
blnForce = True
blnSilent = False
Dim RegFile,BatFile
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
'参数处理
With WSH.Arguments
If .Count <> 0 Then
If .Named.Exists("?") Then ShowHelp
If .Named.Exists("h") Then ShowHelp
If .Named.Exists("help") Then ShowHelp
If .Named.Exists("i") Then RegFile = .Named.Item("i")
If .Named.Exists("o") Then BatFile = .Named.Item("o")
If .Named.Exists("s") Then RegSeptr = .Named.Item("s")
If .Named.Exists("q") Then blnSilent = True
If .Named.Exists("nf") Then blnForce = False
If .Named.Exists("nh") Then IgnoreRegHead = True
If .Unnamed.Count > 0 Then
RegFile = .Unnamed.Item(0)
If Not objFSO.FileExists(RegFile) Then WSH.Quit
If .Unnamed.Count > 1 Then
BatFile = .Unnamed.Item(1)
Else
BatFile = Left(RegFile,InstrRev(RegFile,".")) & "bat"
End If
End If
End If
End With
If Len(RegSeptr) = 0 Then
RegSeptr = REG_SEPARATOR
Else
RegSeptr = Left(RegSeptr,1)
End If
'选择注册表文件
Dim strFile
RegFile = SelectFile( )
If RegFile = "" Then
' RegFile = OpenFile(".","注册表文件(*.reg)|*.reg")
RegFile= SelectFile( )
If RegFile = "" Then WSH.Quit
'Else
' BatFile = Left(RegFile,InstrRev(RegFile,".")) & BatFileExt
End If
If Not objFSO.FileExists(RegFile) Then WSH.Quit
'选择批处理文件
'If BatFile = "" Then BatFile = OpenFile(".","批处理文件(*." & BatFileExt & ")|*." &
BatFileExt)
BatFile = Left(RegFile,InstrRev(RegFile,".")) & BatFileExt
If BatFile = "" Then WSH.Quit
'获取注册表文件编码
Dim FileEncoding
FileEncoding = GetEncoding(RegFile)
If FileEncoding = "ANSI" Then
OpenFormat = ANSI
ElseIf FileEncoding = "Unicode" Then
OpenFormat = Unicode
Else
If Not blnSilent Then MsgBox "注册表文件的编码不正确。",vbInformation,"文件编码:" &
FileEncoding
WSH.Quit
End If
'格式化注册表文件
Dim RegStr,RegLine
Set objFile = objFSO.OpenTextFile(RegFile,ForReading,False,OpenFormat)
Do Until objFile.AtEndOfStream
RegLine = MyTrim(objFile.ReadLine)
If RegLine <> "" Then '清除空行
'If Left(RegLine,1) <> ";" Then RegStr = RegStr & RegLine & vbCrLf '清除注释行
RegStr = RegStr & RegLine & vbCrLf
End If
Loop
objFile.Close
'合并hex(?)类型多行数据
Dim hStr,hPos,RegChar
hPos = InStr(1,RegStr,",\" & vbCrLf)
Do While hPos > 0
RegChar = Mid(RegStr,hPos + 4,1)
If InStr(1,"[@""",RegChar) > 0 Then
RegStr = Left(RegStr,hPos - 1) & Mid(RegStr,hPos + 2)
ElseIf RegChar = ";" Then
RemEnd = InStr(hPos + 5,RegStr,vbCrLf)
If RemEnd = 0 Then
RegStr = Left(RegStr,hPos - 1)
Else
RegStr = Left(RegStr,hPos) & Mid(RegStr,RemEnd + 2)
End If
Else
RegStr = Left(RegStr,hPos) & Mid(RegStr,hPos + 4)
End If
hPos = InStr(hPos + 4,RegStr,",\" & vbCrLf)
Loop
'替换主键为缩写
RegStr = Replace(RegStr,vbCrLf & "[HKEY_LOCAL_MACHINE\",vbCrLf & "[HKLM\")
RegStr = Replace(RegStr,vbCrLf & "[HKEY_CURRENT_USER\",vbCrLf & "[HKCU\")
RegStr = Replace(RegStr,vbCrLf & "[HKEY_CLASSES_ROOT\",vbCrLf & "[HKCR\")
RegStr = Replace(RegStr,vbCrLf & "[HKEY_USER\",vbCrLf & "[HKU\")
RegStr = Replace(RegStr,vbCrLf & "[HKEY_CUREENT_CONFIG\",vbCrLf & "[HKCC\")
RegStr = Replace(RegStr,vbCrLf & "[-HKEY_LOCAL_MACHINE\",vbCrLf & "[-HKLM\")
RegStr = Replace(RegStr,vbCrLf & "[-HKEY_CURRENT_USER\",vbCrLf & "[-HKCU\")
RegStr = Replace(RegStr,vbCrLf & "[-HKEY_CLASSES_ROOT\",vbCrLf & "[-HKCR\")
RegStr = Replace(RegStr,vbCrLf & "[-HKEY_USER\",vbCrLf & "[-HKU\")
RegStr = Replace(RegStr,vbCrLf & "[-HKEY_CUREENT_CONFIG\",vbCrLf & "[-HKCC\")
'对格式化后的注册表文件进行转换
Dim RegLines,n
RegLines = Split(RegStr,vbCrLf)
n = UBound(RegLines)
If Not IgnoreRegHead Then
'检验文件头
If RegLines(0) <> "REGEDIT4" And _
RegLines(0) <> "Windows Registry Editor Version 5.00" Then
If Not blnSilent Then MsgBox "不是合法注册表文件头",vbInformation,"错误"
WSH.Quit
End If
End If
Dim RegCommand,BatStr
Dim i,RegKey,RegVal,RegType,RegData
If blnForce Then sForce = " /f" Else sForce = ""
Dim o '为1是删除,为0是添加
Dim vPos
Dim HeadChar,LastHeadChar
LastHeadChar = ""
For i = 1 To n
HeadChar = Left(RegLines(i),1)
If HeadChar = "[" Then
If LastHeadChar = "[" And o = 0 Then '添加项
BatStr = BatStr & RegCommand & RegKey & sForce & vbCrLf
End If
If Mid(RegLines(i),2,1) = "-" Then
RegCommand = "reg delete "
o = 1
Else
RegCommand = "reg add "
o = 0
End If
RegKey = """" & Mid(RegLines(i),2 + o,Len(RegLines(i)) - 2 - o) & """"
If o = 1 Then '删除项
BatStr = BatStr & RegCommand & RegKey & sForce & vbCrLf
RegKey = ""
End If
ElseIf HeadChar = "@" And (Not Len(RegKey)) Then
RegLines(i) = Replace(RegLines(i),"\\",vbNullChar)
RegVal = " /ve "
GetTD Replace(Mid(RegLines(i),3),vbNullChar,"\"),RegType,RegData
If RegData = "-" Then
BatStr = BatStr & "reg delete " & RegKey & " /ve " & sForce & vbCrLf
Else
If RegType <> "REG_SZ" Then
RegType = " /t " & RegType
Else
RegType = ""
End If
BatStr = BatStr & "reg add " & RegKey & " /ve" & RegType & " /d " & RegData &
sForce & vbCrLf
End If
ElseIf HeadChar = """" And (Not Len(RegKey)) Then
RegLines(i) = Replace(RegLines(i),"\\",vbNullChar)
vPos = InStr(2,RegLines(i),"""=")
If vPos > 2 Then
If Mid(RegLines(i),vPos - 1,1) = "\" Then
Do Until Mid(RegLines(i),vPos - 1,1) <> "\"
vPos = InStr(vPos + 2,RegLines(i),"""=")
If vPos = 0 Then Exit Do
Loop
End If
If vPos <> 0 Then
RegVal = Replace(Left(RegLines(i),vPos),vbNullChar,"\")
RegVal = RegSpe(RegVal,0)
GetTD Replace(Mid(RegLines(i),vPos + 2),vbNullChar,"\"),RegType,RegData
If RegData = "-" Then
BatStr = BatStr & "reg delete " & RegKey & " /v " & RegVal & sForce &
vbCrLf
Else
If RegType <> "REG_SZ" Then
RegType = " /t " & RegType
Else
RegType = ""
End If
BatStr = BatStr & "reg add " & RegKey & " /v " & RegVal & RegType & "
/d " & RegData & sForce & vbCrLf
End If
End If
End If
ElseIf HeadChar = ";" Then '注释内容处理(仅支持纯注释行,并且不在Hex数据中间。)
BatStr = BatStr & "rem " & Mid(RegLines(i),2) & vbCrLf
HeadChar = LastHeadChar
End If
LastHeadChar = HeadChar
Next
'保存为批处理文件
If Len(BatHead) Then BatStr = BatHead & vbCrLf & BatStr
If LCase(Right(BatFile,4)) <> "." & BatFileExt Then BatFile = BatFile & "." & BatFileExt
Set objFile = objFSO.CreateTextFile(BatFile,blnOverWrite)
objFile.Write BatStr
objFile.Close
Sub ShowHelp()
MsgBox "命令行参数说明(不区分大小写)" & vbCrLf & _
"/?、/h、/help 查看此帮助信息" & vbCrLf & _
"/i:RegFileName 指定要转换的注册表文件路径" & vbCrLf & _
"/o:BatFileName 指定转换后的批处理文件路径" & vbCrLf & _
"可选参数" & vbCrLf & _
"/S:Separator REG_MULTI_SZ 数据字符串中用作分隔符的字符" & vbCrLf & _
" 仅限一个字符,默认""\0""用作分隔符" & vbCrLf & _
"/Q 安静模式,不弹出错误提示" & vbCrLf & _
"/NF 转换后REG命令无/F参数" & vbCrLf & _
"/NH 忽略注册表文件头检测" & vbCrLf & vbCrLf & _
"例如:" & vbCrLf & _
"简易模式:CScript Reg2Bat.vbs [/i:]slore.reg /S:轩 /Q" & vbCrLf & _
" 省略批处理文件路径,将输出为注册表文件同名文件" & vbCrLf &
_
"经典模式:CScript Reg2Bat.vbs slore.reg slore.bat /S:轩 /Q" &
vbCrLf & _
" 其中注册表文件路径和批处理文件路径顺序不可调换。" &
vbCrLf & _
"标准模式:CScript Reg2Bat.vbs /i:slore.reg /o:slore.bat /S:轩 /Q"
& vbCrLf & _
" 其中/i:、/o:、/S:中的冒号不可省略,顺序可变。" _
,vbInformation,"Reg2Bat By Slore"
WSH.Quit
End Sub
'---------------------------------自定义函数-------------------------------
'打开文件函数
'参数:初始路径,文件类型过滤器
Function OpenFile(IntDir,Fltr)
Dim objDialog
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = Fltr
objDialog.InitialDir = IntDir
intResult = objDialog.ShowOpen
If intResult Then
OpenFile = objDialog.FileName
Else
OpenFile = ""
End If
End Function
'修改后的打开文件函数：
'Works in Windows XP, Vista, Windows 7, Windows 8, Windows 8.1.
Function SelectFile( )
Dim objExec, strMSHTA, wshShell
SelectFile = ""
' For use in HTAs as well as "plain" VBScript:
strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
& "<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')"
_
& ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" &
"/script>"""
' For use in "plain" VBScript only:
' strMSHTA = "mshta.exe ""about:<input type=file id=FILE>" _
' & "<script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
' & ".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo
(0,0);</script>"""
Set wshShell = CreateObject( "WScript.Shell" )
Set objExec = wshShell.Exec( strMSHTA )
SelectFile = objExec.StdOut.ReadLine( )
Set objExec = Nothing
Set wshShell = Nothing
Set wshShell = Nothing
End Function
'调用方法
'Dim strFile
'strFile = SelectFile( )
'If strFile = "" Then
' WScript.Echo "No file selected."
'Else
' WScript.Echo """" & strFile & """"
'End If
'检测文本文件编码
Function GetEncoding(FileName)
Dim objStreamR,HeadBin,HeadBytes(1)
Set objStreamR = CreateObject("Adodb.Stream")
objStreamR.Type = adTypeBinary
objStreamR.Mode = adModeReadWrite
objStreamR.Open
objStreamR.LoadFromFile FileName
HeadBin = objStreamR.Read(2)
objStreamR.Close
HeadBytes(0) = AscB(MidB(HeadBin,1,1))
HeadBytes(1) = AscB(MidB(HeadBin,2,1))
GetEncoding = "ANSI"
If HeadBytes(0) = &HFF And HeadBytes(1) = &HFE Then GetEncoding = "Unicode"
If HeadBytes(0) = &HFE And HeadBytes(1) = &HFF Then GetEncoding = "Unicode Big Endian"
If HeadBytes(0) = &HEF And HeadBytes(1) = &HBB Then GetEncoding = "UTF-8"
End Function
'剔除字符串两边的Tab字符和空格
Function MyTrim(iStr)
Dim sPos,ePos
sPos = 1
For i = 1 To Len(iStr)
If Mid(iStr,i,1) = vbTab or Mid(iStr,i,1) = " " Then
sPos = i + 1
Else
Exit For
End If
Next
ePos = Len(iStr)
For i = Len(iStr) To 1 Step - 1
If Mid(iStr,i,1) = vbTab or Mid(iStr,i,1) = " " Then
ePos = i - 1
Else
Exit For
End If
Next
If (ePos - sPos + 1) < 0 Then
MyTrim = ""
Exit Function
End If
MyTrim = Mid(iStr,sPos,ePos - sPos + 1)
End Function
Sub GetTD(iStr,oType,oData)
Dim i
oType = "":oData = ""
If iStr = "" Then Exit Sub
If iStr = "-" Then oData = "-":Exit Sub
If Left(iStr,1) = """" Then
oType = "REG_SZ"
oData = RegSpe(iStr,0)
ElseIf LCase(Left(iStr,4)) = "hex:" Then
oType = "REG_BINARY"
oData = """" & Replace(Mid(iStr,5),",","") & """"
ElseIf LCase(Left(iStr,6)) = "dword:" Then
oType = "REG_DWORD"
oData = Hex2Dec(Mid(iStr,7))
Else
For i = 0 To 9
If LCase(Left(iStr,7)) = "hex(" & i & "):" Then
oType = RegHexType(i)
If (i = 1) or (i = 2) or (i = 3) or (i = 7) Then
oData = RegHexToAscii(Replace(Mid(iStr,8),",",""),i,RegSeptr)
Else
oData = """对不起,这是不支持的类型。"""
End If
Exit For
End If
Next
End If
End Sub
Function RegSpe(iStr,t)
Dim i,f,QPos
If Left(iStr,1) = """" Then
RegSpe = Mid(iStr,2,Len(iStr) - 2) '去除双引号
Else
RegSpe = iStr
End If
'反斜杠与引号字符串处理
QPos = - 1
Do Until QPos = 0
QPos = InstrRev(RegSpe,"\""",QPos)
If QPos = 0 Then Exit Do
f = t
For i = QPos To 1 Step - 1
If Mid(RegSpe,i,1) = "\" Then
If f = 1 Then
RegSpe = Left(RegSpe,i) & "\" & Mid(RegSpe,i + 1)
Else
f = 1
End If
Else
Exit For
End If
Next
QPos = i
Loop
For i = Len(RegSpe) To 1 Step - 1
If Mid(RegSpe,i,1) = "\" Then
RegSpe = RegSpe & "\"
Else
Exit For
End If
Next
'百分号字符处理
RegSpe = Replace(RegSpe,"%","%%")
'对HexData转ASCII的引号字符进行转义
If t = 1 Then
RegSpe = Replace(RegSpe,"""","\""")
End If
'添加双引号
RegSpe = """" & RegSpe & """"
End Function
Function Hex2Dec(strHex)
Hex2Dec = 268435456 * CLng("&H" & Left(strHex,1))
Hex2Dec = Hex2Dec + CLng("&H" & Mid(strHex,2))
End Function
Function RegHexToAscii(iStr,RegTypeIndex,Separator)
Dim i,n,sRet,HexL,HexH
For i = 1 To Len(iStr) Step 4
HexL = Mid(iStr, i, 2)
HexH = Mid(iStr, i + 2, 2)
If HexL & HexH = "0000" Then
If RegTypeIndex = 7 Then '多字符串(REG_MULTI_SZ)类型
HexChar = Separator
Else 'ElseIf RegTypeIndex = 2 Then '可扩充字符串(REG_EXPAND_SZ)类型
Exit For
End If
ElseIf HexL = "00" Then
HexChar = Chr(CLng("&H" & HexL))
Else
HexChar = ChrW(CLng("&H" & HexH & HexL))
End If
sRet = sRet & HexChar
Next
If RegTypeIndex = 7 Then
n = Len(Separator)
Do Until Right(sRet,n) <> Separator
sRet = Left(sRet,Len(sRet) - n)
Loop
End If
RegHexToAscii = RegSpe(sRet,1)
End Function
