批处理之家 - Powered by Discuz! Board

strIniFile = ".\aaa.inf"
Local = "0000041c"
strTemp = ReadINF(strInfFile, "Locales", Local)
MsgBox "Local = " & strTemp, vbInformation
Function ReadINF(FilePath, MarK, Key)
Dim fso, sReadLine, i, j, ss
Set fso = CreateObject("Scripting.FileSystemObject")
Set InfFile = fso.opentextfile(FilePath, 1)
Do Until InfFile.atendofstream
sReadLine = InfFile.readline
If sReadLine = "" Then
InfFile.skipline
ElseIf Trim(sReadLine) = "[" & Mark & "]" Then
Do Until InfFile.atendofstream '查找该小节名下的键名
sReadLine = InfFile.readline '读取小节名后的行
j = InStr(sReadLine, "=")
If j > 0 Then '小节名后的文本行存在
If InStr(Left(sReadLine, j), Key) > 0 Then '从"="左边字符串找到键名
ss = Trim(Right(sReadLine, Len(sReadLine) - InStr(sReadLine, "=")))
End If
End If
Loop
End If
Loop
InfFile.Close
Set fso = Nothing
ReadINF= ss
End Function
y1 = split(strTemp, ",")(2)
y2 = split(strTemp, ",")(3)
MsgBox y1
MsgBox y2

复制代码

strKey1 = "Locales"
strKey2 = "0000041c"
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile("a.txt", 1, false, -1)
txt = f.ReadAll : f.Close
pattern1 = "^ *\[" & strKey1 & "] *$"
pattern2 = "^ *" & strKey2 & " *=([^,]*,){2}([^,]*),([^,]*),.*$"
Set re = New RegExp
re.Pattern = pattern1 & "[\s\S]*?" & pattern2
re.IgnoreCase = true
re.MultiLine = true
If re.Test(txt) Then
Set m = re.Execute(txt)(0)
MsgBox "a=" & m.SubMatches(1) & " b=" & m.SubMatches(2)
End If

复制代码

Dim ws, oArgs, iPath, tPath, sName, Local
Set ws = CreateObject("WScript.Shell")
Set oArgs = WScript.Arguments
If oArgs.Count >= 3 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)
Else MsgBox "Input error!"& vbcrlf & vbcrlf & "HojoHE.exe -Sdefault -ID:\a -TE:\a\b -L00000409" : WScript.Quit
End If
Else MsgBox "Input error!"& vbcrlf & vbcrlf & "HojoHE.exe -Sdefault -ID:\a -TE:\a\b -L00000409" : WScript.Quit
End If
Dim file, fso, f, s, ss, hFile
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(tPath) = False Then fso.CreateFolder tPath
Dim MyArray()
ReDim MyArray(8)
Select Case LCase(Mid(oArgs(0), 3))
Case "default"
hFile = "default"
MyArray(0) = "HIVEDEF.INF"
Case "software"
hFile = "software"
MyArray(1) = "HIVESFT.INF"
MyArray(2) = "HIVECLS.INF"
MyArray(3) = "HIVESXS.INF"
MyArray(4) = "HIVCLS32.INF"
MyArray(5) = "HIVSFT32.INF"
MyArray(6) = "DMREG.INF"
Case "setupreg.hiv"
hFile = "setup"
MyArray(7) = "HIVESYS.INF"
MyArray(8) = "INTL.INF"
Case Else MsgBox "The parameter isn't supported!"&vbcrlf&vbcrlf&"Must be 'default', or 'software', or 'setupreg.hiv'." : WScript.Quit
End Select
For i=0 To UBound(MyArray)
ss = MyArray(i)
If (fso.FileExists(iPath & ss)) Then
fso.CopyFile iPath & ss,tPath,true
file = tPath & ss
Call ProcessFile()
End If
Next
Function ProcessFile()
Set f = fso.OpenTextFile(file, 1, false, GetFileFormat(file))
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 file = tPath & "INTL.INF" Then
s = ReplaceStr(s, "\[" & sLoca & "\]", "[DefaultInstall]")
s = ReplaceStr(s, "CopyFile", ";CopyFile")
Call ProssLocales()
MsgBox LG1
MsgBox LG2
s = ReplaceStr(s, "\[LG_INSTALL_" & LG1 & "\]", "[DefaultInstall]")
s = ReplaceStr(s, "\[LG_INSTALL_" & LG2 & "\]", "[DefaultInstall]")
End If
fso.OpenTextFile(file, 2, true, -1).Write s
' Call RegJudge()
End Function
WScript.Quit
Function GetFileFormat(ByVal file)
Dim Bin
with CreateObject("Adodb.Stream")
.Type = 1
.Mode = 3
.Open
.Position = 0
.Loadfromfile file
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
If Not file = tPath & "INTL.INF" Then
If Left(s, 16) <> "[DefaultInstall]" Then
s = "[DefaultInstall]" & vbCrLf & "AddReg = AddReg" & vbCrLf & "AddReg = AddReg.RemoteBoot" & vbCrLf &"AddReg = AddReg.Fresh" & vbCrLf & "AddReg = AddReg.Upgrade" & vbCrLf & s
End If
End If
Set re = New RegExp
re.Pattern = pattern
re.Global = true
re.IgnoreCase = true
ReplaceStr = re.Replace(s, s1)
End Function
Function RegJudge()
Dim yn
On Error Resume Next
yn = ws.RegRead("HKEY_LOCAL_MACHINE\WB-" & hFile & "\")
If yn <> 0 Then
ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 132 " & file, , true
Else MsgBox "Error, the WB-" & hFile & " not found and exit." : WScript.Quit
End If
End Function
Function ProssLocales()
strKey = "Locales"
Set f = fso.OpenTextFile(tPath & "INTL.INF", 1, false, -1)
txt = f.ReadAll : f.Close
pattern1 = "^ *\[" & strKey & "] *$"
pattern2 = "^ *" & sLoca & " *=([^,]*,){2}([^,]*),([^,]*),.*$"
Set re = New RegExp
re.Pattern = pattern1 & "[\s\S]*?" & pattern2
re.IgnoreCase = true
re.MultiLine = true
If rs.Test(txt) Then
Set m = re.Execute(txt)(0)
LG1 = m.SubMatches(1)
LG2 = m.SubMatches(2)
End If
End Function

复制代码

Function ProssLocales(ByVal s)
strKey = "Locales"
pattern1 = "^ *\[" & strKey & "] *$"
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

复制代码