Board logo

标题: [技术讨论] 回报批处理之家---VBS处理 unicode、inf文件回帖 [打印本页]

作者: yuanyannian    时间: 2014-11-22 11:44     标题: 回报批处理之家---VBS处理 unicode、inf文件回帖

本帖是本人对批处理之家的回报贴。即,将近一段时期本人求助并得以解决的成熟代码汇报给论坛,本人不可独享,留存在论坛中,以提供给需要者。
这些代码主要是针对 Unicode 格式的 INF 文件的处理。

感谢批处理之家提供的平台,使得相应问题能够得以圆满解决。
再次感谢 apang 等老师的无私相助。

1. 接收外部参数,查找替换
  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 : WScript.Quit
  21.     End If
  22. Else MsgBox "usage:" & vbLf & vbLf & msg1 & vbLf & "or" & vbLf & msg2 : WScript.Quit
  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'." : WScript.Quit
  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." : WScript.Quit
  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
复制代码
2. 内部变量查找,写入 reg 文件
  1. Dim msg, ws, oArgs, sName, sPath, tPath
  2. msg = "HojoRV.exe -SN""HIVESFT.INF"" -TN""Revise.reg"" -SP""D:\a"" -TP""E:\aa\bb"""
  3. Set ws = CreateObject("WScript.Shell")
  4. Set oArgs = WScript.Arguments
  5. If oArgs.Count = 4 Then
  6.     If (Left(oArgs(0),3) = "-SN") and (Left(oArgs(1),3) = "-TN") and (Left(oArgs(2),3) = "-SP") and (Left(oArgs(3),3) = "-TP") Then
  7.         sName = UCase(Mid(oArgs(0), 4))
  8.         tName = UCase(Mid(oArgs(1), 4))
  9.         sPath = UCase(Mid(oArgs(2), 4)) & "\"
  10.         tPath = UCase(Mid(oArgs(3), 4)) & "\"
  11.     Else MsgBox "Usage:" & vbLf & vbLf & msg : WScript.Quit
  12.     End If
  13. Else MsgBox "Usage:" & vbLf & vbLf & msg : WScript.Quit
  14. End If
  15. Dim sR, strSection, arField, arValue, arPath
  16. sR = "HKEY_LOCAL_MACHINE\"
  17. strSection = "Strings"
  18. If sName = "WIN95UPG.INF" Then
  19.     arField = Array("BIOS","FLOP","ISAPNP","MF","MONITOR","NETWORK","PCI","ROOT","SCSI","VIRTUAL","PCMCIA","MCA")
  20.     arValue = Array("@", "@", "@", """yyn1""", """yyn2""", """yyn3""", """yyn4""", """yyn5""", """wwwwwwwww""", """sssssssssss""", """wwww_ddd", """yyn6""")
  21.     arPath = Array(sR&"pe-soft\yyn\Desktop", sR&"pe-soft\yyn\Test", sR&"pe-soft\yyn\Test\yyn", sR&"pe-soft\yyn\www", sR&"pe-soft\yyn\Test\rrr", sR&"pe-soft\yyn\trtr\trtr", _
  22.             sR&"pe-soft\yyn\Test\yyn\ddd", sR&"pe-soft\yyn\ddddd", sR&"pe-soft\yyn\Test\yyn\fgfg", sR&"pe-soft\yyn\Test\uiuiu", sR&"pe-soft\yyn\Test\yyn\kkkk", sR&"pe-soft\yyn\ghghg")
  23. End If
  24. If sName = "HIVESFT.INF" Then
  25.     arField = Array("BIOS","FLOP","ISAPNP","MF","MONITOR","NETWORK","PCI","ROOT","SCSI","VIRTUAL","PCMCIA","MCA")
  26.     arValue = Array("@", "@", "@", """yyn1""", """yyn2""", """yyn3""", """yyn4""", """yyn5""", """wwwwwwwww""", """sssssssssss""", """wwww_ddd", """yyn6""")
  27.     arPath = Array(sR&"pe-soft\yyn\Desktop", sR&"pe-soft\yyn\Test", sR&"pe-soft\yyn\Test\yyn", sR&"pe-soft\yyn\www", sR&"pe-soft\yyn\Test\rrr", sR&"pe-soft\yyn\trtr\trtr", _
  28.             sR&"pe-soft\yyn\Test\yyn\ddd", sR&"pe-soft\yyn\ddddd", sR&"pe-soft\yyn\Test\yyn\fgfg", sR&"pe-soft\yyn\Test\uiuiu", sR&"pe-soft\yyn\Test\yyn\kkkk", sR&"pe-soft\yyn\ghghg")
  29. End If
  30. Dim fso, txt, re, i, regData
  31. Set fso = CreateObject("Scripting.FileSystemObject")
  32. txt = fso.OpenTextFile(sPath & sName, 1, false, -1).ReadAll
  33. txt = txt & vbCrLf & "["
  34. Set re = New RegExp
  35. re.Pattern = "^ *\[" & strSection & "] *$[\s\S]*?(?=^ *\[)"
  36. re.IgnoreCase = true
  37. re.Global = true
  38. re.MultiLine = true
  39. If Not re.Test(txt) Then WScript.Quit
  40. txt = re.Execute(txt)(0)
  41. For i = 0 to UBound(arField)
  42.     re.Pattern = "^ *" & arField(i) & " *= *([^\r\n]+)"
  43. ''    re.Pattern = "^ *" & arField(i) & " *= *(.*)"
  44.     If re.Test(txt) Then
  45.         regData = re.Execute(txt)(0).SubMatches(0)
  46.         regData = chr(34) & Replace(regData, chr(34), "") & chr(34)
  47.         s = s & "[" & arPath(i) & "]" & vbCrLf
  48.         s = s & arValue(i) & "=" & regData & vbCrLf
  49.         s = s & vbCrLf
  50.     End If
  51. Next
  52. s = "Windows Registry Editor Version 5.00" & vbCrLf & vbCrLf & s
  53. fso.OpenTextFile(tPath & tName, 2, true, -1).Write s
复制代码
3. 快捷方式建立,更改文件及文件夹属性
  1. Dim oArgs, sType, sName, sPathA, sPathB, sPathC, sDest
  2. Msg1 = "ShortcutBuild.exe -ST[Shortcut Type] -SN[Shortcut Name] -PA[Users Path] -PB[Icon Path] -PC[Target Path] -D[Desript]"
  3. Msg2 = "Shortcut Type: Desktop/StartMenu/Programs/QuickLaunch/Accessories"
  4. Set oArgs = WScript.Arguments
  5. If oArgs.Count >= 6 Then
  6.     If Left(oArgs(0),3) = "-ST" and (Left(oArgs(1),3) = "-SN") and (Left(oArgs(2),3) = "-PA") and (Left(oArgs(3),3) = "-PB") and _
  7.         (Left(oArgs(4),3) = "-PC") and (Left(oArgs(5),2) = "-D") Then
  8.         sType = Mid(oArgs(0), 4)
  9.         sName = Mid(oArgs(1), 4)
  10.         sPathA = Mid(oArgs(2), 4)
  11.         sPathB = Mid(oArgs(3), 4)
  12.         sPathC = Mid(oArgs(4), 4)
  13.         sDest = Mid(oArgs(5), 3)
  14.     Else MsgBox "Usage:"& vbcrlf & vbcrlf & Msg1 & vbcrlf & Msg2 : WScript.Quit
  15.     End If
  16. Else MsgBox "Usage:"& vbcrlf & vbcrlf & Msg1 & vbcrlf & Msg2 : WScript.Quit
  17. End If
  18. Dim fso, stPath, stName, menuPath, progPath, progName
  19. Set fso = CreateObject("Scripting.FileSystemObject")
  20. Set WshShell = WScript.CreateObject("WScript.Shell")
  21. Select Case LCase(Mid(oArgs(0), 4))
  22.     Case "desktop"
  23.         stPath = sPathA & "\Users\Default\desktop"
  24.         stName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21769"
  25.         Call ProcessShortcut()
  26.     Case "programs"
  27.         menuPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu"
  28.         menuName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21786"
  29.         stPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs"
  30.         stName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21782"
  31.         Call ProcessShortcut()
  32.     Case "accessories"
  33.         menuPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu"
  34.         menuName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21786"
  35.         progPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs"
  36.         progName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21782"
  37.         stPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Accessories"
  38.         stName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21761"
  39.         Call ProcessShortcut()
  40.     Case "administrativetools"
  41.         menuPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu"
  42.         menuName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21786"
  43.         progPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs"
  44.         progName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21782"
  45.         stPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Administrative Tools"
  46.         stName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21762"
  47.         Call ProcessShortcut()
  48.     Case "startmenu"
  49.         stPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\User Pinned\StartMenu"
  50.         Call ProcessShortcut()
  51.     Case "taskbar"
  52.         stPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar"
  53.         Call ProcessShortcut()
  54.     Case Else
  55.         MsgBox "Usage:" & vbLf & vbLf & Msg2 : WScript.Quit
  56. End Select
  57. Function ProcessShortcut()
  58.     Dim sla, getPath, newPath, workPath, lnkFile
  59.     sla = "\"
  60.     getPath = split(stPath, sla)
  61.     For i = 1 to Ubound(getPath)
  62.         newPath = newPath & sla & getPath(i)
  63.         If Not fso.FolderExists(getPath(0) & sla & newPath) Then
  64.             fso.CreateFolder(getPath(0) & sla & newPath)
  65.         End If
  66.     Next
  67.     Set oShellLink = WshShell.CreateShortcut(stPath & "\" & sName & ".lnk")
  68.     oShellLink.IconLocation = sPathB
  69.     oShellLink.TargetPath = sPathC
  70.     If LCase(Mid(oArgs(1), 4)) = "windows explorer" Then
  71.         workPath = ""
  72.     Else workPath = "%HOMEDRIVE%%HOMEPATH%"
  73.     End If
  74.     oShellLink.WorkingDirectory = workPath
  75.     oShellLink.WindowStyle = 1
  76.     oShellLink.Description = sDest
  77.     lnkFile = stPath & "\" & sName & ".lnk"
  78.     If fso.FileExists(lnkFile) Then
  79.         Call ProcessDesktop()
  80.     Else
  81.         oShellLink.Save
  82.         Call ProcessDesktop()
  83.     End if
  84. End Function
  85. Function ProcessDesktop()
  86.     Dim iniFile, locName, fi
  87.     iniFile = stPath & "\" & "desktop.ini"
  88.     If LCase(sName) = "windows explorer" Then locName = "Windows Explorer.lnk=@X:\WXPE\system32\shell32.dll,-22067"
  89.     If LCase(sName) = "command prompt" Then locName = "Command Prompt.lnk=@X:\WXPE\system32\shell32.dll,-22022"
  90.     If LCase(sName) = "notepad" Then locName = "Notepad.lnk=@X:\WXPE\system32\shell32.dll,-22051"
  91.     If LCase(sName) = "regedit" Then locName = "Regedit.lnk=@X:\WXPE\regedit.exe,-16"
  92.     If LCase(sName) = "remote desktop connection" Then locName = "Remote Desktop Connection.lnk=@X:\WXPE\system32\mstsc.exe,-4000"
  93.     If LCase(sName) = "wordpad" Then locName = "Wordpad.lnk=@X:\WXPE\system32\shell32.dll,-22069"
  94.     If LCase(sName) = "calculator" Then locName = "Calculator.lnk=@X:\WXPE\system32\shell32.dll,-22019"
  95.     If LCase(sName) = "mspaint" Then locName = "Mspaint.lnk=@X:\WXPE\system32\shell32.dll,-22054"
  96.     If LCase(sName) = "component services" Then locName = "Component Services.lnk=@X:\WXPE\system32\comres.dll,-3410"
  97.     If LCase(sName) = "computer management" Then locName = "Computer Management.lnk=@X:\WXPE\system32\mycomput.dll,-300"
  98.     If LCase(sName) = "services" Then locName = "services.lnk=@X:\WXPE\system32\filemgmt.dll,-2204"
  99.     If LCase(sName) = "event viewer" Then locName = "Event Viewer.lnk=@X:\WXPE\system32\shell32.dll,-22029"
  100.     If LCase(sName) = "disk management" Then locName = "Disk management.lnk=@X:\WXPE\system32\dmdskres.dll,-1003"
  101.     If LCase(sName) = "device management" Then locName = "Device management.lnk=@X:\WXPE\system32\devmgr.dll,-4"
  102.     If LCase(sName) = "task management" Then locName = "Task management.lnk=@X:\WXPE\system32\taskmgr.exe,-32420"
  103.     If Not LCase(sType) = "desktop" Then
  104.         If Not LCase(sType) = "startmenu" Then
  105.             If Not LCase(sType) = "taskbar" Then Call ProcessMdesktop()
  106.         End If
  107.     End If
  108.     If fso.FileExists(iniFile) Then
  109.         Const ForAppending = 8
  110.         Set fi = fso.OpenTextFile(iniFile, ForAppending)
  111.         If Not LCase(sType) = "startmenu" Then
  112.             If Not LCase(sType) = "taskbar" Then
  113.                 If InStr(fso.OpenTextFile(iniFile).ReadAll(), "[.ShellClassInfo]") = 0 Then fi.WriteLine("[.ShellClassInfo]")
  114.                 If InStr(fso.OpenTextFile(iniFile).ReadAll(), stName) = 0 Then fi.WriteLine(stName)
  115.             End If
  116.         End If
  117.         If InStr(fso.OpenTextFile(iniFile).ReadAll(), "[LocalizedFileNames]") = 0 Then fi.WriteLine("[LocalizedFileNames]")
  118.         If InStr(fso.OpenTextFile(iniFile).ReadAll(), locName) = 0 Then fi.WriteLine(locName)
  119.         fi.Close
  120.     Else
  121.         Set fi = fso.CreateTextFile(iniFile, True)
  122.         If Not LCase(sType) = "startmenu" Then
  123.             If Not LCase(sType) = "taskbar" Then
  124.                 fi.WriteLine("[.ShellClassInfo]")
  125.                 fi.WriteLine(stName)
  126.             End If
  127.         End If
  128.         fi.WriteLine("[LocalizedFileNames]")
  129.         fi.WriteLine(locName)
  130.         fi.Close
  131.     End If
  132.     Call ProcessAttrib()
  133. End Function
  134. Function ProcessMdesktop()
  135.     Dim piniFile, fprog, miniFile, fmenu
  136.     If Not LCase(sType) = "programs" Then
  137.         piniFile = progPath & "\" & "desktop.ini"
  138.         If fso.FileExists(piniFile) Then
  139.             Const ForAppending = 8
  140.             Set fprog = fso.OpenTextFile(piniFile, ForAppending)
  141.             If InStr(fso.OpenTextFile(piniFile).ReadAll(), "[.ShellClassInfo]") = 0 Then fprog.WriteLine("[.ShellClassInfo]")
  142.             If InStr(fso.OpenTextFile(piniFile).ReadAll(), progName) = 0 Then fprog.WriteLine(progName)
  143.             fprog.Close
  144.         Else
  145.             Set fprog = fso.CreateTextFile(piniFile, True)
  146.             fprog.WriteLine("[.ShellClassInfo]")
  147.             fprog.WriteLine(progName)
  148.             fprog.Close
  149.         End If
  150.     End If
  151.     miniFile = menuPath & "\" & "desktop.ini"
  152.     If fso.FileExists(miniFile) Then
  153.         Set fmenu = fso.OpenTextFile(miniFile, ForAppending)
  154.         If InStr(fso.OpenTextFile(miniFile).ReadAll(), "[.ShellClassInfo]") = 0 Then fmenu.WriteLine("[.ShellClassInfo]")
  155.         If InStr(fso.OpenTextFile(miniFile).ReadAll(), menuName) = 0 Then fmenu.WriteLine(menuName)
  156.         fmenu.Close
  157.     Else
  158.         Set fmenu = fso.CreateTextFile(miniFile, True)
  159.         fmenu.WriteLine("[.ShellClassInfo]")
  160.         fmenu.WriteLine(menuName)
  161.         fmenu.Close
  162.     End If
  163. End Function
  164. Function ProcessAttrib()
  165.     Dim fst, fstP, menuIni, menuP, progIni, progP
  166.     Set fst = fso.GetFile(stPath & "\" & "desktop.ini")
  167.     fst.Attributes = 2
  168.     Set fstP = fso.GetFolder(stPath)
  169.     If fstP.Attributes = 16 Then
  170.         fstP.Attributes = 16+4
  171.     End If
  172.     If LCase(sType) = "programs" Then
  173.         Set menuIni = fso.GetFile(menuPath & "\" & "desktop.ini")
  174.         menuIni.Attributes = 2
  175.         Set menuP = fso.GetFolder(menuPath)
  176.         If menuP.Attributes = 16 Then
  177.             menuP.Attributes = 16+4
  178.         End If
  179.     End If
  180.     If LCase(sType) = "accessories" Then
  181.         Set progIni = fso.GetFile(progPath & "\" & "desktop.ini")
  182.         progIni.Attributes = 2
  183.         Set progP = fso.GetFolder(progPath)
  184.         If progP.Attributes = 16 Then
  185.             progP.Attributes = 16+4
  186.         End If
  187.         Set menuIni = fso.GetFile(menuPath & "\" & "desktop.ini")
  188.         menuIni.Attributes = 2
  189.         Set menuP = fso.GetFolder(menuPath)
  190.         If menuP.Attributes = 16 Then
  191.             menuP.Attributes = 16+4
  192.         End If
  193.     End If
  194.     If LCase(sType) = "administrativetools" Then
  195.         Set progIni = fso.GetFile(progPath & "\" & "desktop.ini")
  196.         progIni.Attributes = 2
  197.         Set progP = fso.GetFolder(progPath)
  198.         If progP.Attributes = 16 Then
  199.             progP.Attributes = 16+4
  200.         End If
  201.         Set menuIni = fso.GetFile(menuPath & "\" & "desktop.ini")
  202.         menuIni.Attributes = 2
  203.         Set menuP = fso.GetFolder(menuPath)
  204.         If menuP.Attributes = 16 Then
  205.             menuP.Attributes = 16+4
  206.         End If
  207.     End If
  208. End Function
复制代码

作者: ygqiang    时间: 2014-11-28 23:47

本帖是本人对批处理之家的回报贴。即,将近一段时期本人求助并得以解决的成熟代码汇报给论坛,本人不可独享 ...
yuanyannian 发表于 2014-11-22 11:44


你的vbs代码,到底是实现啥功能的?
作者: g495326    时间: 2014-12-29 09:04

您的技术确实得到了提高。
我认为不写用法和注释的代码称不上回报贴。




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