返回列表 发帖
试试
msg = "命令提示符下 输入的格式如 zzz.vbs -Saaa -TD:\zzz"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oArgs = WScript.Arguments
If oArgs.Count >= 2 Then
    fd = Mid(oArgs(1), 3) & "\"
ElseIf oArgs.Count = 1 Then
    fd = ".\"
Else
    MsgBox msg, , "提示" : WScript.Quit
End If
If Mid(oArgs(0), 3) = "aaa" Then
    Call ReplaceStr("HKCU,""", "HKLM,""WB-default\")
ElseIf Mid(oArgs(0), 3) = "bbb" Then
    Call ReplaceStr("HKLM,""SOFTWARE\", "HKLM,""WB-software\")
ElseIf Mid(oArgs(0), 3) = "ccc" Then
    Call ReplaceStr("HKLM,""SYSTEM\", "HKLM,""WB-setup\")
Else
    MsgBox msg, , "提示" : WScript.Quit
End If
Function ReplaceStr(s1, s2)
    Set f = fso.OpenTextFile(fd & "HIVEDEF.INF", 1, false, -1)
    s = f.ReadAll : f.Close
    s = Replace(s, s1, s2)
    s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & vbCrLf & s
    fso.OpenTextFile(fd & "HIVEDEF.INF", 2, true, -1).Write s
End FunctionCOPY

TOP

回复 6# yuanyannian


举例:
Function ReplaceSFT()
  Set ws = CreateObject("WScript.Shell")
  Set f = fso.OpenTextFile(fd & "HIVESFT.INF", 1, false, -1)
  s = f.ReadAll : f.Close
  Set re = New RegExp
  re.Pattern = "HKLM,""SOFTWARE\\"
  re.Global = true
  re.IgnoreCase = true
  s = re.Replace(s, "HKLM,""WB-default\")
  s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & vbCrLf & s
  fso.OpenTextFile(fd & "HIVESFT.INF", 2, true, -1).Write s
  ''ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 128 """ & fd & "HIVESFT.INF""", , true
End FunctionCOPY

TOP

本帖最后由 apang 于 2014-8-9 23:16 编辑
Dim msg, ws, oArgs, fd
msg = "Command prompt: HoJoHE.vbs -SHIVEDEF.INF -TD:\zzz"
msg = msg & vbLf & "or: HoJoHE.vbs -SHIVEDEF.INF -T""D:\zz z"""
Set ws = CreateObject("WScript.Shell")
Set oArgs = WScript.Arguments
If oArgs.Count >= 2 Then
    fd = Mid(oArgs(1), 3) & "\"
ElseIf oArgs.Count = 1 Then
    fd = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\"))
Else Call HoJoHlp()
End If
Dim file, fso, f, s
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(fd & Mid(oArgs(0), 3)) Then
    msg = "Input Path or File Name Error" & vbLf & msg
    Call HoJoHlp()
End If
file = fso.GetFile(fd & Mid(oArgs(0), 3)).ShortPath
Set f = fso.OpenTextFile(file, 1, false, GetFileFormat(file))
s = f.ReadAll : f.Close
Select Case UCase(Mid(oArgs(0), 3))
    Case "HIVEDEF.INF"
        s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
    Case "HIVESFT.INF"
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
    Case "HIVESYS.INF"
        s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
    Case "HIVECLS.INF"
        s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
        s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")
        s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")
    Case Else Call HoJoHlp()
End Select
fso.OpenTextFile(file, 2, true, -1).Write s
ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 128 " & file, , true
MsgBox "OK"
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 Left(s, 16) <> "[DEFAULTINSTALL]" Then
        s = "[DEFAULTINSTALL]" & vbCrLf & "ADDREG = AddReg" & vbCrLf & s
    End If
    Set re = New RegExp
    re.Pattern = pattern
    re.Global = true
    re.IgnoreCase = true
    ReplaceStr = re.Replace(s, s1)
End Function
Function HoJoHlp()
    MsgBox msg : WScript.Quit
End FunctionCOPY
1

评分人数

TOP

回复 12# yuanyannian


    个人认为,代码主要目的是查找与替换字符串,输入参数的判断,会占到代码很大一部分,自己用的话,没必要整得那么麻烦。

TOP

返回列表