Как можно кусок из файла сохранить, зная диапазон Lines?

[kibernetics]

Ёххо, посоветуйте как ускорить цикл для выгрузки куска файла в новый файл. Сейчас делаю так:

Код: Выделить всё

Do While Not EOF(iFileNum)
    DoEvents
    Line Input #iFileNum, sLine 'считываем файл построчно
    sDocFile = sDocFile & sLine & vbNewLine
    If Left(sLine, 4) = "STOP" Then
        iFile = FreeFile
        Open sFilePath & sFile & ".txt" For Output Shared As iFile
            Print #iFile, sDocFile
        Close #iFile
        sDocFile = vbNullString
    End If
Loop

но медленно работает, файлы примерно по 10-11Мб, фрагментов в файле оканчивающих на STOP около 150
у меня есть возможность получения номеров Line со STOP'ами, может это как-то можно заюзать чтоб сразу кусками вынимать фрагменты?
структура файла примерно такая:

Код: Выделить всё

1 dfgfd
2 dfdhbfgn
3 ghrfyjt
4 dgfgh
STOP
1 vbftht
2 brfythj
3 tghrtjn
STOP
...

[Хакер]

Ёхохохоу!
Советую: откажись от текстового формата в пользу бинарного.

[iGrok]

Номера линий тут ничем не помогут. Вот если бы ты точные смещения блоков добыл..

А так - Open For Binary - грузить файл блоками в память, искать vbCrLf+"STOP" в блоках, тем самым получая смещения. И писать в новые файлы блоками.

[kibernetics]

Ну хорошо, грузанул я фрагмент в память, и там оказались концовка первого фрагмента и кусок начала следующего фрагмента...
Как мне потом отделить начало чтоб я с него уже новый фрагмент грузил?
Во завернул, но может понятно? Или может если нашёл, то файл, а потом append делать...
А ни у кого ничего на примете нет подсмотреть?
Надо завтра в работу выдать, а код тормознутый жестоко.

[iGrok]

Ну хорошо, грузанул я фрагмент в память, и там оказались концовка первого фрагмента и кусок начала следующего фрагмента...
Как мне потом отделить начало чтоб я с него уже новый фрагмент грузил?
Во завернул, но может понятно? Или может если нашёл, то файл, а потом append делать...
А ни у кого ничего на примете нет подсмотреть?
Надо завтра в работу выдать, а код тормознутый жестоко.

Так. Ну смотри.
Во-первых, 10 метров это не так уж и много. Можно и целиком в память грузить. Хоть в String.
А там уже InStr тебе поможет найти начала фрагментов. Считаешь их, находишь нужный по счёту, запоминаешь позицию начала. Находишь следующий, запоминаешь позицию конца.
Пишешь в файл нужный фрагмент. Т.е. если это всё-таки String, то Mid$(strBuffer, Позиция_Начала, Позиция_Конца - Позиция_Начала).

Во-вторых, если всё-таки чтение блоками - точно так же забираешь конец первого блока, и нужное кол-во символов из второго, третьего и т.п.

[kibernetics]

Ну в общем идею я с большего понял.
Надо это всё в байты будет както грамотно перевести.
Сегодня уже нет сил.

П.С. А писать лучше Print или Put?

[alibek]

Это разные вещи.
Для бинарных файлов — Put.

[gjghjc]

kibernetics А зачем ты сначала все запихиваешь в одну переменную, ищешь в ней "STOP" и только потом пишешь в файл?
И долго это сколько??
У меня код

Код: Выделить всё

