[问题求助] [已解决]vbs如何提取unicode编码的文本里含指定字符串的行中特定位置的字符串？

yuanyannian

再有新问题求助：
文本如下：（请注意：文本是 unicode 格式的 .INF 文件，要求不改变 unicode 格式）

aaa.inf

[Locales]
00000436 = %Afrikaans%                ,850     ,1,,0436:00000409,0409:00000409
0000041c = %Albanian%                 ,852     ,2,8,041c:0000041c,0409:00000409
00000801 = %Arabic_Iraq%            ,720     ,13,15,0409:00000409,0801:00000401
00000c01 = %Arabic_Egypt%          ,720     ,13,,0409:00000409,0c01:00000401
00001001 = %Arabic_Libya%          ,720     ,13,,040c:0000040c,1001:00020401
00001401 = %Arabic_Algeria%       ,720     ,13,,040c:0000040c,1401:00020401
00001801 = %Arabic_Morocco%     ,720     ,13,,040c:0000040c,1801:00020401
00001c01 = %Arabic_Tunisia%       ,720     ,13,,040c:0000040c,1c01:00020401
00002001 = %Arabic_Oman%        ,720     ,13,,0409:00000409,2001:00000401
00002401 = %Arabic_Yemen%       ,720     ,13,,0409:00000409,2401:00000401
00002801 = %Arabic_Syria%          ,720     ,13,,0409:00000409,2801:00000401
00002c01 = %Arabic_Jordan%        ,720     ,13,,0409:00000409,2c01:00000401

我的问题是，比如我想提取指定字符串 00000436 = 这一行 ,1,,  中的 1，而 0000041c = 这一行中，需要提取 ,2,8, 中的 2 和 8 两个，分别赋给一个变量，在以后的代码中引用。
请教用 vbs 如何做？ 谢谢！

yuanyannian

一定好好向 apang 老师、CrLf 老师等学习，并深入学习 vbs，遇到问题肯定还会请教老师们，请老师们莫要嫌我烦呵。

yuanyannian

回复 12# apang

刚刚测试过，完全没有问题，非常感谢老师了！！！

apang

回复 10# yuanyannian


    CrLf老师一向谦虚:lol

apang

回复 8# yuanyannian


    以下只是想当然，没做测试：
62~66行（未作容错处理，如果匹配不上，可能报下标越界）：

LG = Split(ProssLocales(s), ",")
s = ReplaceStr(s, "\[LG_INSTALL_(" & LG(0) & "|" & LG(1) & ")]", "[DefaultInstall]")
复制代码

函数部分：

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

yuanyannian

静等 apang 老师相助。

yuanyannian

CrLf 老师咋 “看蒙了”？
我自己都蒙着呢，说实话，我对 vsb 一开始纯粹是一点都不懂，在 apang 等老师帮助下能凑出完整的东西来，自己都不知道对不对，甚至都不好意思求助。
就像 apang 老师说的 “请参考ReplaceStr函数的方式传递实参”，我真不懂如何去做。

CrLf

看蒙了...

yuanyannian

回复 7# apang


谢谢 apang 老师。
    Set f = fso.OpenTextFile(tPath & "INTL.INF", 1, false, -1) 注释后，提示下面的“对象变量未设置”。
另外，我本是完全的 vbs 盲，如何传递实参？完全不懂。

apang

回复 6# yuanyannian


    62行调用函数时，请参考ReplaceStr函数的方式传递实参，并在被调用的函数中设定函数返回值
在Function ProssLocales中不能再次打开INTL.INF文件，因为第47行已经打开并赋值给s了

yuanyannian

回复 5# apang


再次感谢 apang 老师出手！！！
单独使用 apang 老师的代码没有问题，但是放进我的整个程序代码中好像就不行了？
我把要处理的代表性文件和程序代码发个附件，请老师看一下，帮忙修改一下，再次感谢。

程序文件名：HojoHE.vbs

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

apang

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

yuanyannian

回复 1# yuanyannian


从网上搜索的方法，照葫芦画瓢，可读取，但只能读取 ANSI 格式，不能处理 unicode 格式。
所以，还请老师们帮忙啊！！！

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

Linuxer

回复 2# jikea


    这是干什么。。。被盗号了？？

jikea

很乆没来了，学习学习