a.readline

a.readall

[2011.11.28 00:54:45:730][TraceID: TWDPWCC8R36HNU]->IncomingTime

[2011.11.28 00:54:45:730][TraceID: TWDPWCC8R36HNU]->IncomingData

[2011.11.28 00:54:45:730][TraceID: TWDPWCC8R36HNU]->ThreadID

[2011.11.28 00:54:45:730][TraceID: TWDPWCC8R36HNU]->RequestExecuteStart

[2011.11.28 00:54:45:730][TraceID: TWDPWCC8R36HNU]->RequestInfo

[2011.11.28 00:54:45:730][TraceID: TWDPWCC8R36HNU]->CheckUserInfo

[2011.11.28 00:54:45:730][TraceID: TWDPWCC8R36HNU]->UserInfo

[2011.11.28 00:54:45:730][TraceID: TWDPWCC8R36HNU]->TraceParams

[2011.11.28 00:54:45:730][TraceID: TWDPWCC8R36HNU]->StartExecuteTask

[2011.11.28 00:54:45:746][TraceID: TWDPWCC8R36HNU]->EndExecuteTask

[2011.11.28 00:54:45:746][TraceID: TWDPWCC8R36HNU]->RequestExecuteEnd

[2011.11.28 00:54:45:746][TraceID: TWDPWCC8R36HNU]->OutgoingData

[2011.11.28 00:54:45:746][TraceID: TWDPWCC8R36HNU]->OutgoingTime

a.ReadAll

Private Sub btn_search_Click()
On Error GoTo errlbl
    Dim fso As FileSystemObject
    Dim f As Folder
    Dim a As TextStream
    Dim ist_path, rez_path As String

    Dim f_name As String
    
    Screen.MousePointer = 11
    ist_path = ""
    rez_path = ""
        
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set f = fso.GetFolder(ist_path)
       
       f_name = Dir(ist_path & "*.log", vbNormal)
        
       Set a = fso.OpenTextFile(ist_path & f_name, ForReading)

       While Not a.AtEndOfStream
            a.ReadLine
            'rst.AddNew: rst("str_fld") = a.ReadLine
            DoEvents            
        Wend        
        
        a.Close
        Set a = Nothing
    MsgBox "Анализ логов завершен!", vbInformation, ""
    Screen.MousePointer = 0
    
    Exit Sub
    
errlbl:
    Screen.MousePointer = 0
    MsgBox Err.Description, vbCritical + vbOKOnly, Err.Number
End Sub

    ------------->  Читаем файл <-----------------------
   |                               |                                         |
   |    если нашли UserInfo с заданным критерием--нет --
   |                               |
   |                              да
   |                               |
   |       выгружаем фрагмент в файл результат
   |                               |
   -----нет--- если читаемый файл EOF
   ^                               |
   |                               да
   |                                |
   |                   есть ли еще файлы-------------нет----------
   |                                |                                                 |
   |                               да                                    конец программы
   |                                |
   -------- переходим к следующему файлу

DoEvents

Attribute VB_Name = "FileParseM"

 strBufer=a.readAll 

Public Sub Test02()
    Dim strFilePath As String
   
    Dim dtmBegin As Date
    Dim dtmEnd As Date
    Dim dtmDifference As Date


    dtmBegin = Now

    strFilePath = "D:\work\LOGOUTPUT\system\tmp\tmp.txt"
    
    FileParse strFilePath

    dtmEnd = Now
    dtmDifference = dtmEnd - dtmBegin
    MsgBox "time " & Format(dtmDifference, "HH:mm:ss")
End Sub

Private Sub FileParse(ByVal strFilePath As String)
    Dim strBuffer As String

    FileRead strFilePath, strBuffer
    BufferParse strBuffer
End Sub

