批处理之家 - Powered by Discuz! Board

Dim msg1, msg2, fso, ws, oArgs, iPath, tPath, sLoca, sPName, tPName
msg1 = "HojoHE.exe -Sdefault -ID:\a -TE:\a\b -L00000409"
msg2 = "HojoUE.exe -SC:\def.reg -TD:\sft.reg"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
Set oArgs = WScript.Arguments
If oArgs.Count >= 4 Then
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
iPath = Mid(oArgs(1), 3) & "\"
tPath = Mid(oArgs(2), 3) & "\"
sLoca = Mid(oArgs(3), 3)
Call HojoHE()
Else MsgBox "usage:" & vbLf & vbLf & msg1
End If
ElseIf oArgs.Count = 2 Then
If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") Then
sPName = Mid(oArgs(0), 3)
tPName = Mid(oArgs(1), 3)
Call ChangeRegFile()
Else MsgBox "usage:" & vbLf & vbLf & msg2
End If
Else MsgBox "usage:" & vbLf & vbLf & msg1 & vbLf & "or" & vbLf & msg2
End If
Function HojoHE()
On Error Resume Next
Dim ar, i
If Not fso.FolderExists(tPath) Then fso.CreateFolder tPath
Select Case LCase(Mid(oArgs(0), 3))
Case "default"
fso.CopyFile iPath & "HIVEDEF.INF", tPath, true
Call ProcessFile(tPath & "HIVEDEF.INF", "default")
Case "software"
ar = Array("HIVESFT","HIVECLS","HIVESXS","HIVCLS32","HIVSFT32","DMREG")
For i = 0 to UBound(ar)
fso.CopyFile iPath & ar(i) & ".INF", tPath, true
Call ProcessFile(tPath & ar(i) & ".INF", "software")
Next
Case "setupreg.hiv"
ar = Array("HIVESYS","INTL")
For i = 0 to UBound(ar)
fso.CopyFile iPath & ar(i) & ".INF", tPath, true
Call ProcessFile(tPath & ar(i) & ".INF", "setup")
Next
Case Else MsgBox "The parameter isn't supported!" & vbLf & vbLf & "Must be 'default', or 'software', or 'setupreg.hiv'."
WScript.Quit
End Select
End Function
Function ChangeRegFile()
Dim f, txt, re, m, s1, s2, s
Set f = fso.OpenTextFile(sPName, 1, , -1)
txt = f.ReadAll : f.Close
Set re = New RegExp
re.Pattern = "([\s\S]*?)(^"".+"" *=[\s\S]+?)(?=^"")"
re.Global = true
re.IgnoreCase = true
re.MultiLine = true
For Each m in re.Execute(txt & vbCrLf & """")
s1 = m.SubMatches(0)
s2 = ReReplace(m.SubMatches(1))
If m.SubMatches(1) <> s2 Then
s = s & s1 & s2
Else s = s & s1
End If
Next
s1 = "25,00,41,00,4c,00,4c,00,55,00,53,00,45,00,52,00,53,00,"
re.Pattern = "(hex$2$:)25,00,55,00,53,00,45,00,52,00,"
s = re.Replace(s, "$1" & s1)
re.Pattern = "WB-default\\Software"
s = re.Replace(s, "WB-software")
fso.OpenTextFile(tPName, 2, true, -1).Write s
End Function
Function ProcessFile(infFile, hivFile)
Dim f, s, lgInst, yn
Set f = fso.OpenTextFile(infFile, 1, false, GetFileFormat(infFile))
s = f.ReadAll : f.Close
s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
s = ReplaceStr(s, "HKLM, *""SYSTEM\\CurrentControlSet", "HKLM,""WB-setup\ControlSet001")
s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
s = ReplaceStr(s, "HKLM, *SYSTEM\\CurrentControlSet", "HKLM,WB-setup\ControlSet001")
s = ReplaceStr(s, "HKLM, *SYSTEM\\", "HKLM,WB-setup\")
s = ReplaceStr(s, "\\CryptSvc\\Security"",""Security"",0x00030003, *\\", "\CryptSvc\Security"",""Security"",0x00030003,00")
s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
s = ReplaceStr(s, "HKLM, *SOFTWARE\\", "HKLM,WB-software\")
s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")
s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")
If UCase(infFile) = UCase(tPath & "INTL.INF") Then
s = ReplaceStr(s, "\[" & sLoca & "\]", "[DefaultInstall]")
s = ReplaceStr(s, "CopyFile", ";CopyFile")
lgInst = Split(ProssLocales(s), ",")
s = ReplaceStr(s, "\[LG_INSTALL_(" & lgInst(0) & "|" & lgInst(1) & ")]", "[DefaultInstall]")
ElseIf Left(s, 16) <> "[DefaultInstall]" Then
s = "AddReg = AddReg.Upgrade" & vbCrLf & s
s = "AddReg = AddReg.Fresh" & vbCrLf & s
s = "AddReg = AddReg.RemoteBoot" & vbCrLf & s
s = "AddReg = AddReg" & vbCrLf & s
s = "[DefaultInstall]" & vbCrLf & s
End If
fso.OpenTextFile(infFile, 2, true, -1).Write s
On Error Resume Next
yn = ws.RegRead("HKEY_LOCAL_MACHINE\WB-" & hivFile & "\")
If yn <> 0 Then
infFile = fso.GetFile(infFile).ShortPath
ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 132 " & infFile, , true
Else MsgBox "Error, the WB-" & hivFile & " not found and exit."
End If
End Function
Function GetFileFormat(ByVal infFile)
Dim Bin
with CreateObject("Adodb.Stream")
.Type = 1
.Mode = 3
.Open
.Position = 0
.Loadfromfile infFile
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
Set re = New RegExp
re.Pattern = pattern
re.Global = true
re.IgnoreCase = true
ReplaceStr = re.Replace(s, s1)
End Function
Function ProssLocales(ByVal s)
Dim pattern1, pattern2, re, m
pattern1 = "^ *\[Locales] *$"
pattern2 = "^ *" & sLoca & " *=([^,]*,){2}([^,]*,[^,]*),.*$"
Set re = New RegExp
re.Pattern = pattern1 & "[\s\S]*?" & pattern2
re.IgnoreCase = true
re.MultiLine = true
For Each m in re.Execute(s)
ProssLocales = m.SubMatches(1)
Next
End Function
Function ReReplace(str)
Dim re, p
p = "Programs|Start Menu|Desktop|Startup|AppData|Templates|Favorites"
Set re = New RegExp
re.Pattern = """(" & p & ")"""
re.IgnoreCase = true
ReReplace = re.Replace(str, """Common $1""")
End Function

复制代码

Set fso = CreateObject("Scripting.FileSystemObject")
txt = fso.OpenTextFile("a.txt", 1, , -1).ReadAll
p = "Programs|Start Menu|Desktop|Startup|AppData|Templates|Favorites"
Set re = New RegExp
re.Pattern = "([\s\S]*?)(^"".+"" *=[\s\S]+?)(?=^"")"
re.Global = true
re.MultiLine = true
For Each m in re.Execute(txt)
s1 = m.SubMatches(0)
s2 = ReReplace(m.SubMatches(1))
If m.SubMatches(1) <> s2 Then
s = s & s1 & s2
Else s = s & s1
End If
Next
s1 = "25,00,41,00,4c,00,4c,00,55,00,53,00,45,00,52,00,53,00,"
Set re = New RegExp
re.Pattern = "(hex$2$:)25,00,55,00,53,00,45,00,52,00,"
re.Global = true
re.IgnoreCase = true
s = re.Replace(s, "$1" & s1)
fso.OpenTextFile("b.txt", 2, true, -1).Write s
Function ReReplace(str)
Set re = New RegExp
re.Pattern = """(" & p & ")"""
re.IgnoreCase = true
ReReplace = re.Replace(str, """Common $1""")
End Function

复制代码

Set fso = CreateObject("Scripting.FileSystemObject")
txt = fso.OpenTextFile("a.reg", 1, , -1).ReadAll
p = "NetHood|Personal|PrintHood|Recent|SendTo|Cookies|My Pictures"
p1 = p & "|Local Settings|Local AppData|Cache|History"
Set re = New RegExp
re.Pattern = "([\s\S]*?)""(" & p1 & ")""[\s\S]+?(?:"")"
re.Global = true
re.IgnoreCase = true
For Each m in re.Execute(txt)
str = str & """" & m.SubMatches(0)
Next
txt = Mid(str, 2)
p2 = "Programs|Start Menu|Desktop|Startup|AppData|Templates|Favorites"
Set re = New RegExp
re.Pattern = """(" & p2 & ")"""
re.Global = true
re.IgnoreCase = true
txt = re.Replace(txt, """Common $1""")
w1 = "25,00,55,00,53,00,45,00,52,00," ''只将这些替换即可，因 ,\ 的位置不是固定的。
w2 = "25,00,41,00,4c,00,4c,00,55,00,53,00,45,00,52,00,53,00,"
Set re = New RegExp
re.Pattern = "(hex$2$:)" & w1
re.Global = true
re.IgnoreCase = true
txt = re.Replace(txt, "$1" & w2)
fso.OpenTextFile("b.reg", 2, true, -1).Write txt

复制代码

@set @n=0;// & cscript -nologo -e:jscript "%~0" & pause & exit
fso = new ActiveXObject('Scripting.FileSystemObject');
txt = fso.OpenTextFile('a.txt', 1, false, -1).ReadAll();
re = /([\s\S]*?)(^".+" *=[\s\S]+?)(?=^")/mg;
s = '';
r =/^"(Programs|Start Menu|Desktop|Startup|AppData|Templates|Favorites)"/i;
while ((ar = re.exec(txt)) !=null) {
if (r.test(ar[2])) {
s += ar[1] + ar[2].replace(r, '"Common $1"');
} else s += ar[1];
}
s1='25,00,41,00,4c,00,4c,00,55,00,53,00,45,00,52,00,53,00,50,00,52,00,\\';
s2='4f,00,46,00,49,00,4c,00,45,00,25,00';
p1='25,00,55,00,53,00,45,00,52,00,50,00,52,00,4f,00,46,00,49,00,\\\\';
p2='4c,00,45,00,25,00';
re=new RegExp('(hex\$2\$:)' + p1 + '( *\\r?\\n *)' + p2, 'ig');
s = s.replace(re, '$1' + s1 + '$2' + s2);
fso.OpenTextFile('b.txt', 2, true, -1).Write(s)

复制代码

Set fso = CreateObject("Scripting.FileSystemObject")
txt = fso.OpenTextFile("a.txt", 1, , -1).ReadAll
p = "Programs|Start Menu|Desktop|Startup|AppData|Templates|Favorites"
Set re = New RegExp
re.Pattern = "([\s\S]*?)(^"".+"" *=[\s\S]+?)(?=^"")"
re.Global = true
re.MultiLine = true
For Each m in re.Execute(txt & vbCrLf & """")
s1 = m.SubMatches(0)
s2 = ReReplace(m.SubMatches(1))
If m.SubMatches(1) <> s2 Then
s = s & s1 & s2
Else s = s & s1
End If
Next
s1 = "25,00,41,00,4c,00,4c,00,55,00,53,00,45,00,52,00,53,00,"
Set re = New RegExp
re.Pattern = "(hex$2$:)25,00,55,00,53,00,45,00,52,00,"
re.Global = true
re.IgnoreCase = true
s = re.Replace(s, "$1" & s1)
fso.OpenTextFile("b.txt", 2, true, -1).Write Left(s, Len(s)-2)
Function ReReplace(str)
Set re = New RegExp
re.Pattern = """(" & p & ")"""
re.IgnoreCase = true
ReReplace = re.Replace(str, """Common $1""")
End Function

复制代码

Dim msg1, msg2, fso, ws, oArgs, iPath, tPath, sLoca, sPName, tPName
msg1 = "HojoHE.exe -Sdefault -ID:\a -TE:\a\b -L00000409"
msg2 = "HojoUE.exe -SC:\def.reg -TD:\sft.reg"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
Set oArgs = WScript.Arguments
If oArgs.Count >= 4 Then
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
iPath = Mid(oArgs(1), 3) & "\"
tPath = Mid(oArgs(2), 3) & "\"
sLoca = Mid(oArgs(3), 3)
Call HojoHE()
Else
MsgBox "usage:" & vbLf & vbLf & msg1
End If
ElseIf oArgs.Count = 2 Then
If Left(oArgs(0),2) = "-S" and (Left(oArgs(1),2) = "-T") Then
sPName = Mid(oArgs(0), 3)
tPName = Mid(oArgs(1), 3)
Call ChangeRegFile()
Else
MsgBox "usage:" & vbLf & vbLf & msg2
End If
Else
MsgBox "usage:" & vbLf & vbLf & msg1 & vbLf & "or" & vbLf & msg2
End If
Function HojoHE()
On Error Resume Next
Dim ar, i
If Not fso.FolderExists(tPath) Then fso.CreateFolder tPath
Select Case LCase(Mid(oArgs(0), 3))
Case "default"
fso.CopyFile iPath & "HIVEDEF.INF", tPath, true
Call ProcessFile(tPath & "HIVEDEF.INF", "default")
Case "software"
ar = Array("HIVESFT","HIVECLS","HIVESXS","HIVCLS32","HIVSFT32","DMREG")
For i = 0 to UBound(ar)
fso.CopyFile iPath & ar(i) & ".INF", tPath, true
Call ProcessFile(tPath & ar(i) & ".INF", "software")
Next
Case "setupreg.hiv"
ar = Array("HIVESYS","INTL")
For i = 0 to UBound(ar)
fso.CopyFile iPath & ar(i) & ".INF", tPath, true
Call ProcessFile(tPath & ar(i) & ".INF", "setupreg.hiv")
Next
Case Else
MsgBox "The parameter isn't supported!" & vbLf & vbLf & _
"Must be 'default', or 'software', or 'setupreg.hiv'."
WScript.Quit
End Select
End Function
Function ChangeRegFile()
Dim f, txt, re, m, s1, s2, s
Set f = fso.OpenTextFile(sPName, 1, , -1)
txt = f.ReadAll : f.Close
Set re = New RegExp
re.Pattern = "([\s\S]*?)(^"".+"" *=[\s\S]+?)(?=^"")"
re.Global = true
re.IgnoreCase = true
re.MultiLine = true
For Each m in re.Execute(txt & vbCrLf & """")
s1 = m.SubMatches(0)
s2 = ReReplace(m.SubMatches(1))
If m.SubMatches(1) <> s2 Then
s = s & s1 & s2
Else s = s & s1
End If
Next
s1 = "25,00,41,00,4c,00,4c,00,55,00,53,00,45,00,52,00,53,00,"
re.Pattern = "(hex$2$:)25,00,55,00,53,00,45,00,52,00,"
s = re.Replace(s, "$1" & s1)
re.Pattern = "pe-def\\Software"
s = re.Replace(s, "pe-soft")
fso.OpenTextFile(tPName, 2, true, -1).Write s
End Function
Function ProcessFile(infFile, hivFile)
Dim f, s, lgInst
Set f = fso.OpenTextFile(infFile, 1, false, GetFileFormat(infFile))
s = f.ReadAll : f.Close
s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
s = ReplaceStr(s, "HKLM, *""SYSTEM\\CurrentControlSet", "HKLM,""WB-setup\ControlSet001")
s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
s = ReplaceStr(s, "HKLM, *SYSTEM\\CurrentControlSet", "HKLM,WB-setup\ControlSet001")
s = ReplaceStr(s, "HKLM, *SYSTEM\\", "HKLM,WB-setup\")
s = ReplaceStr(s, "\\CryptSvc\\Security"",""Security"",0x00030003, *\\", "\CryptSvc\Security"",""Security"",0x00030003,00")
s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
s = ReplaceStr(s, "HKLM, *SOFTWARE\\", "HKLM,WB-software\")
s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")
s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")
If UCase(infFile) = UCase(tPath & "INTL.INF") Then
s = ReplaceStr(s, "\[" & sLoca & "\]", "[DefaultInstall]")
s = ReplaceStr(s, "CopyFile", ";CopyFile")
lgInst = Split(ProssLocales(s), ",")
s = ReplaceStr(s, "\[LG_INSTALL_(" & lgInst(0) & "|" & lgInst(1) & ")]", "[DefaultInstall]")
ElseIf Left(s, 16) <> "[DefaultInstall]" Then
s = "AddReg = AddReg.Upgrade" & vbCrLf & s
s = "AddReg = AddReg.Fresh" & vbCrLf & s
s = "AddReg = AddReg.RemoteBoot" & vbCrLf & s
s = "AddReg = AddReg" & vbCrLf & s
s = "[DefaultInstall]" & vbCrLf & s
End If
fso.OpenTextFile(infFile, 2, true, -1).Write s
''ws.RegRead "HKEY_LOCAL_MACHINE\WB-" & hivFile & "\"
If Err.Number = 0 Then
Err.Clear
infFile = fso.GetFile(infFile).ShortPath
ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 132 " & infFile, , true
Else
MsgBox "Error, the WB-" & hivFile & " not found and exit."
End If
End Function
Function GetFileFormat(ByVal infFile)
Dim Bin
with CreateObject("Adodb.Stream")
.Type = 1
.Mode = 3
.Open
.Position = 0
.Loadfromfile infFile
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
Set re = New RegExp
re.Pattern = pattern
re.Global = true
re.IgnoreCase = true
ReplaceStr = re.Replace(s, s1)
End Function
Function ProssLocales(ByVal s)
Dim pattern1, pattern2, re, m
pattern1 = "^ *\[Locales] *$"
pattern2 = "^ *" & sLoca & " *=([^,]*,){2}([^,]*,[^,]*),.*$"
Set re = New RegExp
re.Pattern = pattern1 & "[\s\S]*?" & pattern2
re.IgnoreCase = true
re.MultiLine = true
For Each m in re.Execute(s)
ProssLocales = m.SubMatches(1)
Next
End Function
Function ReReplace(str)
Dim re, p
p = "Programs|Start Menu|Desktop|Startup|AppData|Templates|Favorites"
Set re = New RegExp
re.Pattern = """(" & p & ")"""
re.IgnoreCase = true
ReReplace = re.Replace(str, """Common $1""")
End Function

复制代码