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

Linuxer

五级士官

Rank: 4

帖子: 260
积分: 341
技术: 27
捐助: 0
注册时间: 2014-7-18

3楼

发表于 2014-8-21 12:14 | 只看该作者

回复 2# jikea

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

Rank: 3 Rank: 3

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

4楼

发表于 2014-8-21 12:16 | 只看该作者

本帖最后由 yuanyannian 于 2014-8-21 12:23 编辑

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

76626yyn

Rank: 8 Rank: 8

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

5楼

发表于 2014-8-21 15:08 | 只看该作者

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

Rank: 3 Rank: 3

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

6楼

发表于 2014-8-22 07:53 | 只看该作者

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

76626yyn

Rank: 8 Rank: 8

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

7楼

发表于 2014-8-22 15:00 | 只看该作者

回复 6# yuanyannian

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

Rank: 3 Rank: 3

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

8楼

发表于 2014-8-22 16:58 | 只看该作者

回复 7# apang

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

76626yyn

CrLf

论坛巡查

Rank: 8 Rank: 8

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

9楼

发表于 2014-8-22 19:32 | 只看该作者

看蒙了...

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

Rank: 3 Rank: 3

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

10楼

发表于 2014-8-22 20:25 | 只看该作者

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

76626yyn

Rank: 3 Rank: 3

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

11楼

发表于 2014-8-22 20:34 | 只看该作者

静等 apang 老师相助。

76626yyn

Rank: 8 Rank: 8

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

12楼

发表于 2014-8-22 20:42 | 只看该作者

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

Rank: 8 Rank: 8

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

13楼

发表于 2014-8-22 20:49 | 只看该作者

回复 10# yuanyannian

CrLf老师一向谦虚:lol

Rank: 3 Rank: 3

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

14楼

发表于 2014-8-22 21:04 | 只看该作者

回复 12# apang

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

76626yyn

Rank: 3 Rank: 3

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

15楼

发表于 2014-8-22 21:09 | 只看该作者

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

76626yyn