批处理之家 - Powered by Discuz! Board

标题: [问题求助] [已解决]VBS怎样处理 unicode 格式文件？ [打印本页]

作者: yuanyannian 时间: 2014-8-1 06:45 标题: [已解决]VBS怎样处理 unicode 格式文件？

本帖最后由 yuanyannian 于 2014-8-5 19:52 编辑

处理 windows 安装盘中 HIVEDEF.INF 等 unicode 格式文件，得到 apang 老师的很大帮助，但由于本人对批处理实在是外行，每一步都不会写，所以不断麻烦并请教各位老师，请原谅！
现在的问题是，我想按如下方式处理 HIVEDEF.INF 等 unicode 格式文件，需要老师帮忙：

'命令提示符下 输入的格式如 zzz.vbs -Saaa -TD:\zzz
'如参数为 aaa，则跳转到 Function  aaa()；如参数为 bbb，则跳转到 Function  bbb()；如参数为 ccc，则跳转到 Function  ccc()；等等。
'源文件为 unicode，需要保持原格式不变
'如何接收第二个外部参数（变量），并截取 -T后面输入的路径作为变量（如 D:\zzz），后面将调用这个变量作为源文件的路径如 %zzz%


'如下格式执行不正确，如何修改？
Set oArgs = WScript.Arguments
If oArgs(0)="aaa" Then
  Call aaaSE()
ElseIf oArgs(0)="bbb" Then
  Call bbbSE()
ElseIf oArgs(0)="ccc" Then
  Call cccSE()
End If
'退出

