[Taras2020]

И вот вопрос: Есть один минус и сразу вопрос: Как сделать что бы если количество строк не кратно количеству частей то последний файл меньше ?. То есть пусть все первые файлы равны, последний меньше.

Потому что в данном случае делит не правильно.

Код:

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;

[dr. F.I.N.]

Код:

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;

[Taras2020]

Код то быстро работает но: Если взять к примеру текстовый файл с текстом и разбить его на 3 файла:
55555555555555555555
55555555555555555555
55555555555555555555
55555555555555555555
55555555555555555555

То при разбитии, к примеру, на три файла получается:
В первом файле вот такое:
55555555555555555555
55555555555555
Во втором файле вот такое:
555555
55555555555555555555
555555
В третьем файле вот такое:
55555555555555
55555555555555555555

То есть программа обрезает строки, а нужно что бы было:
В первом файле вот такое:
55555555555555555555
55555555555555555555
Во втором файле вот такое:
55555555555555555555
55555555555555555555
В третьем файле вот такое:
55555555555555555555

Возможно так сделать ?

[Alegun]

Здесь "резка" идёт по байтам, а не по строкам, тогда нужно реагировать на перевод каретки, но это слегка затратно, проще использовать возможности класса 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;

[Taras2020]

Сообщение от Alegun

Здесь "резка" идёт по байтам, а не по строкам, тогда нужно реагировать на перевод каретки, но это слегка затратно, проще использовать возможности класса TStrings, примерно так

На коде что выше можете продемонстрировать, если не сложно

[Alegun]

К сожалению, сложно - одно дело в потоке файл на куски резать, совсем другое - ещё и за содержимым получившихся кусков следить, поэтому, раз файл текстовый, то и резать его нужно построчно

[dr. F.I.N.]

Код:

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;

[Taras2020]

Спасибо ребята, сейчас буду пробовать!.

[Alegun]

Оффтоп: 2 dr. F.I.N.
Оно работает, на гиговом словаре режет норм, но только почему-то тормозит, хотя должна быть это самая шустрая реализация, через класс StringList немного быстрее получается

З.Ы. Во, затык на AssignFile происходит, на большом текстовике, причём к концу файла всё заметнее и заметнее