[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[问题求助] [已解决]---VBS 替换注册表文件中的内容

本帖最后由 yuanyannian 于 2014-10-19 14:07 编辑

这个有点麻烦,求助高手老师们。
原文件如下:是后缀为 .reg 的注册表文件。

Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\pe-def\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders]
"AppData"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00,5c,00,41,00,70,00,70,00,6c,00,69,00,63,00,61,00,74,00,69,\
  00,6f,00,6e,00,20,00,44,00,61,00,74,00,61,00,00,00
"Desktop"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00,5c,00,4c,68,62,97,00,00
"Favorites"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00,5c,00,46,00,61,00,76,00,6f,00,72,00,69,00,74,00,65,00,73,\
  00,00,00
"NetHood"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00,5c,00,4e,00,65,00,74,00,48,00,6f,00,6f,00,64,00,00,00
"ersonal"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00,5c,00,4d,00,79,00,20,00,44,00,6f,00,63,00,75,00,6d,00,65,\
  00,6e,00,74,00,73,00,00,00
"PrintHood"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00,5c,00,50,00,72,00,69,00,6e,00,74,00,48,00,6f,00,6f,00,64,\
  00,00,00
"Programs"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00,5c,00,0c,30,00,5f,cb,59,0d,30,dc,83,55,53,5c,00,0b,7a,8f,\
  5e,00,00
"Recent"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,4c,\
  00,45,00,25,00,5c,00,52,00,65,00,63,00,65,00,6e,00,74,00,00,00
"SendTo"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,4c,\
  00,45,00,25,00,5c,00,53,00,65,00,6e,00,64,00,54,00,6f,00,00,00
"Start Menu"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,\
  00,4c,00,45,00,25,00,5c,00,0c,30,00,5f,cb,59,0d,30,dc,83,55,53,00,00
"Startup"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00,5c,00,0c,30,00,5f,cb,59,0d,30,dc,83,55,53,5c,00,0b,7a,8f,\
  5e,5c,00,2f,54,a8,52,00,00
"Templates"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00,5c,00,54,00,65,00,6d,00,70,00,6c,00,61,00,74,00,65,00,73,\
  00,00,00
"Cookies"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00,5c,00,43,00,6f,00,6f,00,6b,00,69,00,65,00,73,00,00,00
"My Pictures"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,\
  00,4c,00,45,00,25,00,5c,00,4d,00,79,00,20,00,44,00,6f,00,63,00,75,00,6d,00,\
  65,00,6e,00,74,00,73,00,5c,00,4d,00,79,00,20,00,50,00,69,00,63,00,74,00,75,\
  00,72,00,65,00,73,00,00,00
"Local Settings"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,\
  49,00,4c,00,45,00,25,00,5c,00,4c,00,6f,00,63,00,61,00,6c,00,20,00,53,00,65,\
  00,74,00,74,00,69,00,6e,00,67,00,73,00,00,00
"Local AppData"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,\
  49,00,4c,00,45,00,25,00,5c,00,4c,00,6f,00,63,00,61,00,6c,00,20,00,53,00,65,\
  00,74,00,74,00,69,00,6e,00,67,00,73,00,5c,00,41,00,70,00,70,00,6c,00,69,00,\
  63,00,61,00,74,00,69,00,6f,00,6e,00,20,00,44,00,61,00,74,00,61,00,00,00
"Cache"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,4c,\
  00,45,00,25,00,5c,00,4c,00,6f,00,63,00,61,00,6c,00,20,00,53,00,65,00,74,00,\
  74,00,69,00,6e,00,67,00,73,00,5c,00,54,00,65,00,6d,00,70,00,6f,00,72,00,61,\
  00,72,00,79,00,20,00,49,00,6e,00,74,00,65,00,72,00,6e,00,65,00,74,00,20,00,\
  46,00,69,00,6c,00,65,00,73,00,00,00
"History"=hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00,5c,00,48,00,69,00,73,00,74,00,6f,00,72,00,79,00,00,00

