1

Программа написанная на Delphi, создает каждый день новую директорию и собирает файлы со всех машин. Мне нужно, чтобы происходила архивация папок (директорий которые создала программа) через каждые 20 дней.

Например, были созданы папки программой: 2.02 и 3.02 мне нужно что бы 22.02 заархивировалась папка 2.02, а 23.02 заархивировалась папка 3.02. Как это сделать?

1
  • Получить дату на 20 дей раньше текущей: backDate := IncDay(todayDate, -20);
    – user6550
    1 мая 2013 в 23:21

2 ответа 2

1

при старте программы проверяешь текущую дату. архивируешь. в реестре записываешь дату последней архивации. потом при каждом старте проверяешь когда последний раз была архивация, если разница >=20 дней-заново архивируешь, и обновляешь дату в реестре. можешь даже программу в автозапуск добавить-тогда все автоматически будет происходить))

0
1

Почему бы не размяться, не всё ж с базами возиться :)

Я предлагаю не писать в реестр, а в папках, которые были уже архивированы, создавать файл backup.info (можно даже пустой, но проще писать в него, на всякий случай что-то, относящееся к архивированию).

Итак:

// возвращает разницу между временем создания файла или папки и текущим, в неполных днях
function GetFileOrFolderCreationDifference(attr:integer;myfolder:string):integer; 
var
  ft: TFileTime;
  st: TSystemTime;
  dt: TDateTime;
  sr: TSearchRec;
begin
   if FindFirst(myfolder, attr, Sr) = 0 then
      begin
        ft:=sr.FindData.ftCreationTime;
        System.SysUtils.FindClose(sr);
        FileTimeToSystemTime(ft, st);
        dt:=SystemTimeToDateTime(st);
        Result:=DaysBetween(Tomorrow,dt); // я использую Tomorrow, чтобы получить неполные 20 дней на сегодня, если нужно полные - используйте Today
      end
   else
      begin
        // обработка, если папки или файла не существует, либо проблемы с ней
      end;
end;



//непосредственно процедура бэкапа
procedure Backup(path:string);
var
   sr: TSearchRec;
   f:TextFile;
   filename:string;
begin
 if FindFirst(path + '\*.*', faAnyFile, sr) = 0 then
   begin
     repeat
      if (sr.Attr and faDirectory) <> 0 then  // если найденный файл - папка
         begin
           if (sr.Name <> '.') and (sr.Name <> '..') then  // на всякий случай игнорируем служебные папки
              begin
                 if (GetFileOrFolderCreationDifference(faDirectory,path+'\'+sr.Name) mod 20) = 0 then // кратность разницы дат
                   begin
                      filename:=path+'\'+sr.Name+'\backup.info';
                      if FileExists(filename) then   // проверяем существование файла backup.info
                        begin
                           if GetFileOreCreationDifference(faNormal,filename) >= 20  then // насколько старый файл backup.info
                              begin
                                 Backup_now(vars); // ваша процедура бэкапа
                                 AssignFile(f,filename);
                                 Rewrite(f);
                                 writeln(f,'Бэкап сделан ' + DateTimeToStr(Now));
                                 CloseFile(f);
                              end;
                        end
                      else
                        begin
                           Backup_now(vars); // ваша процедура бэкапа
                           AssignFile(f,filename);
                           Rewrite(f);
                           writeln(f,'Бэкап сделан ' + DateTimeToStr(Now));
                           CloseFile(f);
                        end;
                   end
              end;
         end;
     until FindNext(sr) <> 0;
   end;
 System.SysUtils.FindClose(sr);
end;

Ну, и вызов, например, так:

Backup('H:\Projects');
5
  • Лесенка из if .. then begin if .. then begin ... совершенно ужасна! Не хотите заменить на гораздо более компактный и читаемый and .. and .. ?
    – Kromster
    25 янв 2018 в 12:25
  • @Kromster Нет, не хочу, поскольку, по-хорошему, ТС там должен добавить достаточно кода для проверки, контроля и т.п. 25 янв 2018 в 12:40
  • @Kromster Кстати, лесенка - это хорошо. Просто монитор пошире нужен, и всё. Видели бы вы, что приносят мои студенты :D 25 янв 2018 в 12:42
  • Дело не в широте монитора, а в читаемости - избыточные begin/end, ступеньки и растягивание в ширину. А то, что приносят студенты, никак к делу не относится. Это не наезд, просто комментарий )
    – Kromster
    25 янв 2018 в 12:47
  • @Kromster Обычно пишешь код вчерную именно так, оставляя проверки и контроль на потом. А дальше уже, если проверки/контроль не нужны, оптимизируешь. Поэтому я не считаю такой код (он ведь черновой, его нужно дополнять) моветоном. Более того, в IDE используешь разные тона белого/бежевого для обозначения степени готовности кода. 25 янв 2018 в 12:53

Ваш ответ

Нажимая на кнопку «Отправить ответ», вы соглашаетесь с нашими условиями использования и подтверждаете, что прочитали и поняли наши политику конфиденциальности и нормы поведения.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.