[问题求助] 求助处理unicode格式文件的VBS代码修改并精简

yuanyannian

这段时期，关于处理 unicode 格式文件，不断劳烦 apang 等老师，非常抱歉，这里衷心感谢！！！
仍然是这个代码，由于本人对批处理是丈二外行，不得要领，不断地更改代码功能，所以也就不断地麻烦各位老师指教、修改，请见谅。
下面的代码是在 apang 等老师指点下，自己东拼西凑起来的，虽然可以运行，但自己都觉得太外行了，所以再请老师修改。


功能需求：
1. 命令行输入 4 个参数，各个参数前的如 -S 等要求正确输入，不要求必须全部输入 4 个参数，但如输入1个，或2个，或3个，或4个，则
   分别处理。当第一个参数为 ? ，显示帮助信息，即 msg。其它情况下则要求给出 sd、fd 路径。
2. 第 4 个参数暂时赋值给变量，以后会用到。
3. 判断第一个参数 -S 后面的文件名，如 default 或 setupreg.hiv，仅处理1个文件，如 software 则需要处理多个文件，需要
   先判断 sd 目录中如存在该文件，先复制到 fd 目录中再处理，如不存在就忽略。
4. 处理文件过程：先判断是否 unicode 格式，否则先转换为 unicode 格式。替换文件中的字符串，添加行。

Dim msg, ws, oArgs, fd, sd
msg = "Command prompt: HojoHE.vbs -SA.INF -TD:\a -IC:\a\b -L0409"
Set ws = CreateObject("WScript.Shell")
Set oArgs = WScript.Arguments
If oArgs.Count = 4 Then
    If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") and (Left(oArgs(2),2) = "-I") and (Left(oArgs(2),2) = "-L") Then
        loc = Mid(oArgs(3), 3)
        sd = Mid(oArgs(2), 3) & "\"
        fd = Mid(oArgs(1), 3) & "\"
    Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit
    End If
If oArgs.Count = 3 Then
    If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") and (Left(oArgs(2),2) = "-I") Then
        sd = Mid(oArgs(2), 3) & "\"
        fd = Mid(oArgs(1), 3) & "\"
    Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit
    End If
ElseIf oArgs.Count = 2 Then
    If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") Then
        sd = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))
        fd = Mid(oArgs(1), 3) & "\"
    Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit
    End If
ElseIf oArgs.Count = 1 Then
    If oArgs(0) = "?" Then
        MsgBox msg
    ElseIf Left(oArgs(0),2) = "-S" Then
        sd = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))
        fd = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))
    Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit
    End If
Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit
End If
 
Dim ifile, file, fso, f, s, ss
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(fd) = False Then fso.CreateFolder fd
If LCase(Mid(oArgs(0), 3)) = "default" Then
    If (fso.FileExists(sd & "HIVEDEF.INF")) Then
        ifile = sd & "HIVEDEF.INF"
        fso.CopyFile ifile,fd,true
        file = fd & "HIVEDEF.INF"
        Call GetFile()
    End If
    ElseIf LCase(Mid(oArgs(0), 3)) = "software" Then
        If (fso.FileExists(sd & "HIVESFT.INF")) Then
            ifile = sd & "HIVESFT.INF"
            fso.CopyFile ifile,fd,true
            file = fd & "HIVESFT.INF"
            Call GetFile()
        End If
        If (fso.FileExists(sd & "HIVECLS.INF")) Then
            ifile = sd & "HIVECLS.INF"
            fso.CopyFile ifile,fd,true
            file = fd & "HIVECLS.INF"
            Call GetFile()
        End If
        If (fso.FileExists(sd & "HIVESXS.INF")) Then
            ifile = sd & "HIVESXS.INF"
            fso.CopyFile ifile,fd,true
            file = fd & "HIVESXS.INF"
            Call GetFile()
        End If
        If (fso.FileExists(sd & "DMREG.INF")) Then
            ifile = sd & "DMREG.INF"
            fso.CopyFile ifile,fd,true
            file = fd & "DMREG.INF"
            Call GetFile()
        End If
        If (fso.FileExists(sd & "HIVCLS32.INF")) Then
            ifile = sd & "HIVCLS32.INF"
            fso.CopyFile ifile,fd,true
            file = fd & "HIVCLS32.INF"
            Call GetFile()
        End If
        If (fso.FileExists(sd & "HIVSFT32.INF")) Then
            ifile = sd & "HIVSFT32.INF"
            fso.CopyFile ifile,fd,true
            file = fd & "HIVSFT32.INF"
            Call GetFile()
        End If
    ElseIf LCase(Mid(oArgs(0), 3)) = "setupreg.hiv" Then
        If (fso.FileExists(sd & "HIVESYS.INF")) Then
            ifile = sd & "HIVESYS.INF"
            fso.CopyFile ifile,fd,true
            file = fd & "HIVESYS.INF"
            Call GetFile()
        End If
    Else MsgBox "The parameter isn't supported!"&vbcrlf&vbcrlf&"Must be 'default', or 'software', or 'setupreg.hiv'." : WScript.Quit
End If
 
Function GetFile()
    Set f = fso.OpenTextFile(file, 1, false, GetFileFormat(file))
    s = f.ReadAll : f.Close
    If file = fd & "HIVEDEF.INF" Then
        s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
        s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
    End If
    If file = fd & "HIVESFT.INF" Then
        s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
        s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
    End If
    If file = fd & "HIVESXS.INF" Then
        s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
        s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
    End If
    If file = fd & "HIVECLS.INF" Then
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
        s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")
        s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")
        s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
        s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
    End If
    If file = fd & "DMREG.INF" Then
        s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
        s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
    End If
    If file = fd & "HIVSFT32.INF" Then
        s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
        s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
    End If
    If file = fd & "HIVCLS32.INF" Then
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
        s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")
        s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")
        s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
        s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
    End If
    If file = fd & "HIVESYS.INF" Then
        s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
        s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
    End If
    fso.OpenTextFile(file, 2, true, -1).Write s
    ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 128 " & file, , true
End Function
WScript.Quit
 
Function GetFileFormat(ByVal file)
    Dim Bin
    with CreateObject("Adodb.Stream") 
        .Type = 1
        .Mode = 3
        .Open
        .Position = 0
        .Loadfromfile file
        Bin = .read(2)
    End with
    If AscB(MidB(Bin,1,1))=&HFF and AscB(MidB(Bin,2,1))=&HFE Then
        GetFileFormat = -1   ''unicode
    Else GetFileFormat = 0   ''ansi
    End If
End Function
 
Function ReplaceStr(ByVal s, pattern, s1)
    Dim re
    If Left(s, 16) <> "[DEFAULTINSTALL]" Then
        s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & s
    End If
    Set re = New RegExp
    re.Pattern = pattern
    re.Global = true
    re.IgnoreCase = true
    ReplaceStr = re.Replace(s, s1)
End FunctionCOPY

523066680

holy high!
(好厉害)

yuanyannian

参照网上的例子，自己修改如下，不知对不对？目前运行好像没有提示错误之处。
但有几个问题请教(见代码中)：

Dim msg, ws, oArgs, sLoca, iPath, tPath
msg = "Command prompt: HojoHE.exe -Sdefault -TD:\aa -IC:\aa\bb -L00000409"
Set ws = CreateObject("WScript.Shell")
Set oArgs = WScript.Arguments
Select Case oArgs.Count
    Case 4
        If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") and (Left(oArgs(2),2) = "-I") and (Left(oArgs(3),2) = "-L") Then
            sLoca = Mid(oArgs(3), 3)
            iPath = Mid(oArgs(2), 3) & "\"
            tPath = Mid(oArgs(1), 3) & "\"
        Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit
        End If
    Case 3
        If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") and (Left(oArgs(2),2) = "-I") Then
            iPath = Mid(oArgs(2), 3) & "\"
            tPath = Mid(oArgs(1), 3) & "\"
        Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit
        End If
    Case 2
        If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") Then
            iPath = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))
            tPath = Mid(oArgs(1), 3) & "\"
        Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit
        End If
    Case 1
        If oArgs(0) = "?" Then
            MsgBox msg : WScript.Quit
        ElseIf Left(oArgs(0),2) = "-S" Then
            iPath = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))
            tPath = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))
        Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit
        End If
    Case Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit
End Select
'35
Dim file, fso, f, s, ss                    ‘’此处的 f, s 是否应该放在 Function ProcessFile() 之下？
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(tPath) = False Then fso.CreateFolder tPath
Dim MyArray()                             ''定义一个一维动态数组
ReDim MyArray(7)                          ''定义数组大小
    Select Case LCase(Mid(oArgs(0), 3))
        Case "default"
            MyArray(0) = "HIVEDEF.INF"    ''为数组赋值
        Case "software"
            MyArray(1) = "HIVESFT.INF"
            MyArray(2) = "HIVECLS.INF"
            MyArray(3) = "HIVESXS.INF"
            MyArray(4) = "HIVCLS32.INF"
            MyArray(5) = "HIVSFT32.INF"
            MyArray(6) = "DMREG.INF"
        Case "setupreg.hiv"
            MyArray(7) = "HIVESYS.INF"
        Case Else MsgBox "The parameter isn't supported!"&vbcrlf&vbcrlf&"Must be 'default', or 'software', or 'setupreg.hiv'." : WScript.Quit
    End Select
For i=0 To UBound(MyArray)
ss = MyArray(i)                          ''循环遍历数组，并输出数组值给变量 ss
    If (fso.FileExists(iPath & ss)) Then
        fso.CopyFile iPath & ss,tPath,true
        file = tPath & ss
        Call ProcessFile()
    End If
Next
 
Function ProcessFile()
    Set f = fso.OpenTextFile(file, 1, false, GetFileFormat(file))
    s = f.ReadAll : f.Close
    s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")     ‘’如果存在就替换，否则忽略，       这样对吗？下同
    s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
    s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
    s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")
    s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")
    fso.OpenTextFile(file, 2, true, -1).Write s
''    ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 128 " & file, , true       ‘’此处如何判断是否安装成功，如果安装成功，如何删除 file？
End Function
WScript.Quit
 
Function GetFileFormat(ByVal file)
    Dim Bin
    with CreateObject("Adodb.Stream") 
        .Type = 1
        .Mode = 3
        .Open
        .Position = 0
        .Loadfromfile file
        Bin = .read(2)
    End with
    If AscB(MidB(Bin,1,1))=&HFF and AscB(MidB(Bin,2,1))=&HFE Then
        GetFileFormat = -1   ''unicode
    Else GetFileFormat = 0   ''ansi
    End If
End Function
 
Function ReplaceStr(ByVal s, pattern, s1)
    Dim re
    If Left(s, 16) <> "[DEFAULTINSTALL]" Then
        s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & s
    End If
    Set re = New RegExp
    re.Pattern = pattern
    re.Global = true
    re.IgnoreCase = true
    ReplaceStr = re.Replace(s, s1)
End FunctionCOPY