Board logo

标题: [问题求助] 求助处理unicode格式文件的VBS代码修改并精简 [打印本页]
作者: yuanyannian    时间: 2014-8-6 11:19     标题: 求助处理unicode格式文件的VBS代码修改并精简

这段时期，关于处理 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 格式。替换文件中的字符串，添加行。
  1. Dim msg, ws, oArgs, fd, sd

  2. msg = "Command prompt: HojoHE.vbs -SA.INF -TD:\a -IC:\a\b -L0409"

  3. Set ws = CreateObject("WScript.Shell")

  4. Set oArgs = WScript.Arguments

  5. If oArgs.Count = 4 Then

  6.     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

  7.         loc = Mid(oArgs(3), 3)

  8.         sd = Mid(oArgs(2), 3) & "\"

  9.         fd = Mid(oArgs(1), 3) & "\"

  10.     Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit

  11.     End If

  12. If oArgs.Count = 3 Then

  13.     If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") and (Left(oArgs(2),2) = "-I") Then

  14.         sd = Mid(oArgs(2), 3) & "\"

  15.         fd = Mid(oArgs(1), 3) & "\"

  16.     Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit

  17.     End If

  18. ElseIf oArgs.Count = 2 Then

  19.     If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") Then

  20.         sd = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))

  21.         fd = Mid(oArgs(1), 3) & "\"

  22.     Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit

  23.     End If

  24. ElseIf oArgs.Count = 1 Then

  25.     If oArgs(0) = "?" Then

  26.         MsgBox msg

  27.     ElseIf Left(oArgs(0),2) = "-S" Then

  28.         sd = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))

  29.         fd = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))

  30.     Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit

  31.     End If

  32. Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit

  33. End If

  34. 

  35. Dim ifile, file, fso, f, s, ss

  36. Set fso = CreateObject("Scripting.FileSystemObject")

  37. If fso.FolderExists(fd) = False Then fso.CreateFolder fd

  38. If LCase(Mid(oArgs(0), 3)) = "default" Then

  39.     If (fso.FileExists(sd & "HIVEDEF.INF")) Then

  40.         ifile = sd & "HIVEDEF.INF"

  41.         fso.CopyFile ifile,fd,true

  42.         file = fd & "HIVEDEF.INF"

  43.         Call GetFile()

  44.     End If

  45.     ElseIf LCase(Mid(oArgs(0), 3)) = "software" Then

  46.         If (fso.FileExists(sd & "HIVESFT.INF")) Then

  47.             ifile = sd & "HIVESFT.INF"

  48.             fso.CopyFile ifile,fd,true

  49.             file = fd & "HIVESFT.INF"

  50.             Call GetFile()

  51.         End If

  52.         If (fso.FileExists(sd & "HIVECLS.INF")) Then

  53.             ifile = sd & "HIVECLS.INF"

  54.             fso.CopyFile ifile,fd,true

  55.             file = fd & "HIVECLS.INF"

  56.             Call GetFile()

  57.         End If

  58.         If (fso.FileExists(sd & "HIVESXS.INF")) Then

  59.             ifile = sd & "HIVESXS.INF"

  60.             fso.CopyFile ifile,fd,true

  61.             file = fd & "HIVESXS.INF"

  62.             Call GetFile()

  63.         End If

  64.         If (fso.FileExists(sd & "DMREG.INF")) Then

  65.             ifile = sd & "DMREG.INF"

  66.             fso.CopyFile ifile,fd,true

  67.             file = fd & "DMREG.INF"

  68.             Call GetFile()

  69.         End If

  70.         If (fso.FileExists(sd & "HIVCLS32.INF")) Then

  71.             ifile = sd & "HIVCLS32.INF"

  72.             fso.CopyFile ifile,fd,true

  73.             file = fd & "HIVCLS32.INF"

  74.             Call GetFile()

  75.         End If

  76.         If (fso.FileExists(sd & "HIVSFT32.INF")) Then

  77.             ifile = sd & "HIVSFT32.INF"

  78.             fso.CopyFile ifile,fd,true

  79.             file = fd & "HIVSFT32.INF"

  80.             Call GetFile()

  81.         End If

  82.     ElseIf LCase(Mid(oArgs(0), 3)) = "setupreg.hiv" Then

  83.         If (fso.FileExists(sd & "HIVESYS.INF")) Then

  84.             ifile = sd & "HIVESYS.INF"

  85.             fso.CopyFile ifile,fd,true

  86.             file = fd & "HIVESYS.INF"

  87.             Call GetFile()

  88.         End If

  89.     Else MsgBox "The parameter isn't supported!"&vbcrlf&vbcrlf&"Must be 'default', or 'software', or 'setupreg.hiv'." : WScript.Quit

  90. End If

  91. 

  92. Function GetFile()

  93.     Set f = fso.OpenTextFile(file, 1, false, GetFileFormat(file))

  94.     s = f.ReadAll : f.Close

  95.     If file = fd & "HIVEDEF.INF" Then

  96.         s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")

  97.         s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")

  98.         s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")

  99.     End If

  100.     If file = fd & "HIVESFT.INF" Then

  101.         s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")

  102.         s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")

  103.         s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")

  104.     End If

  105.     If file = fd & "HIVESXS.INF" Then

  106.         s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")

  107.         s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")

  108.         s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")

  109.     End If

  110.     If file = fd & "HIVECLS.INF" Then

  111.         s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")

  112.         s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")

  113.         s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")

  114.         s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")

  115.         s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")

  116.     End If

  117.     If file = fd & "DMREG.INF" Then

  118.         s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")

  119.         s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")

  120.         s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")

  121.     End If

  122.     If file = fd & "HIVSFT32.INF" Then

  123.         s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")

  124.         s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")

  125.         s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")

  126.     End If

  127.     If file = fd & "HIVCLS32.INF" Then

  128.         s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")

  129.         s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")

  130.         s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")

  131.         s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")

  132.         s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")

  133.     End If

  134.     If file = fd & "HIVESYS.INF" Then

  135.         s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")

  136.         s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")

  137.         s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")

  138.     End If

  139.     fso.OpenTextFile(file, 2, true, -1).Write s

  140.     ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 128 " & file, , true

  141. End Function

  142. WScript.Quit

  143. 

  144. Function GetFileFormat(ByVal file)

  145.     Dim Bin

  146.     with CreateObject("Adodb.Stream") 

  147.         .Type = 1

  148.         .Mode = 3

  149.         .Open

  150.         .Position = 0

  151.         .Loadfromfile file

  152.         Bin = .read(2)

  153.     End with

  154.     If AscB(MidB(Bin,1,1))=&HFF and AscB(MidB(Bin,2,1))=&HFE Then

  155.         GetFileFormat = -1   ''unicode

  156.     Else GetFileFormat = 0   ''ansi

  157.     End If

  158. End Function

  159. 

  160. Function ReplaceStr(ByVal s, pattern, s1)

  161.     Dim re

  162.     If Left(s, 16) <> "[DEFAULTINSTALL]" Then

  163.         s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & s

  164.     End If

  165.     Set re = New RegExp

  166.     re.Pattern = pattern

  167.     re.Global = true

  168.     re.IgnoreCase = true

  169.     ReplaceStr = re.Replace(s, s1)

  170. End Function
