[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

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

本帖最后由 pcl_test 于 2016-8-4 23:34 编辑

再有新问题求助:
文本如下:(请注意:文本是 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 如何做? 谢谢!
76626yyn

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

TOP

回复 12# apang

刚刚测试过,完全没有问题,非常感谢老师了!!!
76626yyn

TOP

回复 10# yuanyannian


    CrLf老师一向谦虚:lol

TOP

回复 8# yuanyannian


    以下只是想当然,没做测试:
62~66行(未作容错处理,如果匹配不上,可能报下标越界):
  1. LG = Split(ProssLocales(s), ",")
  2. s = ReplaceStr(s, "\[LG_INSTALL_(" & LG(0) & "|" & LG(1) & ")]", "[DefaultInstall]")
复制代码
函数部分:
  1. Function ProssLocales(ByVal s)
  2.     strKey = "Locales"
  3.     pattern1 = "^ *\[" & strKey & "] *$"
  4.     pattern2 = "^ *" & sLoca & " *=([^,]*,){2}([^,]*,[^,]*),.*$"
  5.     Set re = New RegExp
  6.     re.Pattern = pattern1 & "[\s\S]*?" & pattern2
  7.     re.IgnoreCase = true
  8.     re.MultiLine = true
  9.     For Each m in re.Execute(s)
  10.         ProssLocales = m.SubMatches(1)
  11.     Next
  12. End Function
复制代码

TOP

静等 apang 老师相助。
76626yyn

TOP

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

TOP

看蒙了...

TOP

回复 7# apang


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

TOP

回复 6# yuanyannian


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

TOP

回复 5# apang


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

程序文件名:HojoHE.vbs
  1. Dim ws, oArgs, iPath, tPath, sName, Local
  2. Set ws = CreateObject("WScript.Shell")
  3. Set oArgs = WScript.Arguments
  4. If oArgs.Count >= 3 Then
  5.     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
  6.         iPath = Mid(oArgs(1), 3) & "\"
  7.         tPath = Mid(oArgs(2), 3) & "\"
  8.         sLoca = Mid(oArgs(3), 3)
  9.     Else MsgBox "Input error!"& vbcrlf & vbcrlf & "HojoHE.exe -Sdefault -ID:\a -TE:\a\b -L00000409" : WScript.Quit
  10.     End If
  11. Else MsgBox "Input error!"& vbcrlf & vbcrlf & "HojoHE.exe -Sdefault -ID:\a -TE:\a\b -L00000409" : WScript.Quit
  12. End If
  13. Dim file, fso, f, s, ss, hFile
  14. Set fso = CreateObject("Scripting.FileSystemObject")
  15. If fso.FolderExists(tPath) = False Then fso.CreateFolder tPath
  16. Dim MyArray()
  17. ReDim MyArray(8)
  18.     Select Case LCase(Mid(oArgs(0), 3))
  19.         Case "default"
  20.             hFile = "default"
  21.             MyArray(0) = "HIVEDEF.INF"
  22.         Case "software"
  23.             hFile = "software"
  24.             MyArray(1) = "HIVESFT.INF"
  25.             MyArray(2) = "HIVECLS.INF"
  26.             MyArray(3) = "HIVESXS.INF"
  27.             MyArray(4) = "HIVCLS32.INF"
  28.             MyArray(5) = "HIVSFT32.INF"
  29.             MyArray(6) = "DMREG.INF"
  30.         Case "setupreg.hiv"
  31.             hFile = "setup"
  32.             MyArray(7) = "HIVESYS.INF"
  33.             MyArray(8) = "INTL.INF"
  34.         Case Else MsgBox "The parameter isn't supported!"&vbcrlf&vbcrlf&"Must be 'default', or 'software', or 'setupreg.hiv'." : WScript.Quit
  35.     End Select
  36. For i=0 To UBound(MyArray)
  37. ss = MyArray(i)
  38.     If (fso.FileExists(iPath & ss)) Then
  39.         fso.CopyFile iPath & ss,tPath,true
  40.         file = tPath & ss
  41.         Call ProcessFile()
  42.     End If
  43. Next
  44. Function ProcessFile()
  45.     Set f = fso.OpenTextFile(file, 1, false, GetFileFormat(file))
  46.     s = f.ReadAll : f.Close
  47.     s = ReplaceStr(s, "HKCU, *""", "HKLM,""WB-default\")
  48.     s = ReplaceStr(s, "HKLM, *""SYSTEM\\CurrentControlSet", "HKLM,""WB-setup\ControlSet001")
  49.     s = ReplaceStr(s, "HKLM, *""SYSTEM\\", "HKLM,""WB-setup\")
  50.     s = ReplaceStr(s, "HKLM, *SYSTEM\\CurrentControlSet", "HKLM,WB-setup\ControlSet001")
  51.     s = ReplaceStr(s, "HKLM, *SYSTEM\\", "HKLM,WB-setup\")
  52.     s = ReplaceStr(s, "\\CryptSvc\\Security"",""Security"",0x00030003, *\\", "\CryptSvc\Security"",""Security"",0x00030003,00")
  53.     s = ReplaceStr(s, "HKLM, *""SOFTWARE\\", "HKLM,""WB-software\")
  54.     s = ReplaceStr(s, "HKLM, *SOFTWARE\\", "HKLM,WB-software\")
  55.     s = ReplaceStr(s, "HKCR, *""", "HKLM,""WB-software\Classes\")
  56.     s = ReplaceStr(s, "HKCR,\.", "HKLM,WB-software\Classes\.")
  57.     If file = tPath & "INTL.INF" Then
  58.         s = ReplaceStr(s, "\[" & sLoca & "\]", "[DefaultInstall]")
  59.         s = ReplaceStr(s, "CopyFile", ";CopyFile")
  60.         Call ProssLocales()
  61.         MsgBox LG1
  62.         MsgBox LG2
  63.         s = ReplaceStr(s, "\[LG_INSTALL_" & LG1 & "\]", "[DefaultInstall]")
  64.         s = ReplaceStr(s, "\[LG_INSTALL_" & LG2 & "\]", "[DefaultInstall]")
  65.     End If
  66.     fso.OpenTextFile(file, 2, true, -1).Write s
  67. '    Call RegJudge()
  68. End Function
  69. WScript.Quit
  70. Function GetFileFormat(ByVal file)
  71.     Dim Bin
  72.     with CreateObject("Adodb.Stream")
  73.         .Type = 1
  74.         .Mode = 3
  75.         .Open
  76.         .Position = 0
  77.         .Loadfromfile file
  78.         Bin = .read(2)
  79.     End with
  80.     If AscB(MidB(Bin,1,1))=&HFF and AscB(MidB(Bin,2,1))=&HFE Then
  81.         GetFileFormat = -1   ''unicode
  82.     Else GetFileFormat = 0   ''ansi
  83.     End If
  84. End Function
  85. Function ReplaceStr(ByVal s, pattern, s1)
  86.     Dim re
  87.     If Not file = tPath & "INTL.INF" Then
  88.         If Left(s, 16) <> "[DefaultInstall]" Then
  89.             s = "[DefaultInstall]" & vbCrLf & "AddReg = AddReg" & vbCrLf & "AddReg = AddReg.RemoteBoot" & vbCrLf &"AddReg = AddReg.Fresh" & vbCrLf & "AddReg = AddReg.Upgrade" & vbCrLf & s
  90.         End If
  91.     End If
  92.     Set re = New RegExp
  93.     re.Pattern = pattern
  94.     re.Global = true
  95.     re.IgnoreCase = true
  96.     ReplaceStr = re.Replace(s, s1)
  97. End Function
  98. Function RegJudge()
  99.     Dim yn
  100.     On Error Resume Next
  101.     yn = ws.RegRead("HKEY_LOCAL_MACHINE\WB-" & hFile & "\")
  102.     If yn <> 0 Then
  103.         ws.Run "rundll32 syssetup,SetupInfObjectInstallAction DefaultInstall 132 " & file, , true
  104.     Else MsgBox "Error, the WB-" & hFile & " not found and exit." : WScript.Quit
  105.     End If
  106. End Function
  107. Function ProssLocales()
  108.     strKey = "Locales"
  109.     Set f = fso.OpenTextFile(tPath & "INTL.INF", 1, false, -1)
  110.     txt = f.ReadAll : f.Close
  111.     pattern1 = "^ *\[" & strKey & "] *$"
  112.     pattern2 = "^ *" & sLoca & " *=([^,]*,){2}([^,]*),([^,]*),.*$"
  113.     Set re = New RegExp
  114.     re.Pattern = pattern1 & "[\s\S]*?" & pattern2
  115.     re.IgnoreCase = true
  116.     re.MultiLine = true
  117.     If rs.Test(txt) Then
  118.         Set m = re.Execute(txt)(0)
  119.         LG1 = m.SubMatches(1)
  120.         LG2 = m.SubMatches(2)
  121.     End If
  122. End Function
复制代码
76626yyn

TOP

  1. strKey1 = "Locales"
  2. strKey2 = "0000041c"
  3. Set fso = CreateObject("Scripting.FileSystemObject")
  4. Set f = fso.OpenTextFile("a.txt", 1, false, -1)
  5. txt = f.ReadAll : f.Close
  6. pattern1 = "^ *\[" & strKey1 & "] *$"
  7. pattern2 = "^ *" & strKey2 & " *=([^,]*,){2}([^,]*),([^,]*),.*$"
  8. Set re = New RegExp
  9. re.Pattern = pattern1 & "[\s\S]*?" & pattern2
  10. re.IgnoreCase = true
  11. re.MultiLine = true
  12. If re.Test(txt) Then
  13.         Set m = re.Execute(txt)(0)
  14.         MsgBox "a=" & m.SubMatches(1) & " b=" & m.SubMatches(2)
  15. End If
复制代码

TOP

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

回复 1# yuanyannian


从网上搜索的方法,照葫芦画瓢,可读取,但只能读取 ANSI 格式,不能处理 unicode 格式。
所以,还请老师们帮忙啊!!!
  1. strIniFile = ".\aaa.inf"
  2. Local = "0000041c"
  3. strTemp = ReadINF(strInfFile, "Locales", Local)
  4. MsgBox "Local = " & strTemp, vbInformation
  5. Function ReadINF(FilePath, MarK, Key)
  6. Dim fso, sReadLine, i, j, ss
  7. Set fso = CreateObject("Scripting.FileSystemObject")
  8. Set InfFile = fso.opentextfile(FilePath, 1)
  9. Do Until InfFile.atendofstream
  10.     sReadLine = InfFile.readline
  11.     If sReadLine = "" Then
  12.         InfFile.skipline
  13.     ElseIf Trim(sReadLine) = "[" & Mark & "]" Then
  14.         Do Until InfFile.atendofstream            '查找该小节名下的键名
  15.             sReadLine = InfFile.readline     '读取小节名后的行
  16.             j = InStr(sReadLine, "=")
  17.             If j > 0 Then                                    '小节名后的文本行存在
  18.                 If InStr(Left(sReadLine, j), Key) > 0 Then    '从"="左边字符串找到键名
  19.                     ss = Trim(Right(sReadLine, Len(sReadLine) - InStr(sReadLine, "=")))
  20.                 End If
  21.             End If
  22.         Loop
  23.     End If
  24. Loop
  25. InfFile.Close
  26. Set fso = Nothing
  27. ReadINF= ss
  28. End Function
  29. y1 = split(strTemp, ",")(2)
  30. y2 = split(strTemp, ",")(3)
  31. MsgBox y1
  32. MsgBox y2
复制代码
76626yyn

TOP

回复 2# jikea


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

TOP

本帖最后由 jikea 于 2014-8-21 09:49 编辑

很乆没来了,学习学习
正在学习中…………

TOP

返回列表