Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 31.01.2018, 15:36
Taras2020 Taras2020 вне форума
Прохожий
 
Регистрация: 15.01.2018
Сообщения: 36
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Разбить текст на части, подсказка

Добрый день уважаемые пользователи.
Этот код разбивает текст на части и сохраняет в одной папке.

Вопрос такого плана: Как сделать что бы каждый файл сохранялся в отдельной папке при разбитии ?.
Код:
procedure TForm2.Button1Click(Sender: TObject);


  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;

Последний раз редактировалось Taras2020, 18.04.2018 в 22:42.
Ответить с цитированием
  #2  
Старый 31.01.2018, 21:32
Аватар для @Rafa3L
@Rafa3L @Rafa3L вне форума
Начинающий
 
Регистрация: 09.11.2011
Адрес: Москва
Сообщения: 144
Версия Delphi: XE2
Репутация: 11216
По умолчанию

Код:
...
 s:= ExtractFilePath(Application.ExeName) + 'Folder' + IntToStr(i);
 if ForceDirectories(s) then.. {Появилась такая папка, туды и класть}
...
__________________
Помогаю платно.
Помогаю иногда бесплатно.
Ответить с цитированием
Этот пользователь сказал Спасибо @Rafa3L за это полезное сообщение:
Taras2020 (04.02.2018)
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 18:57.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter