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. 

  25. Function HojoHE()

  26.     On Error Resume Next

  27.     Dim ar, i

  28.     If Not fso.FolderExists(tPath) Then fso.CreateFolder tPath

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

  30.         Case "default"

  31.             fso.CopyFile iPath & "HIVEDEF.INF", tPath, true

  32.             Call ProcessFile(tPath & "HIVEDEF.INF", "default")

  33.         Case "software"

  34.             ar = Array("HIVESFT","HIVECLS","HIVESXS","HIVCLS32","HIVSFT32","DMREG")

  35.             For i = 0 to UBound(ar)

  36.                 fso.CopyFile iPath & ar(i) & ".INF", tPath, true

  37.                 Call ProcessFile(tPath & ar(i) & ".INF", "software")

  38.             Next

  39.         Case "setupreg.hiv"

  40.             ar = Array("HIVESYS","INTL")

  41.             For i = 0 to UBound(ar)

  42.                 fso.CopyFile iPath & ar(i) & ".INF", tPath, true

  43.                 Call ProcessFile(tPath & ar(i) & ".INF", "setup")

  44.             Next

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

  46.             WScript.Quit

  47.     End Select

  48. End Function

  49. 

  50. Function ChangeRegFile()

  51.     Dim f, txt, re, m, s1, s2, s

  52.     Set f = fso.OpenTextFile(sPName, 1, , -1)

  53.     txt = f.ReadAll : f.Close

  54.     Set re = New RegExp

  55.     re.Pattern = "([\s\S]*?)(^"".+"" *=[\s\S]+?)(?=^"")"

  56.     re.Global = true

  57.     re.IgnoreCase = true

  58.     re.MultiLine = true

  59.     For Each m in re.Execute(txt & vbCrLf & """")

  60.         s1 = m.SubMatches(0)

  61.         s2 = ReReplace(m.SubMatches(1))

  62.         If m.SubMatches(1) <> s2 Then

  63.             s = s & s1 & s2

  64.         Else s = s & s1

  65.         End If

  66.     Next

  67.     s1 = "25,00,41,00,4c,00,4c,00,55,00,53,00,45,00,52,00,53,00,"

  68.     re.Pattern = "(hex\(2\):)25,00,55,00,53,00,45,00,52,00,"

  69.     s = re.Replace(s, "$1" & s1)

  70.     re.Pattern = "WB-default\\Software"

  71.     s = re.Replace(s, "WB-software")

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

  73. End Function

  74. 

  75. Function ProcessFile(infFile, hivFile)

  76.     Dim f, s, lgInst, yn

  77.     Set f = fso.OpenTextFile(infFile, 1, false, GetFileFormat(infFile))

  78.     s = f.ReadAll : f.Close

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

  80.     s = ReplaceStr(s, "HKLM, *""SYSTEM\\CurrentControlSet", "HKLM,""WB-setup\ControlSet001")

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

  82.     s = ReplaceStr(s, "HKLM, *SYSTEM\\CurrentControlSet", "HKLM,WB-setup\ControlSet001")

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

  84.     s = ReplaceStr(s, "\\CryptSvc\\Security"",""Security"",0x00030003, *\\", "\CryptSvc\Security"",""Security"",0x00030003,00")

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

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

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

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

  89.     If UCase(infFile) = UCase(tPath & "INTL.INF") Then

  90.         s = ReplaceStr(s, "\[" & sLoca & "\]", "[DefaultInstall]")

  91.         s = ReplaceStr(s, "CopyFile", ";CopyFile")

  92.         lgInst = Split(ProssLocales(s), ",")

  93.         s = ReplaceStr(s, "\[LG_INSTALL_(" & lgInst(0) & "|" & lgInst(1) & ")]", "[DefaultInstall]")

  94.     ElseIf Left(s, 16) <> "[DefaultInstall]" Then

  95.         s = "AddReg = AddReg.Upgrade" & vbCrLf & s

  96.         s = "AddReg = AddReg.Fresh" & vbCrLf & s

  97.         s = "AddReg = AddReg.RemoteBoot" & vbCrLf & s

  98.         s = "AddReg = AddReg" & vbCrLf & s

  99.         s = "[DefaultInstall]" & vbCrLf & s

  100.     End If

  101.     fso.OpenTextFile(infFile, 2, true, -1).Write s

  102.     On Error Resume Next

  103.     yn = ws.RegRead("HKEY_LOCAL_MACHINE\WB-" & hivFile & "\")

  104.     If yn <> 0 Then

  105.         infFile = fso.GetFile(infFile).ShortPath

  106.         ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 132 " & infFile, , true

  107.     Else MsgBox "Error, the WB-" & hivFile & " not found and exit." : WScript.Quit

  108.     End If

  109. End Function

  110. 

  111. Function GetFileFormat(ByVal infFile)

  112.     Dim Bin

  113.     with CreateObject("Adodb.Stream")

  114.         .Type = 1

  115.         .Mode = 3

  116.         .Open

  117.         .Position = 0

  118.         .Loadfromfile infFile

  119.         Bin = .read(2)

  120.     End with

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

  122.         GetFileFormat = -1   ''unicode

  123.     Else GetFileFormat = 0   ''ansi

  124.     End If

  125. End Function

  126. 

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

  128.     Dim re

  129.     Set re = New RegExp

  130.     re.Pattern = pattern

  131.     re.Global = true

  132.     re.IgnoreCase = true

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

  134. End Function

  135. 

  136. Function ProssLocales(ByVal s)

  137.     Dim pattern1, pattern2, re, m

  138.     pattern1 = "^ *\[Locales] *$"

  139.     pattern2 = "^ *" & sLoca & " *=([^,]*,){2}([^,]*,[^,]*),.*$"

  140.     Set re = New RegExp

  141.     re.Pattern = pattern1 & "[\s\S]*?" & pattern2

  142.     re.IgnoreCase = true

  143.     re.MultiLine = true

  144.     For Each m in re.Execute(s)

  145.         ProssLocales = m.SubMatches(1)

  146.     Next

  147. End Function

  148. 

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

  16. Dim sR, strSection, arField, arValue, arPath

  17. sR = "HKEY_LOCAL_MACHINE\"

  18. strSection = "Strings"

  19. 

  20. If sName = "WIN95UPG.INF" Then

  21.     arField = Array("BIOS","FLOP","ISAPNP","MF","MONITOR","NETWORK","PCI","ROOT","SCSI","VIRTUAL","PCMCIA","MCA")

  22.     arValue = Array("@", "@", "@", """yyn1""", """yyn2""", """yyn3""", """yyn4""", """yyn5""", """wwwwwwwww""", """sssssssssss""", """wwww_ddd", """yyn6""")

  23.     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", _

  24.             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")

  25. End If

  26. 

  27. If sName = "HIVESFT.INF" Then

  28.     arField = Array("BIOS","FLOP","ISAPNP","MF","MONITOR","NETWORK","PCI","ROOT","SCSI","VIRTUAL","PCMCIA","MCA")

  29.     arValue = Array("@", "@", "@", """yyn1""", """yyn2""", """yyn3""", """yyn4""", """yyn5""", """wwwwwwwww""", """sssssssssss""", """wwww_ddd", """yyn6""")

  30.     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", _

  31.             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")

  32. End If

  33. 

  34. Dim fso, txt, re, i, regData

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

  36. txt = fso.OpenTextFile(sPath & sName, 1, false, -1).ReadAll

  37. txt = txt & vbCrLf & "["

  38. Set re = New RegExp

  39. re.Pattern = "^ *\[" & strSection & "] *$[\s\S]*?(?=^ *\[)"

  40. re.IgnoreCase = true

  41. re.Global = true

  42. re.MultiLine = true

  43. If Not re.Test(txt) Then WScript.Quit

  44. txt = re.Execute(txt)(0)

  45. For i = 0 to UBound(arField)

  46.     re.Pattern = "^ *" & arField(i) & " *= *([^\r\n]+)"

  47. ''    re.Pattern = "^ *" & arField(i) & " *= *(.*)"

  48.     If re.Test(txt) Then

  49.         regData = re.Execute(txt)(0).SubMatches(0)

  50.         regData = chr(34) & Replace(regData, chr(34), "") & chr(34)

  51.         s = s & "[" & arPath(i) & "]" & vbCrLf

  52.         s = s & arValue(i) & "=" & regData & vbCrLf

  53.         s = s & vbCrLf

  54.     End If

  55. Next

  56. s = "Windows Registry Editor Version 5.00" & vbCrLf & vbCrLf & s

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

  19. Dim fso, stPath, stName, menuPath, progPath, progName

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

  21. Set WshShell = WScript.CreateObject("WScript.Shell")

  22. Select Case LCase(Mid(oArgs(0), 4))

  23.     Case "desktop"

  24.         stPath = sPathA & "\Users\Default\desktop"

  25.         stName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21769"

  26.         Call ProcessShortcut()

  27.     Case "programs"

  28.         menuPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu"

  29.         menuName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21786"

  30.         stPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs"

  31.         stName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21782"

  32.         Call ProcessShortcut()

  33.     Case "accessories"

  34.         menuPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu"

  35.         menuName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21786"

  36.         progPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs"

  37.         progName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21782"

  38.         stPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Accessories"

  39.         stName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21761"

  40.         Call ProcessShortcut()

  41.     Case "administrativetools"

  42.         menuPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu"

  43.         menuName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21786"

  44.         progPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs"

  45.         progName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21782"

  46.         stPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Administrative Tools"

  47.         stName = "LocalizedResourceName=@X:\WXPE\System32\shell32.dll,-21762"

  48.         Call ProcessShortcut()

  49.     Case "startmenu"

  50.         stPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\User Pinned\StartMenu"

  51.         Call ProcessShortcut()

  52.     Case "taskbar"

  53.         stPath = sPathA & "\Users\Default\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar"

  54.         Call ProcessShortcut()

  55.     Case Else

  56.         MsgBox "Usage:" & vbLf & vbLf & Msg2 : WScript.Quit

  57. End Select

  58. 

  59. Function ProcessShortcut()

  60.     Dim sla, getPath, newPath, workPath, lnkFile

  61.     sla = "\"

  62.     getPath = split(stPath, sla)

  63.     For i = 1 to Ubound(getPath)

  64.         newPath = newPath & sla & getPath(i)

  65.         If Not fso.FolderExists(getPath(0) & sla & newPath) Then

  66.             fso.CreateFolder(getPath(0) & sla & newPath)

  67.         End If

  68.     Next

  69.     Set oShellLink = WshShell.CreateShortcut(stPath & "\" & sName & ".lnk")

  70.     oShellLink.IconLocation = sPathB

  71.     oShellLink.TargetPath = sPathC

  72.     If LCase(Mid(oArgs(1), 4)) = "windows explorer" Then

  73.         workPath = ""

  74.     Else workPath = "%HOMEDRIVE%%HOMEPATH%"

  75.     End If

  76.     oShellLink.WorkingDirectory = workPath

  77.     oShellLink.WindowStyle = 1

  78.     oShellLink.Description = sDest

  79.     lnkFile = stPath & "\" & sName & ".lnk"

  80.     If fso.FileExists(lnkFile) Then

  81.         Call ProcessDesktop()

  82.     Else

  83.         oShellLink.Save

  84.         Call ProcessDesktop()

  85.     End if

  86. End Function

  87. 

  88. Function ProcessDesktop()

  89.     Dim iniFile, locName, fi

  90.     iniFile = stPath & "\" & "desktop.ini"

  91.     If LCase(sName) = "windows explorer" Then locName = "Windows Explorer.lnk=@X:\WXPE\system32\shell32.dll,-22067"

  92.     If LCase(sName) = "command prompt" Then locName = "Command Prompt.lnk=@X:\WXPE\system32\shell32.dll,-22022"

  93.     If LCase(sName) = "notepad" Then locName = "Notepad.lnk=@X:\WXPE\system32\shell32.dll,-22051"

  94.     If LCase(sName) = "regedit" Then locName = "Regedit.lnk=@X:\WXPE\regedit.exe,-16"

  95.     If LCase(sName) = "remote desktop connection" Then locName = "Remote Desktop Connection.lnk=@X:\WXPE\system32\mstsc.exe,-4000"

  96.     If LCase(sName) = "wordpad" Then locName = "Wordpad.lnk=@X:\WXPE\system32\shell32.dll,-22069"

  97.     If LCase(sName) = "calculator" Then locName = "Calculator.lnk=@X:\WXPE\system32\shell32.dll,-22019"

  98.     If LCase(sName) = "mspaint" Then locName = "Mspaint.lnk=@X:\WXPE\system32\shell32.dll,-22054"

  99.     If LCase(sName) = "component services" Then locName = "Component Services.lnk=@X:\WXPE\system32\comres.dll,-3410"

  100.     If LCase(sName) = "computer management" Then locName = "Computer Management.lnk=@X:\WXPE\system32\mycomput.dll,-300"

  101.     If LCase(sName) = "services" Then locName = "services.lnk=@X:\WXPE\system32\filemgmt.dll,-2204"

  102.     If LCase(sName) = "event viewer" Then locName = "Event Viewer.lnk=@X:\WXPE\system32\shell32.dll,-22029"

  103.     If LCase(sName) = "disk management" Then locName = "Disk management.lnk=@X:\WXPE\system32\dmdskres.dll,-1003"

  104.     If LCase(sName) = "device management" Then locName = "Device management.lnk=@X:\WXPE\system32\devmgr.dll,-4"

  105.     If LCase(sName) = "task management" Then locName = "Task management.lnk=@X:\WXPE\system32\taskmgr.exe,-32420"

  106.     If Not LCase(sType) = "desktop" Then

  107.         If Not LCase(sType) = "startmenu" Then

  108.             If Not LCase(sType) = "taskbar" Then Call ProcessMdesktop()

  109.         End If

  110.     End If

  111.     If fso.FileExists(iniFile) Then

  112.         Const ForAppending = 8

  113.         Set fi = fso.OpenTextFile(iniFile, ForAppending)

  114.         If Not LCase(sType) = "startmenu" Then

  115.             If Not LCase(sType) = "taskbar" Then

  116.                 If InStr(fso.OpenTextFile(iniFile).ReadAll(), "[.ShellClassInfo]") = 0 Then fi.WriteLine("[.ShellClassInfo]")

  117.                 If InStr(fso.OpenTextFile(iniFile).ReadAll(), stName) = 0 Then fi.WriteLine(stName)

  118.             End If

  119.         End If

  120.         If InStr(fso.OpenTextFile(iniFile).ReadAll(), "[LocalizedFileNames]") = 0 Then fi.WriteLine("[LocalizedFileNames]")

  121.         If InStr(fso.OpenTextFile(iniFile).ReadAll(), locName) = 0 Then fi.WriteLine(locName)

  122.         fi.Close

  123.     Else

  124.         Set fi = fso.CreateTextFile(iniFile, True)

  125.         If Not LCase(sType) = "startmenu" Then

  126.             If Not LCase(sType) = "taskbar" Then

  127.                 fi.WriteLine("[.ShellClassInfo]")

  128.                 fi.WriteLine(stName)

  129.             End If

  130.         End If

  131.         fi.WriteLine("[LocalizedFileNames]")

  132.         fi.WriteLine(locName)

  133.         fi.Close

  134.     End If

  135.     Call ProcessAttrib()

  136. End Function

  137. 

  138. Function ProcessMdesktop()

  139.     Dim piniFile, fprog, miniFile, fmenu

  140.     If Not LCase(sType) = "programs" Then

  141.         piniFile = progPath & "\" & "desktop.ini"

  142.         If fso.FileExists(piniFile) Then

  143.             Const ForAppending = 8

  144.             Set fprog = fso.OpenTextFile(piniFile, ForAppending)

  145.             If InStr(fso.OpenTextFile(piniFile).ReadAll(), "[.ShellClassInfo]") = 0 Then fprog.WriteLine("[.ShellClassInfo]")

  146.             If InStr(fso.OpenTextFile(piniFile).ReadAll(), progName) = 0 Then fprog.WriteLine(progName)

  147.             fprog.Close

  148.         Else

  149.             Set fprog = fso.CreateTextFile(piniFile, True)

  150.             fprog.WriteLine("[.ShellClassInfo]")

  151.             fprog.WriteLine(progName)

  152.             fprog.Close

  153.         End If

  154.     End If

  155.     miniFile = menuPath & "\" & "desktop.ini"

  156.     If fso.FileExists(miniFile) Then

  157.         Set fmenu = fso.OpenTextFile(miniFile, ForAppending)

  158.         If InStr(fso.OpenTextFile(miniFile).ReadAll(), "[.ShellClassInfo]") = 0 Then fmenu.WriteLine("[.ShellClassInfo]")

  159.         If InStr(fso.OpenTextFile(miniFile).ReadAll(), menuName) = 0 Then fmenu.WriteLine(menuName)

  160.         fmenu.Close

  161.     Else

  162.         Set fmenu = fso.CreateTextFile(miniFile, True)

  163.         fmenu.WriteLine("[.ShellClassInfo]")

  164.         fmenu.WriteLine(menuName)

  165.         fmenu.Close

  166.     End If

  167. End Function

  168. 

  169. Function ProcessAttrib()

  170.     Dim fst, fstP, menuIni, menuP, progIni, progP

  171.     Set fst = fso.GetFile(stPath & "\" & "desktop.ini")

  172.     fst.Attributes = 2

  173.     Set fstP = fso.GetFolder(stPath)

  174.     If fstP.Attributes = 16 Then

  175.         fstP.Attributes = 16+4

  176.     End If

  177.     If LCase(sType) = "programs" Then

  178.         Set menuIni = fso.GetFile(menuPath & "\" & "desktop.ini")

  179.         menuIni.Attributes = 2

  180.         Set menuP = fso.GetFolder(menuPath)

  181.         If menuP.Attributes = 16 Then

  182.             menuP.Attributes = 16+4

  183.         End If

  184.     End If

  185.     If LCase(sType) = "accessories" Then

  186.         Set progIni = fso.GetFile(progPath & "\" & "desktop.ini")

  187.         progIni.Attributes = 2

  188.         Set progP = fso.GetFolder(progPath)

  189.         If progP.Attributes = 16 Then

  190.             progP.Attributes = 16+4

  191.         End If

  192.         Set menuIni = fso.GetFile(menuPath & "\" & "desktop.ini")

  193.         menuIni.Attributes = 2

  194.         Set menuP = fso.GetFolder(menuPath)

  195.         If menuP.Attributes = 16 Then

  196.             menuP.Attributes = 16+4

  197.         End If

  198.     End If

  199.     If LCase(sType) = "administrativetools" Then

  200.         Set progIni = fso.GetFile(progPath & "\" & "desktop.ini")

  201.         progIni.Attributes = 2

  202.         Set progP = fso.GetFolder(progPath)

  203.         If progP.Attributes = 16 Then

  204.             progP.Attributes = 16+4

  205.         End If

  206.         Set menuIni = fso.GetFile(menuPath & "\" & "desktop.ini")

  207.         menuIni.Attributes = 2

  208.         Set menuP = fso.GetFolder(menuPath)

  209.         If menuP.Attributes = 16 Then

  210.             menuP.Attributes = 16+4

  211.         End If

  212.     End If

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