问题:1. 如果存在 "History" 、"Local AppData"、"NetHood"、 "Personal"、"PrintHood"、"Recent"、"Cookies"、"My Pictures"、"Local AppData" 键值,就删除所在的整个键值。
      2. 替换 "Programs" 为 "Common Programs" ,"Start Menu",为"Common Start Menu","Desktop" 为 "Common Desktop","Startup" 为 "Common Startup","AppData" 为 "Common AppData","Templates" 为 "Common Templates","Favorites" 为 "Common Favorites",其余的都删除。
      3. 替换每一个键值下的 hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00(很有规律,这段16 进制代码之后的内容不能更改)为 hex(2):25,00,41,00,4c,00,4c,00,55,00,53,00,45,00,52,00,53,00,50,00,52,00,\
  4f,00,46,00,49,00,4c,00,45,00,25,00,可以先合并行再替换。

我的思路:是否可以先合并各个键值的行为一行,再替换更好?

要求:操作中保持 .reg 格式(即 unicode 文件格式)不变,hex(2):25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\
  4c,00,45,00,25,00 之后的内容不能动。

先谢谢!
-----------------------------------------------------------------------------------------------------
感谢 apang 等老师,我的问题圆满解决。将最终代码贴上,以供需要的参考:
  1. Dim msg1, msg2, fso, ws, oArgs, iPath, tPath, sLoca, sPName, tPName
  2. msg1 = "HojoHE.exe -Sdefault -ID:\a -TE:\a\b -L00000409"
  3. msg2 = "HojoUE.exe -SC:\def.reg -TD:\sft.reg"
  4. Set fso = CreateObject("Scripting.FileSystemObject")
  5. Set ws = CreateObject("WScript.Shell")
  6. Set oArgs = WScript.Arguments
  7. If oArgs.Count >= 4 Then
  8.     If (Left(oArgs(0),2) = "-S") and (Left(oArgs(1),2) = "-I") and (Left(oArgs(2),2) = "-T") and (Left(oArgs(3),2) = "-L") Then
  9.         iPath = Mid(oArgs(1), 3) & "\"
  10.         tPath = Mid(oArgs(2), 3) & "\"
  11.         sLoca = Mid(oArgs(3), 3)
  12.         Call HojoHE()
  13.     Else MsgBox "usage:" & vbLf & vbLf & msg1
  14.     End If
  15. ElseIf oArgs.Count = 2 Then
  16.     If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") Then
  17.         sPName = Mid(oArgs(0), 3)
  18.         tPName = Mid(oArgs(1), 3)
  19.         Call ChangeRegFile()
  20.     Else MsgBox "usage:" & vbLf & vbLf & msg2
  21.     End If
  22. Else MsgBox "usage:" & vbLf & vbLf & msg1 & vbLf & "or" & vbLf & msg2
  23. End If
  24. Function HojoHE()
  25.     On Error Resume Next
  26.     Dim ar, i
  27.     If Not fso.FolderExists(tPath) Then fso.CreateFolder tPath
  28.     Select Case LCase(Mid(oArgs(0), 3))
  29.         Case "default"
  30.             fso.CopyFile iPath & "HIVEDEF.INF", tPath, true
  31.             Call ProcessFile(tPath & "HIVEDEF.INF", "default")
  32.         Case "software"
  33.             ar = Array("HIVESFT","HIVECLS","HIVESXS","HIVCLS32","HIVSFT32","DMREG")
  34.             For i = 0 to UBound(ar)
  35.                 fso.CopyFile iPath & ar(i) & ".INF", tPath, true
  36.                 Call ProcessFile(tPath & ar(i) & ".INF", "software")
  37.             Next
  38.         Case "setupreg.hiv"
  39.             ar = Array("HIVESYS","INTL")
  40.             For i = 0 to UBound(ar)
  41.                 fso.CopyFile iPath & ar(i) & ".INF", tPath, true
  42.                 Call ProcessFile(tPath & ar(i) & ".INF", "setup")
  43.             Next
  44.         Case Else MsgBox "The parameter isn't supported!" & vbLf & vbLf & "Must be 'default', or 'software', or 'setupreg.hiv'."
  45.             WScript.Quit
  46.     End Select
  47. End Function
  48. Function ChangeRegFile()
  49.     Dim f, txt, re, m, s1, s2, s
  50.     Set f = fso.OpenTextFile(sPName, 1, , -1)
  51.     txt = f.ReadAll : f.Close
  52.     Set re = New RegExp
  53.     re.Pattern = "([\s\S]*?)(^"".+"" *=[\s\S]+?)(?=^"")"
  54.     re.Global = true
  55.     re.IgnoreCase = true
  56.     re.MultiLine = true
  57.     For Each m in re.Execute(txt & vbCrLf & """")
  58.         s1 = m.SubMatches(0)
  59.         s2 = ReReplace(m.SubMatches(1))
  60.         If m.SubMatches(1) <> s2 Then
  61.             s = s & s1 & s2
  62.         Else s = s & s1
  63.         End If
  64.     Next
  65.     s1 = "25,00,41,00,4c,00,4c,00,55,00,53,00,45,00,52,00,53,00,"
  66.     re.Pattern = "(hex\(2\):)25,00,55,00,53,00,45,00,52,00,"
  67.     s = re.Replace(s, "$1" & s1)
  68.     re.Pattern = "WB-default\\Software"
  69.     s = re.Replace(s, "WB-software")
  70.     fso.OpenTextFile(tPName, 2, true, -1).Write s
  71. End Function
  72. Function ProcessFile(infFile, hivFile)
  73.     Dim f, s, lgInst, yn
  74.     Set f = fso.OpenTextFile(infFile, 1, false, GetFileFormat(infFile))
  75.     s = f.ReadAll : f.Close
  76.     s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
  77.     s = ReplaceStr(s, "HKLM, *""SYSTEM\\CurrentControlSet", "HKLM,""WB-setup\ControlSet001")
  78.     s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
  79.     s = ReplaceStr(s, "HKLM, *SYSTEM\\CurrentControlSet", "HKLM,WB-setup\ControlSet001")
  80.     s = ReplaceStr(s, "HKLM, *SYSTEM\\", "HKLM,WB-setup\")
  81.     s = ReplaceStr(s, "\\CryptSvc\\Security"",""Security"",0x00030003, *\\", "\CryptSvc\Security"",""Security"",0x00030003,00")
  82.     s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
  83.     s = ReplaceStr(s, "HKLM, *SOFTWARE\\", "HKLM,WB-software\")
  84.     s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")
  85.     s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")
  86.     If UCase(infFile) = UCase(tPath & "INTL.INF") Then
  87.         s = ReplaceStr(s, "\[" & sLoca & "\]", "[DefaultInstall]")
  88.         s = ReplaceStr(s, "CopyFile", ";CopyFile")
  89.         lgInst = Split(ProssLocales(s), ",")
  90.         s = ReplaceStr(s, "\[LG_INSTALL_(" & lgInst(0) & "|" & lgInst(1) & ")]", "[DefaultInstall]")
  91.     ElseIf Left(s, 16) <> "[DefaultInstall]" Then
  92.         s = "AddReg = AddReg.Upgrade" & vbCrLf & s
  93.         s = "AddReg = AddReg.Fresh" & vbCrLf & s
  94.         s = "AddReg = AddReg.RemoteBoot" & vbCrLf & s
  95.         s = "AddReg = AddReg" & vbCrLf & s
  96.         s = "[DefaultInstall]" & vbCrLf & s
  97.     End If
  98.     fso.OpenTextFile(infFile, 2, true, -1).Write s
  99.     On Error Resume Next
  100.     yn = ws.RegRead("HKEY_LOCAL_MACHINE\WB-" & hivFile & "\")
  101.     If yn <> 0 Then
  102.         infFile = fso.GetFile(infFile).ShortPath
  103.         ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 132 " & infFile, , true
  104.     Else MsgBox "Error, the WB-" & hivFile & " not found and exit."
  105.     End If
  106. End Function
  107. Function GetFileFormat(ByVal infFile)
  108.     Dim Bin
  109.     with CreateObject("Adodb.Stream")
  110.         .Type = 1
  111.         .Mode = 3
  112.         .Open
  113.         .Position = 0
  114.         .Loadfromfile infFile
  115.         Bin = .read(2)
  116.     End with
  117.     If AscB(MidB(Bin,1,1))=&HFF and AscB(MidB(Bin,2,1))=&HFE Then
  118.         GetFileFormat = -1   ''unicode
  119.     Else GetFileFormat = 0   ''ansi
  120.     End If
  121. End Function
  122. Function ReplaceStr(ByVal s, pattern, s1)
  123.     Dim re
  124.     Set re = New RegExp
  125.     re.Pattern = pattern
  126.     re.Global = true
  127.     re.IgnoreCase = true
  128.     ReplaceStr = re.Replace(s, s1)
  129. End Function
  130. Function ProssLocales(ByVal s)
  131.     Dim pattern1, pattern2, re, m
  132.     pattern1 = "^ *\[Locales] *$"
  133.     pattern2 = "^ *" & sLoca & " *=([^,]*,){2}([^,]*,[^,]*),.*$"
  134.     Set re = New RegExp
  135.     re.Pattern = pattern1 & "[\s\S]*?" & pattern2
  136.     re.IgnoreCase = true
  137.     re.MultiLine = true
  138.     For Each m in re.Execute(s)
  139.         ProssLocales = m.SubMatches(1)
  140.     Next
  141. End Function
  142. Function ReReplace(str)
  143.     Dim re, p
  144.     p = "Programs|Start Menu|Desktop|Startup|AppData|Templates|Favorites"
  145.     Set re = New RegExp
  146.     re.Pattern = """(" & p & ")"""
  147.     re.IgnoreCase = true
  148.     ReReplace = re.Replace(str, """Common $1""")
  149. End Function
复制代码
1

评分人数

    • Batcher: 感谢给帖子标题标注[已解决]字样PB + 2
76626yyn

回复 23# apang

非常感谢!可以结贴了。
76626yyn

TOP

回复 22# yuanyannian


   
在 117 行后面,即 MsgBox "Error, the WB-" & hivFile & " not found and exit.",不用": WScript.Quit" 可以退出吗?


你自己试下呀
加上WScript.Quit会中途强行退出,不会处理其它文件(如果有多个文件需要处理的话),这个根据需要吧。

TOP

回复 21# apang
谢谢!
可以了,把 110 到 113 行换为:
  1.     On Error Resume Next
  2.     yn = ws.RegRead("HKEY_LOCAL_MACHINE\WB-" & hivFile & "\")
  3.     If yn <> 0 Then
  4.         infFile = fso.GetFile(infFile).ShortPath
复制代码
把 52 行换为:
  1. Call ProcessFile(tPath & ar(i) & ".INF", "setup")
复制代码
应该没问题了,待进一步测试一下。

另外请教,在 117 行后面,即 MsgBox "Error, the WB-" & hivFile & " not found and exit.",不用": WScript.Quit" 可以退出吗?
76626yyn

TOP

回复 20# yuanyannian


1 我的win7无法测试注册是否成功,先注释掉第110行试试
2 少了一个参数,已修改

TOP

本帖最后由 yuanyannian 于 2014-10-17 19:34 编辑

回复 16# apang

1. 无法读取 hiveFile,导致 .INF 文件不能注册。
2. If Not infFile = tPath & "INTL.INF" Then 这行似乎无效。

再次感谢 apang 老师 !!!
76626yyn

TOP

回复 18# CrLf

当然应该,可如何加呢?
76626yyn

TOP

回复 17# yuanyannian


    那结帖后给胖大大加个分呗

TOP

非常非常感谢!!!
76626yyn

TOP

本帖最后由 apang 于 2014-10-18 00:14 编辑

回复 15# yuanyannian


    太长太乱,看得头都大,如果还有问题,请自行修改
  1. Dim msg1, msg2, fso, ws, oArgs, iPath, tPath, sLoca, sPName, tPName
  2. msg1 = "HojoHE.exe -Sdefault -ID:\a -TE:\a\b -L00000409"
  3. msg2 = "HojoUE.exe -SC:\def.reg -TD:\sft.reg"
  4. Set fso = CreateObject("Scripting.FileSystemObject")
  5. Set ws = CreateObject("WScript.Shell")
  6. Set oArgs = WScript.Arguments
  7. If oArgs.Count >= 4 Then
  8.     If (Left(oArgs(0),2) = "-S") and (Left(oArgs(1),2) = "-I") and _
  9.             (Left(oArgs(2),2) = "-T") and (Left(oArgs(3),2) = "-L") Then
  10.         iPath = Mid(oArgs(1), 3) & "\"
  11.         tPath = Mid(oArgs(2), 3) & "\"
  12.         sLoca = Mid(oArgs(3), 3)
  13.         Call HojoHE()
  14.     Else
  15.         MsgBox "usage:" & vbLf & vbLf & msg1
  16.     End If
  17. ElseIf oArgs.Count = 2 Then
  18.     If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") Then
  19.         sPName = Mid(oArgs(0), 3)
  20.         tPName = Mid(oArgs(1), 3)
  21.         Call ChangeRegFile()
  22.     Else
  23.         MsgBox "usage:" & vbLf & vbLf & msg2
  24.     End If
  25. Else
  26.     MsgBox "usage:" & vbLf & vbLf & msg1 & vbLf & "or" & vbLf & msg2
  27. End If
  28. Function HojoHE()
  29.     On Error Resume Next
  30.     Dim ar, i
  31.     If Not fso.FolderExists(tPath) Then fso.CreateFolder tPath
  32.     Select Case LCase(Mid(oArgs(0), 3))
  33.         Case "default"
  34.             fso.CopyFile iPath & "HIVEDEF.INF", tPath, true
  35.             Call ProcessFile(tPath & "HIVEDEF.INF", "default")
  36.         Case "software"
  37.             ar = Array("HIVESFT","HIVECLS","HIVESXS","HIVCLS32","HIVSFT32","DMREG")
  38.             For i = 0 to UBound(ar)
  39.                 fso.CopyFile iPath & ar(i) & ".INF", tPath, true
  40.                 Call ProcessFile(tPath & ar(i) & ".INF", "software")            
  41.             Next
  42.         Case "setupreg.hiv"
  43.             ar = Array("HIVESYS","INTL")
  44.             For i = 0 to UBound(ar)
  45.                 fso.CopyFile iPath & ar(i) & ".INF", tPath, true
  46.                 Call ProcessFile(tPath & ar(i) & ".INF", "setupreg.hiv")            
  47.             Next
  48.         Case Else
  49.             MsgBox "The parameter isn't supported!" & vbLf & vbLf & _
  50.                    "Must be 'default', or 'software', or 'setupreg.hiv'."
  51.             WScript.Quit
  52.     End Select
  53. End Function
  54. Function ChangeRegFile()
  55.     Dim f, txt, re, m, s1, s2, s
  56.     Set f = fso.OpenTextFile(sPName, 1, , -1)
  57.     txt = f.ReadAll : f.Close
  58.     Set re = New RegExp
  59.     re.Pattern = "([\s\S]*?)(^"".+"" *=[\s\S]+?)(?=^"")"
  60.     re.Global = true
  61.     re.IgnoreCase = true
  62.     re.MultiLine = true
  63.     For Each m in re.Execute(txt & vbCrLf & """")
  64.         s1 = m.SubMatches(0)
  65.         s2 = ReReplace(m.SubMatches(1))
  66.         If m.SubMatches(1) <> s2 Then
  67.             s = s & s1 & s2
  68.         Else s = s & s1
  69.         End If
  70.     Next
  71.     s1 = "25,00,41,00,4c,00,4c,00,55,00,53,00,45,00,52,00,53,00,"
  72.     re.Pattern = "(hex\(2\):)25,00,55,00,53,00,45,00,52,00,"
  73.     s = re.Replace(s, "$1" & s1)
  74.     re.Pattern = "pe-def\\Software"
  75.     s = re.Replace(s, "pe-soft")
  76.     fso.OpenTextFile(tPName, 2, true, -1).Write s
  77. End Function
  78. Function ProcessFile(infFile, hivFile)
  79.     Dim f, s, lgInst
  80.     Set f = fso.OpenTextFile(infFile, 1, false, GetFileFormat(infFile))
  81.     s = f.ReadAll : f.Close
  82.     s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
  83.     s = ReplaceStr(s, "HKLM, *""SYSTEM\\CurrentControlSet", "HKLM,""WB-setup\ControlSet001")
  84.     s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
  85.     s = ReplaceStr(s, "HKLM, *SYSTEM\\CurrentControlSet", "HKLM,WB-setup\ControlSet001")
  86.     s = ReplaceStr(s, "HKLM, *SYSTEM\\", "HKLM,WB-setup\")
  87.     s = ReplaceStr(s, "\\CryptSvc\\Security"",""Security"",0x00030003, *\\", "\CryptSvc\Security"",""Security"",0x00030003,00")
  88.     s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
  89.     s = ReplaceStr(s, "HKLM, *SOFTWARE\\", "HKLM,WB-software\")
  90.     s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")
  91.     s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")
  92.     If UCase(infFile) = UCase(tPath & "INTL.INF") Then
  93.         s = ReplaceStr(s, "\[" & sLoca & "\]", "[DefaultInstall]")
  94.         s = ReplaceStr(s, "CopyFile", ";CopyFile")
  95.         lgInst = Split(ProssLocales(s), ",")
  96.         s = ReplaceStr(s, "\[LG_INSTALL_(" & lgInst(0) & "|" & lgInst(1) & ")]", "[DefaultInstall]")
  97.     ElseIf Left(s, 16) <> "[DefaultInstall]" Then
  98.         s = "AddReg = AddReg.Upgrade" & vbCrLf & s
  99.         s = "AddReg = AddReg.Fresh" & vbCrLf & s
  100.         s = "AddReg = AddReg.RemoteBoot" & vbCrLf & s
  101.         s = "AddReg = AddReg" & vbCrLf & s
  102.         s = "[DefaultInstall]" & vbCrLf & s
  103.     End If
  104.     fso.OpenTextFile(infFile, 2, true, -1).Write s
  105.     ''ws.RegRead "HKEY_LOCAL_MACHINE\WB-" & hivFile & "\"
  106.     If Err.Number = 0 Then
  107.         Err.Clear
  108.         infFile = fso.GetFile(infFile).ShortPath
  109.         ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 132 " & infFile, , true
  110.     Else
  111.         MsgBox "Error, the WB-" & hivFile & " not found and exit."
  112.     End If
  113. End Function
  114. Function GetFileFormat(ByVal infFile)
  115.     Dim Bin
  116.     with CreateObject("Adodb.Stream")
  117.         .Type = 1
  118.         .Mode = 3
  119.         .Open
  120.         .Position = 0
  121.         .Loadfromfile infFile
  122.         Bin = .read(2)
  123.     End with
  124.     If AscB(MidB(Bin,1,1))=&HFF and AscB(MidB(Bin,2,1))=&HFE Then
  125.         GetFileFormat = -1   ''unicode
  126.     Else GetFileFormat = 0   ''ansi
  127.     End If
  128. End Function
  129. Function ReplaceStr(ByVal s, pattern, s1)
  130.     Dim re
  131.     Set re = New RegExp
  132.     re.Pattern = pattern
  133.     re.Global = true
  134.     re.IgnoreCase = true
  135.     ReplaceStr = re.Replace(s, s1)
  136. End Function
  137. Function ProssLocales(ByVal s)
  138.     Dim pattern1, pattern2, re, m
  139.     pattern1 = "^ *\[Locales] *$"
  140.     pattern2 = "^ *" & sLoca & " *=([^,]*,){2}([^,]*,[^,]*),.*$"
  141.     Set re = New RegExp
  142.     re.Pattern = pattern1 & "[\s\S]*?" & pattern2
  143.     re.IgnoreCase = true
  144.     re.MultiLine = true
  145.     For Each m in re.Execute(s)
  146.         ProssLocales = m.SubMatches(1)
  147.     Next
  148. End Function
  149. Function ReReplace(str)
  150.     Dim re, p
  151.     p = "Programs|Start Menu|Desktop|Startup|AppData|Templates|Favorites"
  152.     Set re = New RegExp
  153.     re.Pattern = """(" & p & ")"""
  154.     re.IgnoreCase = true
  155.     ReReplace = re.Replace(str, """Common $1""")
  156. End Function
复制代码
1

评分人数

    • yuanyannian: 感谢 apang 老师的无私相助。技术 + 1

TOP

回复 12# apang

apang 老师还真不愿帮忙啊?有求了!!!
76626yyn

TOP

回复 12# apang

查看了所有语言的 HKEY_LOCAL_MACHINE\pe-def\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders,几乎是一样的排列。
76626yyn

TOP

本帖最后由 yuanyannian 于 2014-10-14 06:53 编辑

回复 11# apang

理解,这已经十分感谢了!如果没有老师的无私相助,我根本无法写出来 vbs。
76626yyn

TOP

3#代码还是有点问题,如果 Programs|Start Menu|Desktop|Startup|AppData|Templates|Favorites  这7个键值中的任意一个位于reg文件的最后面,将会匹配不到而导致结果错误
  1. Set fso = CreateObject("Scripting.FileSystemObject")
  2. txt = fso.OpenTextFile("a.txt", 1, , -1).ReadAll
  3. p = "Programs|Start Menu|Desktop|Startup|AppData|Templates|Favorites"
  4. Set re = New RegExp
  5. re.Pattern = "([\s\S]*?)(^"".+"" *=[\s\S]+?)(?=^"")"
  6. re.Global = true
  7. re.MultiLine = true
  8. For Each m in re.Execute(txt & vbCrLf & """")
  9.         s1 = m.SubMatches(0)
  10.         s2 = ReReplace(m.SubMatches(1))
  11.         If m.SubMatches(1) <> s2 Then
  12.                 s = s & s1 & s2
  13.         Else s = s & s1
  14.         End If
  15. Next
  16. s1 = "25,00,41,00,4c,00,4c,00,55,00,53,00,45,00,52,00,53,00,"
  17. Set re = New RegExp
  18. re.Pattern = "(hex\(2\):)25,00,55,00,53,00,45,00,52,00,"
  19. re.Global = true
  20. re.IgnoreCase = true
  21. s = re.Replace(s, "$1" & s1)
  22. fso.OpenTextFile("b.txt", 2, true, -1).Write Left(s, Len(s)-2)
  23. Function ReReplace(str)
  24.         Set re = New RegExp
  25.         re.Pattern = """(" & p & ")"""
  26.         re.IgnoreCase = true
  27.         ReReplace = re.Replace(str, """Common $1""")
  28. End Function
复制代码

TOP

回复 10# yuanyannian


    需要判断参数个数,蛋疼,相当蛋疼,恕不能帮忙
1

评分人数

    • CrLf: 看描述就醉了,蛋蛋隐隐作痛技术 + 1

TOP

返回列表