Reg2Bat_By Slore（生成同名bat文件，支持XP WIN7 WIN7X64）.vbs

原文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 数据字符串中用作分隔符的字符
'               仅限一个字符,默认""用作分隔符
'/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 = ""       '默认分隔符

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 & _
                 "               仅限一个字符,默认""""用作分隔符" & 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