Private Sub CommandButton1_Click()
'    n = 0
    fso.CreateTextFile "D:\VYP\OUTPUT\temp.txt", True, False
   
    Set pFileRead = fso.GetFile(lstSrcFile.Text)
    Set pFileWrite = fso.GetFile("D:\VYP\OUTPUT\temp.txt")
   
    Set txtStreamRead = pFileRead.OpenAsTextStream(ForReading)
    Set txtStreamWrite = pFileWrite.OpenAsTextStream(ForWriting)
   
    Extention = Split(pFileRead.Name, ".", -1, vbTextCompare)
    FilExt = Extention(1)
   
    Do Until txtStreamRead.AtEndOfStream = True
       
        TmpStr = txtStreamRead.ReadLine
       
        DoEvents
       
        Select Case InStr(1, TmpStr, "Получатель:", vbTextCompare)
            Case Is > 0
                TmpArr = Split(TmpStr, ":", -1, vbTextCompare)
                NameOfFile = Trim(TmpArr(1))
        End Select
       
        Select Case InStr(1, TmpStr, "Номер основного счета:", vbTextCompare)
            Case Is > 0
                TmpArr = Split(TmpStr, ":", -1, vbTextCompare)
                NameOfFile = NameOfFile & "_" & Trim(TmpArr(1))
        End Select
       
       
       
        Select Case InStr(1, TmpStr, "<Next statement>", vbTextCompare)
               
            Case Is = 0
               
                txtStreamWrite.WriteLine TmpStr
               
            Case Is > 0
               
                txtStreamWrite.Close
                FileCopy "D:\VYP\OUTPUT\temp.txt", "D:\VYP\OUTPUT\" & Mnth & FilExt & "_" & NameOfFile & ".txt"
                fso.CreateTextFile "D:\VYP\OUTPUT\temp.txt", True, False
                Set txtStreamWrite = pFileWrite.OpenAsTextStream(ForWriting)
                               
        End Select
       

   
txtStreamRead.Close
txtStreamWrite.Close
   MsgBox "Нарезка завершена!"
End Sub

Порезал файл 180 метров на отдельные куски за 11минут 07 секунд. Кусков получилось порядка 24 тысяч. Сидел с секундомером замерял. В минуту выгружалось около 16,7 метра.
Пень4 3ГГц 512 оперативки

[jangle]

А не проще создать многопоточное приложение и не мучится?
Написать NativeDLL, в котором создается отдельный тред для сохранения файла.
Программа скидывает туда указатель на блок данных (хоть гигабайт) и адрес CallBack функции для оповещения.
И спокойно работает дальше, обычное фоновое сохранение. Когда поток сохранит данные, он вызовет CallBack функцию в основном приложении, и сообщит, что он кончил работу

[kibernetics]

Да ну, пацаны, вы б ещё предложили отдельно кластер выделить для этой затеи.
Я решил, что самый дельным советом было именно использование байтов.
Короче, сварганил что смог, пробуйте:

Код: Выделить всё

    Dim lFilePos        As Long
    Dim lFileBuffer     As Long
    Dim lFileLength     As Long
    Dim sBuffer         As String
    Dim iMemSizeMB      As Double
    Dim sLookFor        As String
   
    iMemSizeMB = 8
    lFilePos = 1
    lFileBuffer = iMemSizeMB * 1048576 '1 MB буфер
   
    'открываем файл
    iFileNum = FreeFile
    Open sFilePath For Binary Access Read As #iFileNum

    lFileLength = LOF(iFileNum) 'длина файла
    lPos2 = 1
    k = 0
    sLookFor = vbLf & "STOP" 'ищем перевод строки и STOP
   
    Do While (lFilePos <= lFileLength)
       
        If (lFilePos + lFileBuffer) > lFileLength Then
            lFileBuffer = lFileLength 'если буфер больше длины файла равняемся на длину
        End If
       
        sBuffer = Space(lFileBuffer) 'выделяем место для буфа
        Get #iFileNum, lFilePos, sBuffer
        lFilePos = lFilePos + Len(sBuffer) 'подвигаемся
       
        lPos2 = 0
       
        Do
            lPos = InStr(lPos + Len(sLookFor), sBuffer, sLookFor)
            If lPos > 0 Then
                sOemLine = sOemLine & Mid(sBuffer, lPos2 + 1, lPos - lPos2 + 1)
                l = FreeFile
                k = k + 1
                Open "D:\!TEST_OUT\" & k & ".txt" For Binary Shared As l 'сохраняем что нашли
                    Put #l, , sOemLine
                Close #l
                lPos2 = lPos + Len(sLookFor)
                sOemLine = vbNullString
            Else
                sOemLine = sOemLine & Mid(sBuffer, lPos2 + 1) 'тут небольшое лишнее присвоение, если уже конец файла, надо поправить както
                Exit Do
            End If
        Loop
       
        DoEvents
    Loop

в общем, всё по -сырому, если кто чего заметит - маякуйте. ибо, данные очень серьёзные.

[kibernetics]

ошибку случайно заметил, ваще.
в общем, если схватился фрагмент, в конце которого один символ из искомой строки, то следующий фрагмент отработан не будет. беда

[Williams]

в общем, всё по -сырому, если кто чего заметит - маякуйте. ибо, данные очень серьёзные.

Неужели любовные письма?

[iGrok]

Как-то так...

Код: Выделить всё

Sub SplitFile(sFileName As String)
Dim hFile As Long, lFilePos As Long, lFileLen As Long
Dim sBuffer As String, lBufferPos As Long, lBufferSize As Long
Dim lSearchPos As Long, sSearchString As String, sFirstSearchSym As String, lSearchStringLen As Long
Dim hOutFile As Long, lOutFileNumber As Long, sOutPathMask As String

    'Установки - размер буфера, разделитель, и "маска" выходных файлов
    lBufferSize = 3000 '1048576 * 8
    sSearchString = vbCrLf & "STOP" & vbCrLf
    sOutPathMask = "d:\testout"

    'Код обработки. Ниже нужно поменять только способ именования выходных файлов.
    sFirstSearchSym = Left$(sSearchString, 1)
    lSearchStringLen = Len(sSearchString)

    hFile = FreeFile
    Open sFileName For Binary Access Read As hFile

    lFileLen = LOF(hFile)
    lFilePos = 1
    lOutFileNumber = 1

    If lFileLen > 0 Then
        hOutFile = FreeFile
        Open sOutPathMask & lOutFileNumber For Binary As hOutFile

        Do
            'Получаем блок данных
            sBuffer = Space$(lBufferSize)
            Get #hFile, lFilePos, sBuffer

            If lFileLen - lFilePos < lBufferSize Then
                'Если остаток файла меньше буфера - правим размер и режем буфер
                lBufferSize = lFileLen - lFilePos + 1
                sBuffer = Left$(sBuffer, lBufferSize)
            End If

            lBufferPos = 1
            lSearchPos = 1

            'Ищем разделители
            Do
                'Ищем первый символ разделителя внутри блока:
                lSearchPos = InStr(lSearchPos, sBuffer, sFirstSearchSym)
                If lSearchPos > 0 Then
                    If lBufferSize - lSearchPos >= lSearchStringLen Then
                        'Если остаток блока больше или равен длине разделителя - проверяем разделитель.
                        If (Mid$(sBuffer, lSearchPos, lSearchStringLen) = sSearchString) Then
                            'Скидываем нужный кусок текущего блока в текущий файл
                            Put #hOutFile, , Mid$(sBuffer, lBufferPos, lSearchPos - lBufferPos)
                            'Закрываем файл
                            Close #hOutFile
                            'Следующий файл
                            lOutFileNumber = lOutFileNumber + 1
                            hOutFile = FreeFile
                            Open sOutPathMask & lOutFileNumber For Binary As hOutFile
                            'Правим указатель положения в буфере:
                            lBufferPos = lSearchPos + lSearchStringLen
                            lSearchPos = lBufferPos
                        Else
                            lSearchPos = lSearchPos + 1
                        End If
                    Else
                        'Скидываем оставшийся блок до этого места в текущий файл, и смотрим следующий.
                        Put #hOutFile, , Mid$(sBuffer, lBufferPos, lSearchPos - lBufferPos)
                        'Сдвигаем указатель на длину блока до этого места
                        lFilePos = lFilePos + lSearchPos - 1
                        'Вообще говоря, тут получается косяк. Последний кусок, который меньше
                        'длины искомой строки, но начинается на первый символ искомой строки,
                        'мы читаем из файла два раза. Можно это поправить, но это усложнит код.
                        'Мне было влом.

                        'И выходим во внешний цикл - за следующим блоком
                        Exit Do
                    End If
                Else
                    'Разделитель не найден. Скидываем в файл весь оставшийся блок, и смотрим следующий.
                    Put #hOutFile, , Mid$(sBuffer, lBufferPos)
                    'Сдвигаем указатель в файле на длину блока
                    lFilePos = lFilePos + lBufferSize
                    'И выходим во внешний цикл - за следующим блоком
                    Exit Do
                End If
            Loop While lBufferPos < lBufferSize
        Loop While lFilePos < lFileLen
    End If

    Close hOutFile
    Close hFile
End Sub


З.Ы. Писал в общем-то тоже не задумываясь об оптимизации. Сейчас в принципе вижу, что можно сделать чуть проще - но править влом. )

[kibernetics]

iGrok, я решил в общем не перегружать код и добавил просто проверку вначале, что мол если есть в конце буфера последовательность символов, то буфер режем и уменьшаем lFilePos.

Код: Выделить всё

For l = Len(sLookFor) To 1 Step -1
            If Right(sBuffer, l) = Left(sLookFor, l) Then
                sBuffer = Left(sBuffer, Len(sBuffer) - l)
                Exit For
            End If
        Next

[iGrok]

iGrok, я решил в общем не перегружать код и добавил просто проверку вначале, что мол если есть в конце буфера последовательность символов, то буфер режем и уменьшаем lFilePos.

Код: Выделить всё

For l = Len(sLookFor) To 1 Step -1
            If Right(sBuffer, l) = Left(sLookFor, l) Then
                sBuffer = Left(sBuffer, Len(sBuffer) - l)
                Exit For
            End If
        Next

Ну это было моей первой мыслью при попытке реализации такой же штуки. Почему-то я от неё отказался. Почему - не помню. =)
Вообще, должно работать корректно. )

[SSecurity]

Код: Выделить всё

Dim Buffer As String, tmp() As String, I As Long, FSO As New FileSystemObject
Buffer = FSO.OpenTextFile("File1.txt").ReadAll
tmp = Split(Buffer, "STOP" & vbCrLf)
For I = 0 To UBound(tmp)
  Open "outFile" & I & ".txt" For Output As #1
    Print #1, tmp(I)
  Close #1
Next I

а это все фрагменты в разные файлы но ОООООчень долго
14 секунд создавался файл 214 649 706 байт, программа закрылась на 21778 файлов (сказала что слишком много файлов)

[iGrok]

Код: Выделить всё

Dim Buffer As String, tmp() As String, I As Long, FSO As New FileSystemObject
Buffer = FSO.OpenTextFile("File1.txt").ReadAll
tmp = Split(Buffer, "STOP" & vbCrLf)
For I = 0 To UBound(tmp)
  Open "outFile" & I & ".txt" For Output As #1
    Print #1, tmp(I)
  Close #1
Next I

а это все фрагменты в разные файлы но ОООООчень долго
14 секунд создавался файл 214 649 706 байт, программа закрылась на 21778 файлов (сказала что слишком много файлов)

Файл, скажем, на 2 гига ты тоже будешь грузить в строку?

[SSecurity]

Файл, скажем, на 2 гига ты тоже будешь грузить в строку?

нет, для 2х гиговых файлов лучше использовать поблочное считывание (будь то строка либо конкретный блок).

[iGrok]

Файл, скажем, на 2 гига ты тоже будешь грузить в строку?

нет, для 2х гиговых файлов лучше использовать поблочное считывание (будь то строка либо конкретный блок).

А два алгоритма, реализующих блочное считывание, представленные выше - не катят в качестве "правильного ответа" на вопрос темы? =)

[kibernetics]

незнаю. мама в детстве рекомендовала, чтобы я не пользовался фсо.
вот с детства стараюсь обходить его стороной.