[问题求助] [已解决]---VBS 替换注册表文件中的内容

Rank: 3 Rank: 3

帖子: 122
积分: 251
技术: 1
捐助: 0
注册时间: 2009-8-24

24楼

发表于 2014-10-19 14:02 | 只看该作者

回复 23# apang

非常感谢！可以结贴了。

76626yyn

Rank: 8 Rank: 8

帖子: 2085
积分: 14204
技术: 665
捐助: 0
注册时间: 2011-11-27

23楼

发表于 2014-10-19 11:43 | 只看该作者

回复 22# yuanyannian

在 117 行后面，即 MsgBox "Error, the WB-" & hivFile & " not found and exit."，不用": WScript.Quit" 可以退出吗？

你自己试下呀
加上WScript.Quit会中途强行退出，不会处理其它文件（如果有多个文件需要处理的话），这个根据需要吧。

Rank: 3 Rank: 3

帖子: 122
积分: 251
技术: 1
捐助: 0
注册时间: 2009-8-24

22楼

发表于 2014-10-18 07:04 | 只看该作者

回复 21# apang
谢谢！
可以了，把 110 到 113 行换为：

    On Error Resume Next
    yn = ws.RegRead("HKEY_LOCAL_MACHINE\WB-" & hivFile & "\")
    If yn <> 0 Then
        infFile = fso.GetFile(infFile).ShortPath
复制代码

把 52 行换为：

Call ProcessFile(tPath & ar(i) & ".INF", "setup")
复制代码

应该没问题了，待进一步测试一下。

另外请教，在 117 行后面，即 MsgBox "Error, the WB-" & hivFile & " not found and exit."，不用": WScript.Quit" 可以退出吗？

76626yyn

Rank: 8 Rank: 8

帖子: 2085
积分: 14204
技术: 665
捐助: 0
注册时间: 2011-11-27

21楼

发表于 2014-10-18 00:23 | 只看该作者

回复 20# yuanyannian

1 我的win7无法测试注册是否成功，先注释掉第110行试试
2 少了一个参数，已修改

Rank: 3 Rank: 3

帖子: 122
积分: 251
技术: 1
捐助: 0
注册时间: 2009-8-24

20楼

发表于 2014-10-17 19:28 | 只看该作者

本帖最后由 yuanyannian 于 2014-10-17 19:34 编辑

回复 16# apang

1. 无法读取 hiveFile，导致 .INF 文件不能注册。
2. If Not infFile = tPath & "INTL.INF" Then 这行似乎无效。

再次感谢 apang 老师！！！

76626yyn

Rank: 3 Rank: 3

帖子: 122
积分: 251
技术: 1
捐助: 0
注册时间: 2009-8-24

19楼

发表于 2014-10-16 19:27 | 只看该作者

回复 18# CrLf

当然应该，可如何加呢？

76626yyn

CrLf

论坛巡查

Rank: 8 Rank: 8

帖子: 6388
积分: 18843
技术: 982
捐助: 100
注册时间: 2010-10-9

18楼

发表于 2014-10-16 18:01 | 只看该作者

回复 17# yuanyannian

那结帖后给胖大大加个分呗

链接：在线第三方命令行工具下载 bat、vbs、js 原生混编

Rank: 3 Rank: 3

帖子: 122
积分: 251
技术: 1
捐助: 0
注册时间: 2009-8-24

17楼

发表于 2014-10-16 17:36 | 只看该作者

非常非常感谢！！！

76626yyn

Rank: 8 Rank: 8

帖子: 2085
积分: 14204
技术: 665
捐助: 0
注册时间: 2011-11-27

16楼

发表于 2014-10-16 01:13 | 只看该作者

本帖最后由 apang 于 2014-10-18 00:14 编辑

回复 15# yuanyannian

太长太乱，看得头都大，如果还有问题，请自行修改

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

1 评分人数

yuanyannian: 感谢 apang 老师的无私相助。技术 + 1

Rank: 3 Rank: 3

帖子: 122
积分: 251
技术: 1
捐助: 0
注册时间: 2009-8-24

15楼

发表于 2014-10-15 19:39 | 只看该作者

回复 12# apang

apang 老师还真不愿帮忙啊？有求了！！！

76626yyn

Rank: 3 Rank: 3

帖子: 122
积分: 251
技术: 1
捐助: 0
注册时间: 2009-8-24

14楼

发表于 2014-10-14 06:51 | 只看该作者

回复 12# apang

查看了所有语言的 HKEY_LOCAL_MACHINE\pe-def\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders，几乎是一样的排列。

76626yyn

Rank: 3 Rank: 3

帖子: 122
积分: 251
技术: 1
捐助: 0
注册时间: 2009-8-24

13楼

发表于 2014-10-14 06:48 | 只看该作者

本帖最后由 yuanyannian 于 2014-10-14 06:53 编辑

回复 11# apang

理解，这已经十分感谢了！如果没有老师的无私相助，我根本无法写出来 vbs。

76626yyn

Rank: 8 Rank: 8

帖子: 2085
积分: 14204
技术: 665
捐助: 0
注册时间: 2011-11-27

12楼

发表于 2014-10-13 21:53 | 只看该作者

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

Rank: 8 Rank: 8

帖子: 2085
积分: 14204
技术: 665
捐助: 0
注册时间: 2011-11-27

11楼

发表于 2014-10-13 21:41 | 只看该作者

回复 10# yuanyannian

需要判断参数个数，蛋疼，相当蛋疼，恕不能帮忙

1 评分人数

CrLf: 看描述就醉了，蛋蛋隐隐作痛技术 + 1