复制代码
作者: 523066680    时间: 2014-8-6 19:23

holy high!
(好厉害)
作者: yuanyannian    时间: 2014-8-7 07:55

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

  2. msg = "Command prompt: HojoHE.exe -Sdefault -TD:\aa -IC:\aa\bb -L00000409"

  3. Set ws = CreateObject("WScript.Shell")

  4. Set oArgs = WScript.Arguments

  5. Select Case oArgs.Count

  6.     Case 4

  7.         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

  8.             sLoca = Mid(oArgs(3), 3)

  9.             iPath = Mid(oArgs(2), 3) & "\"

  10.             tPath = Mid(oArgs(1), 3) & "\"

  11.         Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit

  12.         End If

  13.     Case 3

  14.         If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") and (Left(oArgs(2),2) = "-I") Then

  15.             iPath = Mid(oArgs(2), 3) & "\"

  16.             tPath = Mid(oArgs(1), 3) & "\"

  17.         Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit

  18.         End If

  19.     Case 2

  20.         If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") Then

  21.             iPath = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))

  22.             tPath = Mid(oArgs(1), 3) & "\"

  23.         Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit

  24.         End If

  25.     Case 1

  26.         If oArgs(0) = "?" Then

  27.             MsgBox msg : WScript.Quit

  28.         ElseIf Left(oArgs(0),2) = "-S" Then

  29.             iPath = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))

  30.             tPath = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))

  31.         Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit

  32.         End If

  33.     Case Else MsgBox "Input error!"&vbcrlf&vbcrlf&msg : WScript.Quit

  34. End Select

  35. '35

  36. Dim file, fso, f, s, ss                    ‘’此处的 f, s 是否应该放在 Function ProcessFile() 之下？

  37. Set fso = CreateObject("Scripting.FileSystemObject")

  38. If fso.FolderExists(tPath) = False Then fso.CreateFolder tPath

  39. Dim MyArray()                             ''定义一个一维动态数组

  40. ReDim MyArray(7)                          ''定义数组大小

  41.     Select Case LCase(Mid(oArgs(0), 3))

  42.         Case "default"

  43.             MyArray(0) = "HIVEDEF.INF"    ''为数组赋值

  44.         Case "software"

  45.             MyArray(1) = "HIVESFT.INF"

  46.             MyArray(2) = "HIVECLS.INF"

  47.             MyArray(3) = "HIVESXS.INF"

  48.             MyArray(4) = "HIVCLS32.INF"

  49.             MyArray(5) = "HIVSFT32.INF"

  50.             MyArray(6) = "DMREG.INF"

  51.         Case "setupreg.hiv"

  52.             MyArray(7) = "HIVESYS.INF"

  53.         Case Else MsgBox "The parameter isn't supported!"&vbcrlf&vbcrlf&"Must be 'default', or 'software', or 'setupreg.hiv'." : WScript.Quit

  54.     End Select

  55. For i=0 To UBound(MyArray)

  56. ss = MyArray(i)                          ''循环遍历数组，并输出数组值给变量 ss

  57.     If (fso.FileExists(iPath & ss)) Then

  58.         fso.CopyFile iPath & ss,tPath,true

  59.         file = tPath & ss

  60.         Call ProcessFile()

  61.     End If

  62. Next

  63. 

  64. Function ProcessFile()

  65.     Set f = fso.OpenTextFile(file, 1, false, GetFileFormat(file))

  66.     s = f.ReadAll : f.Close

  67.     s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")     ‘’如果存在就替换，否则忽略，       这样对吗？下同

  68.     s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")

  69.     s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")

  70.     s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")

  71.     s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")

  72.     fso.OpenTextFile(file, 2, true, -1).Write s

  73. ''    ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 128 " & file, , true       ‘’此处如何判断是否安装成功，如果安装成功，如何删除 file？

  74. End Function

  75. WScript.Quit

  76. 

  77. Function GetFileFormat(ByVal file)

  78.     Dim Bin

  79.     with CreateObject("Adodb.Stream") 

  80.         .Type = 1

  81.         .Mode = 3

  82.         .Open

  83.         .Position = 0

  84.         .Loadfromfile file

  85.         Bin = .read(2)

  86.     End with

  87.     If AscB(MidB(Bin,1,1))=&HFF and AscB(MidB(Bin,2,1))=&HFE Then

  88.         GetFileFormat = -1   ''unicode

  89.     Else GetFileFormat = 0   ''ansi

  90.     End If

  91. End Function

  92. 

  93. Function ReplaceStr(ByVal s, pattern, s1)

  94.     Dim re

  95.     If Left(s, 16) <> "[DEFAULTINSTALL]" Then

  96.         s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & s

  97.     End If

  98.     Set re = New RegExp

  99.     re.Pattern = pattern

  100.     re.Global = true

  101.     re.IgnoreCase = true

  102.     ReplaceStr = re.Replace(s, s1)

  103. End Function
复制代码




欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2