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

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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