Question

如何使用VB6从句子中包含ERROR关键字的文本文件中提取行。我是VB6的新手，想要从日志文件中提取多行并将它们放在最后一个日志文件中。

LOG FIlE：Log.txt

2012-10-29 22:39:47 ------------------------------------- -----

2012-10-29 22:39:47应用程序正在开始......

2012-10-29 22:39:47删除标志文件......

2012-10-29 22:39:47成功验证为“管理员”

2012-10-29 22:40:11显示角色选择对话框...

2012-10-29 22:40:13选择的角色：TESTROLE

2012-10-29 22:40:16检查安装状态......

2012-10-29 22:41:21已成功连接到BO服务器

2012-10-29 22:41:21完成过程

2012-10-30 20:19:35 ------------------------------------- -----

2012-10-30 20:19:35应用程序正在开始......

2012-10-30 20:19:35删除标志文件......

2012-10-29 22:40:11连接服务器时出错

2012-10-29 22:40:16检查安装状态......

2012-10-29 22:41:21 ShellAndWait函数出错。错误代码：0

2012-10-29 22:41:21错误： 2012-10-29 22:41:21错误：对象'〜'的方法'〜'失败

2012-10-29 22:41:21搜索本地源文件夹...

2012-10-29 22:41:21错误：对象'〜'的方法'〜'失败

2012-10-29 22:41:21将文件夹\ xxx.xxx.x.xx \ xyz \ Script复制到E：\

2012-10-29 22:41:21非关键错误：复制文件夹时出错\ xxx.xxx.x.xx \ admin方法

2012-10-29 22:41:21完成过程

在上面的日志文件中，我想在当前会话的senetence中提取包含Error关键字的行，并希望收集所有这些行并将它们放在当前日志的最后一行中。例如，在上面的日志文件中，此会话的此行启动当前日志

“2012-10-30 20:19:35 ------------------------------------ ------“

以行

结束

“2012-10-29 22:41:21这个过程完成了”

所以我想在这两行之间提取包含Error关键字的行，并将它们放在此行之下 “2012-10-29 22:41:21这个过程完成了”行

“2012-10-29 22:41:21这个过程完成了”

会话2012-10-29 22:40:11中遇到的错误列在下面

2012-10-29 22:40:11连接服务器时出错

2012-10-29 22:41:21 ShellAndWait函数出错。错误代码：0

2012-10-29 22:41:21错误：

2012-10-29 22:41:21错误：对象'〜'的方法'〜'失败

012-10-29 22:41:21非关键错误：错误复制文件夹\ xxx.xxx.x.xx \ admin方法'〜'对象'〜'

VB6有可能吗？请指导我，并提前致谢。

Answer 1

普通的原生VB6 I / O适合这样的事情。即使针对80MB测试日志性能进行测试也是可以接受的。额外奖励：你不会以这种方式吃大量的RAM。

作为奖励，这种尝试（a。）我认为它符合您的要求，（b。）进行不区分大小写的搜索，并且（c。）在序列“错误”时不会出现错误命中发生在一个更长的词（例如“恐怖”）。

它还为没有“错误”的会话添加了“ none ”行，但您可以根据需要更改或删除它，我调整了“遇到错误...列在下面”消息不那么笨重的东西。

Option Explicit

Private fOrigLog As Integer
Private fNewLog As Integer
Private colErrorLines As Collection
Private strSessionTimestamp As String

Private Sub FlushErrorLines()
    Print #fNewLog, "Errors encountered in session "; _
                    strSessionTimestamp; _
                    " are listed below"
    With colErrorLines
        If .Count = 0 Then
            Print #fNewLog, "*none*"
        Else
            Do While .Count > 0
                Print #fNewLog, .Item(1)
                .Remove 1
            Loop
        End If
    End With
End Sub

Private Sub Main()
    Const DASHES As String = "------------------------------------------"
    Dim strLine As String
    Dim strLineUCased As String
    Dim posError As Long

    fOrigLog = FreeFile(0)
    Open "log.txt" For Input As #fOrigLog Len = 32767

    fNewLog = FreeFile(0)
    Open "newlog.txt" For Output As #fNewLog Len = 32767

    Set colErrorLines = New Collection

    Do Until EOF(fOrigLog)
        Line Input #fOrigLog, strLine
        If Mid$(strLine, 21, 42) = DASHES Then
            If Len(strSessionTimestamp) > 0 Then
                FlushErrorLines
            End If
            strSessionTimestamp = Left$(strLine, 19)
            Print #fNewLog, strLine
        Else
            strLineUCased = UCase$(strLine)
            posError = InStr(21, strLineUCased, "ERROR")
            If posError > 0 Then
                'Make sure we have a whole word "ERROR" here:
                If Mid$(strLineUCased, posError - 1, 7) & " " _
                        Like "[!0-9A-Z]ERROR[!0-9A-Z]*" Then
                    colErrorLines.Add strLine
                Else
                    Print #fNewLog, strLine
                End If
            Else
                Print #fNewLog, strLine
            End If
        End If
    Loop
    Close #fOrigLog
    FlushErrorLines
    Close #fNewLog

    MsgBox "Complete"
End Sub

Answer 2

一些快速示例代码：

Private Sub Command1_Click()
  Dim lngLine As Long
  Dim strFile As String
  Dim intFile As Integer
  Dim strData As String
  Dim strLine() As String
  Dim strErrors As String
  'set filename
  strFile = "c:\temp\test.log"
  intFile = FreeFile
  'openj file
  Open strFile For Input As #intFile
    'read data from file
    strData = Input(LOF(intFile), #intFile)
  Close #intFile
  'split data into an array of lines
  strLine = Split(strData, vbCrLf)
  'empty error list
  strErrors = ""
  'loop through all lines of data
  For lngLine = 0 To UBound(strLine)
    If InStr(strLine(lngLine), "Error") > 0 Then
      'add line to errors if it contains the word "Error"
      strErrors = strErrors & strLine(lngLine) & vbCrLf
    End If
  Next lngLine
  'show the errors
  Print strErrors
End Sub

如何使用VB6从句子中包含ERROR关键字的文本文件中提取行

2 个答案: