Построчное разрезание TXT-файла

Tol!k · Сообщение **Tol!k** » Ср янв 13, 2010 14:27

Batya, Volniy
Для текстовых файлов, завершающий перевод строки — это правильно.
Потеря остатка, если он меньше n строк — ошибка.
Проверьте ваши скрипты обратной сборкой файла (TC'ом)

Volniy · Сообщение **Volniy** » Ср янв 13, 2010 17:40

Batya писал(а):Только, на мой взгляд, если разбиваем по 3 строки, то в итоговых файлах должно быть по 3 строки, а не 4, как сейчас.

Ну нет же реально никакой 4-ой строки, она же пустая, без единого символа.

Batya писал(а):Ничего подобного - .ReadLine нормально отрабатывает на последней строке без замыкающего vbNewLine.

Это может быть. Я помню по аналогичной функции в VB, там не работало. А вот то, что я говорил про .WriteLine - факт, проверил только что. Так что хотя бы ради устаранения этого явления, уже нужно добавлять vbnewline.

А вообще слона-то ты и не заметил, Batya. В скрипте неправильный выход из цикла я сделал. Из-за этого если в последнем куске меньше строк чем n, весь кусок не записывается в файл. Исправил.

---

Проверил вот сейчас свой скрипт обратной сборкой Тоталом и получил исходный файл байт в байт. Зеер гут значит. На этом и остановлюсь.

Со Старым Новым Годом всех!

Batya · Сообщение **Batya** » Ср янв 13, 2010 18:12

Tol!k писал(а):Для текстовых файлов, завершающий перевод строки — это правильно.
Потеря остатка, если он меньше n строк — ошибка.
Проверьте ваши скрипты обратной сборкой файла (TC'ом)

ОК. Поменял скрипт.

Volniy писал(а):А вообще слона-то ты и не заметил

Да я и не искал

Просто бросилось в глаза.

---

Volniy писал(а):Проверил вот сейчас свой скрипт обратной сборкой Тоталом и получил исходный файл байт в байт.

На твоём (и на моём впрочем то же) скрипте на текстовом файле без переноса строки в конце файла не получается байт в байт

Также на твоем скрипте TC не будет полностью собирать при числе частей больше 10.

Tol!k · Сообщение **Tol!k** » Чт янв 14, 2010 01:47

Batya писал(а):
Volniy писал(а):Проверил вот сейчас свой скрипт обратной сборкой Тоталом и получил исходный файл байт в байт.
На твоём (и на моём впрочем то же) скрипте на текстовом файле без переноса строки в конце файла не получается байт в байт

В конце текстового файла лишний перевод строки не так страшен

Batya писал(а):Также на твоем скрипте TC не будет полностью собирать при числе частей больше 10.

Это особенность алгоритма сборки ТС — номера частей должны иметь одинаковое кол-во знаков: 001 ... 010 ... 100

JayK · Сообщение **JayK** » Чт янв 14, 2010 08:12

Batya
Огромное спасибо, работает, а чтобы расширение было txt а имя файла под номером? можно сделать

JayK · Сообщение **JayK** » Чт янв 14, 2010 08:14

Batya
и еще скрипт не выводит сообщений, типа
.Add 0, "Разрезание файлов на строки"
.Add 1, "Не указаны параметры!"
.Add 2, "Файл-список не существует!"
.Add 3, "Операция завершена."

Batya · Сообщение **Batya** » Чт янв 14, 2010 09:17

Tol!k писал(а):Это особенность алгоритма сборки ТС — номера частей должны иметь одинаковое кол-во знаков: 001 ... 010 ... 100

Я это уже понял и у себя реализовал.

JayK писал(а):Batya
и еще скрипт не выводит сообщений

А ты запусти скрипт без параметров и увидишь сообщение

А если хочешь получить сообщение по завершению работы, удали апостроф в начале строки:

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

'MessBox Mess(3), 3

JayK писал(а):Batya
Огромное спасибо, работает, а чтобы расширение было txt а имя файла под номером? можно сделать

Какого вида имя должно быть? Например, "Name.01.ext", подойдет?

JayK · Сообщение **JayK** » Чт янв 14, 2010 10:42

Batya
точно, вижу сообщение.

Какого вида имя должно быть? Например, "Name.01.ext", подойдет?

пойдет, только не *.ext а именно *.txt
скрипт нужен для нарезки больших файлов для закачки на плеер, а он других форматов не видит... еще html резать и ini по ходу придется....

Batya · Сообщение **Batya** » Чт янв 14, 2010 14:11

JayK писал(а):пойдет, только не *.ext а именно *.txt

ext - это Extension. Я имел ввиду, что я здесь вставлю расширение исходного файла.
Готово. Исправил скрипт. Поменяй у себя:

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

Const NameMode    = 1 'Режим формирования имен файлов

JayK · Сообщение **JayK** » Пт янв 15, 2010 01:45

Batya
Все работает, еще одно огромнейшее спасибо;)

Rotmistr

Гуглил вариант проги, разбивающей текст-файлы построчно или по кол-ву слов. Но такие шикарные вариации в ТС за столько лет использования не встречал. Браво!

А что бы в название после разбивки из текста выводились первые 1-2-3 слова - реально? С расширением *.txt .

Batya · Сообщение **Batya** » Пн окт 25, 2010 13:13

Rotmistr писал(а):А что бы в название после разбивки из текста выводились первые 1-2-3 слова - реально?

Наконец руки дошли.
Старый пост поправить не могу. Привожу новый вариант скрипта:

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

'=====================================================================
' Разрезание выделенных файлов на заданное количество строк
'
' Параметры:
' {файл-список} [{количество строк}]
'
' Пример вызова из TC:
' %L 2
'=====================================================================
Option Explicit
Dim CharArr
'======== Изменяемые параметры =======================================
Const DefRowCount = 1 'Количество строк по умолчанию
Const NameMode    = 4 'Режим формирования имен файлов
'Варианты режима формирования имен:
'  0 - {Имя}.{Расширение}.{Номер части}
'  1 - {Имя}.{Номер части}.{Расширение}
'  2 - {Имя}_{Номер части}.{Расширение}
'  3 - {Имя}[{Номер части}].{Расширение}
'  4 - {Первые несколько слов текста}.{Расширение}
Const WordsCount  = 3 'Количество слов для режима 4 формирования имен
'Массив недопустимых символов имени. Заменяем их указанным ниже символом
CharArr = Split(Chr(10) & " " & Chr(13) & " \ / * ? "" < > . ,")
'Символ для замены недопустимого символа
Const ReplaceChar = " "
'=====================================================================
Dim Mess, FSO, WSH, FF, RowCount
SetMess
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")

On Error Resume Next
CheckParam:CheckErr
Main:CheckErr
'MessBox Mess(3), 3
Quit 0

Sub Main
  Dim F
  For Each F In Split(FSO.OpenTextFile(FF).ReadAll, vbNewLine)
    Action F
  Next
End Sub

Sub Action(pPath)
  Dim lText, lT, lCnt, lPath, lArr, lR, lNum, lNewPath
  If pPath = "" Then Exit Sub
  lPath = GetPath(pPath)
  If Not FSO.FileExists(lPath) Then Exit Sub
  lText = FSO.OpenTextFile(lPath).ReadAll
  lCnt  = 0
  lArr  = CutText(lText, RowCount)
  lR    = Len(CStr(UBound(lArr)))
  For Each lT In lArr
    lNum = Right(String(lR, "0") & CStr(lCnt), lR)
    Select Case NameMode
      Case 0 lNewPath = lPath & "." & lNum
      Case 1 lNewPath = FSO.GetParentFolderName(lPath) & "" & FSO.GetBaseName(lPath) &_
                        "." & lNum & "." & FSO.GetExtensionName(lPath)
      Case 2 lNewPath = FSO.GetParentFolderName(lPath) & "" & FSO.GetBaseName(lPath) &_
                        "_" & lNum & "." & FSO.GetExtensionName(lPath)
      Case 3 lNewPath = FSO.GetParentFolderName(lPath) & "" & FSO.GetBaseName(lPath) &_
                        "[" & lNum & "]." & FSO.GetExtensionName(lPath)
      Case 4 lNewPath = FSO.GetParentFolderName(lPath) & "" & GetSomeWords(ReplaceInadmissibleChars(lT), WordsCount) &_
                        "." & FSO.GetExtensionName(lPath)
    End Select
    FSO.CreateTextFile(lNewPath, True).Write lT
    lCnt = lCnt + 1
  Next
End Sub

Function CutText(pText, pRowCount)
  Dim lArr, lR, lR1, l, l1, l2, l3
  lArr = Split(pText, vbNewLine)
  lR   = UBound(lArr)
  lR1  = -Int(-(lR + 1)/pRowCount) - 1
  ReDim lArr1(lR1)
  For l = 0 To lR1
    l1 = (l + 1) * pRowCount - 1
    l2 = pRowCount - 1
    If l1 > lR Then l2 = lR - l * pRowCount
    For l3 = 0 To l2
      lArr1(l) = lArr1(l) & lArr(l3 + l1 - pRowCount + 1) & vbNewLine
    Next
  Next
  lArr1(lR1) = Left(lArr1(lR1), Len(lArr1(lR1)) - Len(vbNewLine))
  CutText = lArr1
End Function

Sub CheckParam
  With WScript
    If .Arguments.Count = 0 Then Err.Raise vbObjectError + 1, "", Mess(1)
    FF = GetPath(.Arguments(0))
    If Not FSO.FileExists(FF) Then Err.Raise vbObjectError + 2, "", Mess(2)
    If .Arguments.Count > 1 Then
      RowCount = .Arguments(1)
      If IsNumeric(RowCount) Then
        RowCount = CInt(RowCount)
      Else
        RowCount = DefRowCount
      End If
    Else
      RowCount = DefRowCount
    End If
  End With
End Sub

Function GetSomeWords(pText, pNumWords)
  Dim regEx, lM, l, lF, lNum
  Set regEx     = New RegExp
  regEx.Pattern = "\S+"
  regEx.Global  = True
  Set lM        = regEx.Execute(pText)
  If  lM.Count  < pNumWords Then
    lNum = lM.Count
  Else
    lNum = pNumWords
  End If
  For l = 1 To lNum
    lF = lF & " " & lM.Item(l-1).Value
  Next
  GetSomeWords = Mid(lF, 2)
  Set lM    = Nothing
  Set regEx = Nothing
End Function

Function ReplaceInadmissibleChars(pText)
  Dim lC
  ReplaceInadmissibleChars = pText
  For Each lC In CharArr
    ReplaceInadmissibleChars = Replace(ReplaceInadmissibleChars, lC, ReplaceChar)
  Next
End Function

Function GetPath(pPath)
  GetPath = FSO.GetAbsolutePathName(WSH.ExpandEnvironmentStrings(pPath))
End Function

Sub CheckErr
  If Err.Number <> 0 Then
    MessBox "Возникла ошибка № " & Err.Number & ":" & vbNewLine & Err.Description, 1
    Quit Err.Number
  End If
End Sub

Function MessBox(pMess, pMode)
  Dim lIcon
  Select Case pMode
    Case 1 lIcon = vbCritical    + vbOKOnly
    Case 2 lIcon = vbExclamation + vbOKOnly
    Case 3 lIcon = vbInformation + vbOKOnly
  End Select
  MessBox = MsgBox(pMess, lIcon, Mess(0))
End Function

Sub SetMess
  Set Mess = CreateObject("Scripting.Dictionary")
  With Mess
    .Add 0,  "Разрезание файлов на строки"
    .Add 1,  "Не указаны параметры!"
    .Add 2,  "Файл-список не существует!"
    .Add 3,  "Операция завершена."
  End With
End Sub

Sub Quit(pQuitCode)
  Set Mess = Nothing
  Set WSH  = Nothing
  Set FSO  = Nothing
  WScript.Quit pQuitCode
End Sub

Здесь в шапке "Изменяемые параметры" обрати внимание на массив CharArr и константы WordsCount и ReplaceChar.

Rotmistr писал(а):С расширением *.txt .

Мне показалось, что жёстко прописывать расширение "txt" не совсем красиво, но если уж тебе сильно надо, то поменяй в скрипте:

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

      Case 4 lNewPath = FSO.GetParentFolderName(lPath) & "" & ReplaceInadmissibleChars(GetSomeWords(lT, WordsCount)) &_
                        "." & FSO.GetExtensionName(lPath)

на

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

      Case 4 lNewPath = FSO.GetParentFolderName(lPath) & "" & ReplaceInadmissibleChars(GetSomeWords(lT, WordsCount)) &_
                        ".txt"

Rotmistr

Batya
ОГРОМНОЕ СПАСИБО! Буду разбираться, пробовать

Rotmistr

Batya
Спасибо. Работает, хоть и выдает сообщения об ошибках. Например: Возникла ошибка №76: Путь не найден.

Batya · Сообщение **Batya** » Ср окт 27, 2010 14:13

Rotmistr писал(а):Работает, хоть и выдает сообщения об ошибках. Например: Возникла ошибка №76: Путь не найден.

Видимо, первые несколько слов для какого-то файла включают недопустимый для имени файла символ, который не перечислен в массиве CharArr.

Для проверки вставь перед строкой

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

    FSO.CreateTextFile(lNewPath, True).Write lT

следующий код:

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

    MsgBox "Попытка сформировать файл """ & lNewPath & """ с содержимым:" & vbNewLine & vbNewLine & lT, 0, Mess(0)

Total Commander

Построчное разрезание TXT-файла

Это просто потрясно!