Private Sub FileRead(ByVal strFilePath As String, ByRef strBuffer As String)
    Dim lngFileLength As Long
    Dim lngFileHandle As Long

    lngFileHandle = FreeFile()
    Open strFilePath For Binary Access Read Shared As lngFileHandle

    lngFileLength = LOF(lngFileHandle)
    strBuffer = String(lngFileLength, 0)

    Get lngFileHandle, , strBuffer
    Close lngFileHandle
End Sub

Private Sub BufferParse(ByRef strBuffer As String)
    Dim CriteryPosition As Long        '-начальная позиция, найденного совпадения по заданному критерию
    Dim LnBeginSectionPos As Long      '-Начальная позиция секции лога
    Dim LnEndSectionPos As Long        '-Конечная позиция секции лога
    Dim lngCurrentPosition As Long     '-Текущая позиция в буфере
    Dim TmpPosition As Long            '-Промежуточная позиция в буфере при поиске начала и конца секции
    Dim strUserInfo As String          '-Переменная критерия поиска
    Dim strLineBegin As String         '-Сстроковое значение означающее начало строки
    'Dim strLineEnd As String           '-Строковое значение означающее конец строки
    Dim SectionBegin As String         '-Строковое значение означающее начало секции лога
    'Dim SectionEnd As String          '-Строковое значение означающее конец секции лога
    Dim strFound As String             '-Отобранная секция лога, подходящая по критерию поиска
    Dim strFileRezPath As String
    Dim FileHandle As Long

    strUserInfo = Me.fld_cliName.Text
    strLineBegin = vbCrLf
    'strLineEnd = vbCrLf
    SectionBegin = ">IncomingTime"
    'SectionEnd = ">OutgoingTime"
    strFileRezPath = "D:\work\LOGOUTPUT\system\tmp\tmp_rez.txt"
    FileHandle = FreeFile()
    Open strFileRezPath For Append Lock Write As FileHandle

    lngCurrentPosition = 1
    Do While lngCurrentPosition <= Len(strBuffer)
        ' ищем совпадения с критерием поиска
        CriteryPosition = InStr(lngCurrentPosition, strBuffer, strUserInfo, VbCompareMethod.vbTextCompare)
        'MsgBox CriteryPosition
        If CriteryPosition = 0 Then
            Exit Do
        End If

        ' если совпадения по критерию найдены ищем начало текущей секции по ">IncomingTime"
        TmpPosition = InStrRev(strBuffer, SectionBegin, CriteryPosition, VbCompareMethod.vbTextCompare)
        If TmpPosition = 0 Then
            Exit Do
        End If
        ' найдя начало строки, содержащей ">IncomingTime" найдем начало секции
        LnBeginSectionPos = InStrRev(strBuffer, strLineBegin, TmpPosition, VbCompareMethod.vbTextCompare)
        If LnBeginSectionPos = 0 Then
            Exit Do
        End If
        'Теперь найдем конец секции лога, искать будем опять по ">IncomingTime" но уже следующим за _
        позицией найденой по критерию поиска.
        ' line end
     
        TmpPosition = InStr(CriteryPosition, strBuffer, SectionBegin, VbCompareMethod.vbTextCompare)
        If TmpPosition = 0 Then
            Exit Do
        End If
        ' найдя начало строки, содержащей ">IncomingTime" найдем конец текущей секции _
        (оно же начало следующей секции)
        LnEndSectionPos = InStrRev(strBuffer, strLineBegin, TmpPosition, VbCompareMethod.vbTextCompare)
        If LnEndSectionPos = 0 Then
            Exit Do
        End If
        
        strFound = Mid(strBuffer, LnBeginSectionPos + Len(strLineBegin), LnEndSectionPos - LnBeginSectionPos - Len(strLineBegin))
        
        'MsgBox strFound
        
        'FileWrite strFileRezPath, strFound
        Print #FileHandle, strFound

        lngCurrentPosition = LnEndSectionPos ' + Len(strLineEnd)
    Loop
    Close FileHandle
End Sub