Function  aaa()
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set f = fso.OpenTextFile("HIVEDEF.INF", 1, false, -1)  '其中的 HIVEDEF.INF，改为 %xxx%\HIVEDEF.INF
  s = f.ReadAll : f.Close
  s = Replace(f.ReadAll, "HKCU,""", "HKLM,""WB-default\")
  s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & vbCrLf & s
  fso.OpenTextFile("HIVEDEF.INF", 2, true, -1).Write s
'安装 %xxx%\HIVEDEF.INF
End Function
'退出

Function  bbb()
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set f = fso.OpenTextFile("HIVESFT.INF", 1, false, -1)  '其中的 HIVESFT.INF，改为 %xxx%\HIVESFT.INF
  s = f.ReadAll : f.Close
  s = Replace(f.ReadAll, "HKLM,""SOFTWARE\", "HKLM,""WB-software\")
  s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & vbCrLf & s
  fso.OpenTextFile("HIVESFT.INF", 2, true, -1).Write s
'安装 %xxx%\HIVESFT.INF
End Function
'退出

Function  ccc()
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set f = fso.OpenTextFile("HIVESYS.INF", 1, false, -1)  '其中的 HIVESYS.INF，改为 %xxx%\HIVESYS.INF
  s = f.ReadAll : f.Close
  s = Replace(f.ReadAll, "HKLM,""SYSTEM\", "HKLM,""WB-setup\")
  s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & vbCrLf & s
  fso.OpenTextFile("HIVESYS.INF", 2, true, -1).Write s
'安装 %xxx%\HIVESYS.INF
End Function
'退出
复制代码

...

作者: yuanyannian 时间: 2014-8-1 19:17

期待老师出手相助，感谢了！

作者: yuanyannian 时间: 2014-8-1 19:40

本帖最后由 yuanyannian 于 2014-8-1 19:41 编辑

这电脑慢的害人。

作者: apang 时间: 2014-8-1 20:10

试试

msg = "命令提示符下 输入的格式如 zzz.vbs -Saaa -TD:\zzz"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oArgs = WScript.Arguments
If oArgs.Count >= 2 Then
    fd = Mid(oArgs(1), 3) & "\"
ElseIf oArgs.Count = 1 Then
    fd = ".\"
Else
    MsgBox msg, , "提示" : WScript.Quit
End If

If Mid(oArgs(0), 3) = "aaa" Then
    Call ReplaceStr("HKCU,""", "HKLM,""WB-default\")
ElseIf Mid(oArgs(0), 3) = "bbb" Then
    Call ReplaceStr("HKLM,""SOFTWARE\", "HKLM,""WB-software\")
ElseIf Mid(oArgs(0), 3) = "ccc" Then
    Call ReplaceStr("HKLM,""SYSTEM\", "HKLM,""WB-setup\")
Else
    MsgBox msg, , "提示" : WScript.Quit
End If

Function ReplaceStr(s1, s2)
    Set f = fso.OpenTextFile(fd & "HIVEDEF.INF", 1, false, -1)
    s = f.ReadAll : f.Close
    s = Replace(s, s1, s2)
    s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & vbCrLf & s
    fso.OpenTextFile(fd & "HIVEDEF.INF", 2, true, -1).Write s
End Function
复制代码

作者: yuanyannian 时间: 2014-8-1 22:05

回复 4# apang

首先感谢。

路径截取、调用没问题，HIVEDEF.INF 中的字符可成功替换，但其它两个文本（HIVESFT.INF、HIVESYS.INF 未能执行替换），
看代码中似乎没有针对 HIVESFT.INF、HIVESYS.INF 文件和路径？
再者，需要处理的可能还有更多的文件（同样格式）。

apang 老师辛苦了。

作者: yuanyannian 时间: 2014-8-2 07:09

回复 4# apang

我把代码改为如下：

msg = "命令提示符下 输入的格式如 zzz.vbs -Saaa -TD:\zzz"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oArgs = WScript.Arguments
If oArgs.Count >= 2 Then
    fd = Mid(oArgs(1), 3) & "\"
ElseIf oArgs.Count = 1 Then
    fd = ".\"
Else
    MsgBox msg, , "提示" : WScript.Quit
End If

If Mid(oArgs(0), 3) = "aaa" Then
    Call ReplaceDEF()
ElseIf Mid(oArgs(0), 3) = "bbb" Then
    Call ReplaceSFT()
ElseIf Mid(oArgs(0), 3) = "ccc" Then
    Call ReplaceSYS()
Else
    MsgBox msg, , "提示" : WScript.Quit
End If

Function ReplaceDEF()
  Set f = fso.OpenTextFile(fd & "HIVEDEF.INF", 1, false, -1)
  s = Replace(f.ReadAll, "HKCU,""", "HKLM,""WB-default\")
  s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & vbCrLf & s
  fso.OpenTextFile(fd & "HIVEDEF.INF", 2, true, -1).Write s
  f.Close
End Function

Function ReplaceSFT()
  Set f = fso.OpenTextFile(fd & "HIVESFT.INF", 1, false, -1)
  s = Replace(f.ReadAll, "HKLM,""SOFTWARE\", "HKLM,""WB-software\")
  s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & vbCrLf & s
  fso.OpenTextFile(fd & "HIVESFT.INF", 2, true, -1).Write s
  f.Close
End Function

Function ReplaceSYS()
  Set f = fso.OpenTextFile(fd & "HIVESYS.INF", 1, false, -1)
  s = Replace(f.ReadAll, "HKLM,""SYSTEM\", "HKLM,""WB-setup\")
  s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & vbCrLf & s
  fso.OpenTextFile(fd & "HIVESYS.INF", 2, true, -1).Write s
  f.Close
End Function
复制代码

可以达到要求---aaa 时处理 HIVEDEF.INF，bbb 时处理 HIVESFT.INF，ccc 时处理 HIVESYS.INF，但问题来了：它区分大小写，也就是只能处理替换大写字符，请教如何让它不分大小写？
另外，可否处理完以后，运行安装如 HIVEDEF.INF？
bat 下安装 .inf 命令是 rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 128（或132） D:\inf\default.inf，vbs 中如何做？

作者: apang 时间: 2014-8-2 15:26

回复 6# yuanyannian

举例：

Function ReplaceSFT()
  Set ws = CreateObject("WScript.Shell")
  Set f = fso.OpenTextFile(fd & "HIVESFT.INF", 1, false, -1)
  s = f.ReadAll : f.Close
  Set re = New RegExp
  re.Pattern = "HKLM,""SOFTWARE\\"
  re.Global = true
  re.IgnoreCase = true
  s = re.Replace(s, "HKLM,""WB-default\")
  s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & vbCrLf & s
  fso.OpenTextFile(fd & "HIVESFT.INF", 2, true, -1).Write s
  ''ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 128 """ & fd & "HIVESFT.INF""", , true
End Function
复制代码

作者: yuanyannian 时间: 2014-8-2 19:45

回复 7# apang

好用，谢谢 apang 老师！

不过，如果需要替换两个以上不同的字符串，不分大小写就不行了。
另外，INF 安装总是失败。

作者: yuanyannian 时间: 2014-8-2 20:02

回复 7# apang

再请教 apang 老师，在您的指导帮助下，基本完成了成品的 vbs，用于处理 unicode 格式文件。主要作用：

1. 运行方式：xxx.vbs -Szzzz.inf -Td:\zzz
2. 如 zzzz.inf 为 ANSI 格式，就转换为 unicode 格式
3. 替换其中的注册表项指向为可挂载的非本系统的注册表文件
4. 安装 inf 文件（实际作用是将 INF 中的内容注入到非本系统的注册表文件）

存在的问题：
1. 代码过于凌乱，也可能有错误的地方，想请老师修改简化一些。
2. 如需要有两处以上替换的，希望均设置成不分大小写。

作者: apang 时间: 2014-8-3 10:29

本帖最后由 apang 于 2014-8-9 23:16 编辑

Dim msg, ws, oArgs, fd
msg = "Command prompt: HoJoHE.vbs -SHIVEDEF.INF -TD:\zzz"
msg = msg & vbLf & "or: HoJoHE.vbs -SHIVEDEF.INF -T""D:\zz z"""
Set ws = CreateObject("WScript.Shell")
Set oArgs = WScript.Arguments
If oArgs.Count >= 2 Then
    fd = Mid(oArgs(1), 3) & "\"
ElseIf oArgs.Count = 1 Then
    fd = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))
Else Call HoJoHlp()
End If

Dim file, fso, f, s
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(fd & Mid(oArgs(0), 3)) Then
    msg = "Input Path or File Name Error" & vbLf & msg
    Call HoJoHlp()
End If
file = fso.GetFile(fd & Mid(oArgs(0), 3)).ShortPath
Set f = fso.OpenTextFile(file, 1, false, GetFileFormat(file))
s = f.ReadAll : f.Close

Select Case UCase(Mid(oArgs(0), 3))
    Case "HIVEDEF.INF"
        s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
    Case "HIVESFT.INF"
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
    Case "HIVESYS.INF"
        s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
    Case "HIVECLS.INF"
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
        s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")
        s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")
    Case Else Call HoJoHlp()
End Select

fso.OpenTextFile(file, 2, true, -1).Write s
ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 128 " & file, , true

MsgBox "OK"

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 Function

Function HoJoHlp()
    MsgBox msg : WScript.Quit
End Function
复制代码

作者: yuanyannian 时间: 2014-8-3 13:22

回复 10# apang

非常完美，非常感谢 apang 老师，老师辛苦了！！！

谢！谢！谢！

作者: yuanyannian 时间: 2014-8-3 21:12

回复 10# apang

第一部分修改了一下，意思是判断在三个参数、两个参数、一个参数情况下执行的结果，要求准确输入参数，不知可对？

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
复制代码

作者: yuanyannian 时间: 2014-8-4 07:03

回复 10# apang

刚才发现 Case 语句不好用，输入序列以外的任意文件，总提示“文件无法打开”，并不显示 msgbox？

作者: apang 时间: 2014-8-9 23:26

回复 12# yuanyannian

个人认为，代码主要目的是查找与替换字符串，输入参数的判断，会占到代码很大一部分，自己用的话，没必要整得那么麻烦。

欢迎光临批处理之家 (http://bbs.bathome.net/)