|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Разбиение текста на Delphi
И вот вопрос: Есть один минус и сразу вопрос: Как сделать что бы если количество строк не кратно количеству частей то последний файл меньше ?. То есть пусть все первые файлы равны, последний меньше.
Потому что в данном случае делит не правильно. Код:
procedure TForm1.Button1Click(Sender: TObject); const //Количество частей на которые надо разбить файл. N = 10; var F1, F2 : File; i, SizePart, SizePartAdd : Cardinal; Buff : array of Byte; begin if OpenDialog1.InitialDir = '' then begin OpenDialog1.InitialDir := ExtractFilePath(Application.ExeName); end; if not OpenDialog1.Execute then Exit; if not FileExists(OpenDialog1.FileName) then begin ShowMessage('Указанный файл не найден. Действие отменено.'); Exit; end; AssignFile(F1, OpenDialog1.FileName); Reset(F1, 1); if FileSize(F1) < N then begin ShowMessage('Указанный файл слишком мал. Разбиение отменено.'); CloseFile(F1); Exit; end; SizePart := FileSize(F1) div N; SizePartAdd := FileSize(F1) mod N; SetLength(Buff, SizePart); for i := 1 to N do begin AssignFile(F2, OpenDialog1.FileName + '.part' + IntToStr(i)); Rewrite(F2, 1); BlockRead(F1, Pointer(Buff)^, SizePart); BlockWrite(F2, Pointer(Buff)^, SizePart); if (i = N) and (SizePartAdd > 0) then begin BlockRead(F1, Pointer(Buff)^, SizePartAdd); BlockWrite(F2, Pointer(Buff)^, SizePartAdd); end; CloseFile(F2); end; CloseFile(F1); end; |
#2
|
||||
|
||||
Код:
uses Math; procedure CutFile(FileName: string; Parts: Integer); var Src, Trg: TFileStream; PartSize: Int64; i: Integer; begin Src := TFileStream.Create(FileName, fmOpenRead); try if Parts <= Src.Size then begin PartSize := Ceil(Src.Size / Parts); for i := 1 to Parts do begin Trg := TFileStream.Create(FileName + '.part' + IntToStr(i), fmCreate); try if Src.Size - Src.Position < PartSize then PartSize := Src.Size - Src.Position; Trg.CopyFrom(Src, PartSize); finally Trg.Free; end; end; end; finally Src.Free; end; end; procedure TForm1.Button1Click(Sender: TObject); begin if OpenDialog1.Execute then begin CutFile(OpenDialog1.FileName, 10); ShowMessage('Done'); end; end; Грамотно поставленный вопрос содержит не менее 50% ответа. Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть. |
Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение: | ||
Taras2020 (04.02.2018)
|
#3
|
|||
|
|||
Код то быстро работает но: Если взять к примеру текстовый файл с текстом и разбить его на 3 файла:
55555555555555555555 55555555555555555555 55555555555555555555 55555555555555555555 55555555555555555555 То при разбитии, к примеру, на три файла получается: В первом файле вот такое: 55555555555555555555 55555555555555 Во втором файле вот такое: 555555 55555555555555555555 555555 В третьем файле вот такое: 55555555555555 55555555555555555555 То есть программа обрезает строки, а нужно что бы было: В первом файле вот такое: 55555555555555555555 55555555555555555555 Во втором файле вот такое: 55555555555555555555 55555555555555555555 В третьем файле вот такое: 55555555555555555555 Возможно так сделать ? Последний раз редактировалось Taras2020, 04.02.2018 в 12:24. |
#4
|
||||
|
||||
Здесь "резка" идёт по байтам, а не по строкам, тогда нужно реагировать на перевод каретки, но это слегка затратно, проще использовать возможности класса TStrings, примерно так
Код:
procedure CutFile(FileName: string; PartStrCnt: integer); var sl1, sl2: TStrings; i, j: integer; begin sl1:= TStringList.Create; sl2:= TStringList.Create; sl1.LoadFromFile(FileName); i:= 1; for j := 0 to sl1.Count-1 do begin sl2.Add(sl1[j]); if sl2.Count = PartStrCnt then begin sl2.SaveToFile(FileName + '.part' + IntToStr(i)); sl2.Clear; inc(i); end; end; sl2.SaveToFile(FileName + '.part' + IntToStr(i)); sl1.Free; sl2.Free; end; Я не понял Вашего вопроса, но всё же Вам на него отвечу! |
Этот пользователь сказал Спасибо Alegun за это полезное сообщение: | ||
Taras2020 (04.02.2018)
|
#5
|
|||
|
|||
Цитата:
|
#6
|
||||
|
||||
К сожалению, сложно - одно дело в потоке файл на куски резать, совсем другое - ещё и за содержимым получившихся кусков следить, поэтому, раз файл текстовый, то и резать его нужно построчно
Я не понял Вашего вопроса, но всё же Вам на него отвечу! |
Этот пользователь сказал Спасибо Alegun за это полезное сообщение: | ||
Taras2020 (04.02.2018)
|
#7
|
||||
|
||||
Код:
procedure CutTextFile(FileName: string; Parts: Integer); var Src, Trg: TextFile; LineCount, LineCountInPart, i, j: Integer; tmp_str: string; begin LineCount := 0; AssignFile(Src, FileName); Reset(Src); while not Eof(Src) do begin Readln(Src, tmp_str); Inc(LineCount); end; CloseFile(Src); if LineCount >= Parts then begin Reset(Src); LineCountInPart := Ceil(LineCount / Parts); for i := 1 to Parts do begin AssignFile(Trg, FileName + '.part' + IntToStr(i)); Rewrite(Trg); j := 0; while (not Eof(Src)) and (j < LineCountInPart) do begin ReadLn(Src, tmp_str); Writeln(Trg, tmp_str); Inc(j); end; CloseFile(Trg); end; CloseFile(Src); end; end; Грамотно поставленный вопрос содержит не менее 50% ответа. Грамотно поставленная речь вызывает уважение, а у некоторых даже зависть. |
Этот пользователь сказал Спасибо dr. F.I.N. за это полезное сообщение: | ||
Taras2020 (04.02.2018)
|
#8
|
|||
|
|||
Спасибо ребята, сейчас буду пробовать!.
|
#9
|
||||
|
||||
Оффтоп: 2 dr. F.I.N.
Оно работает, на гиговом словаре режет норм, но только почему-то тормозит, хотя должна быть это самая шустрая реализация, через класс StringList немного быстрее получается З.Ы. Во, затык на AssignFile происходит, на большом текстовике, причём к концу файла всё заметнее и заметнее Я не понял Вашего вопроса, но всё же Вам на него отвечу! Последний раз редактировалось Alegun, 04.02.2018 в 15:06. |