program backup; {$mode objfpc}{$H+} uses {$IFDEF UNIX}{$IFDEF UseCThreads} cthreads, {$ENDIF}{$ENDIF} Classes, SysUtils, CustApp { you can add units after this }, UMemoryStreamEx, math; type { TBackup } TBackup = class(TCustomApplication) protected procedure DoRun; override; public Counter: Integer; FileCount: Integer; BackupFileExtension: string; BackupFileName: string; ExponentBase: Double; Verbose: Boolean; constructor Create(TheOwner: TComponent); override; destructor Destroy; override; procedure WriteHelp; virtual; procedure MoveFiles; procedure CheckParameters; procedure PrintStatTable; end; { TBackup } procedure TBackup.DoRun; var CounterFile: TFileStream; CounterFileName: string; begin CheckParameters; CounterFileName := BackupFileName + '.counter'; if FileExists(CounterFileName) then begin CounterFile := TFileStream.Create(CounterFileName, fmOpenReadWrite); Counter := StrToInt(CounterFile.ReadAnsiString); CounterFile.Free; end else begin Counter := 0; end; if not FileExists(BackupFileName) then begin WriteLn('Zdrojový soubor "' + BackupFileName + '" nenalezen.'); Halt; end; if Verbose then WriteLn('Hodnota čítače kroků: ' + IntToStr(Counter)); MoveFiles; CounterFile := TFileStream.Create(CounterFileName, fmCreate); CounterFile.WriteAnsiString(IntToStr(Counter)); CounterFile.Free; Terminate; end; constructor TBackup.Create(TheOwner: TComponent); begin inherited Create(TheOwner); StopOnException := True; BackupFileExtension := ''; BackupFileName := ''; FileCount := 10; ExponentBase := 1; Verbose := False; end; destructor TBackup.Destroy; begin inherited Destroy; end; procedure TBackup.WriteHelp; begin WriteLn('Použití: backup [přepínače]'); WriteLn('Vytváří kopie záložního souboru s exponenciálně rostoucím stářím.'); WriteLn(' -f --file=SOUBOR zálohovaný soubor'); WriteLn(' -b --base=ČÍSLO základ mocniny'); WriteLn(' -c --count=ČÍSLO max. počet založních souborů'); WriteLn(' -e --file-extension=TEXT rozšíření názvu vytvářených souborů'); WriteLn(' -t --table zobrazení tabulky stáří záloh'); WriteLn(' -v --verbose upovídaný režim'); WriteLn(' --version zobrazení verze'); WriteLn(' -h --help zobrazení nápovědy'); end; procedure TBackup.MoveFiles; var I: Integer; NewFileName: string; OldFileName: string; ReducedBackupFileName: string; begin if Copy(BackupFileName, 1 + Length(BackupFileName) - Length(BackupFileExtension), 255) = BackupFileExtension then ReducedBackupFileName := Copy(BackupFileName, 1, Length(BackupFileName) - Length(BackupFileExtension)) else ReducedBackupFileName := BackupFileName; for I := FileCount downto 0 do begin if (Counter mod Trunc(Power(ExponentBase, I))) = 0 then begin if I = 0 then OldFileName := BackupFileName else OldFileName := ReducedBackupFileName + '-' + IntToStr(I) + BackupFileExtension; NewFileName := ReducedBackupFileName + '-' + IntToStr(I + 1) + BackupFileExtension; if FileExists(OldFileName) then begin if Verbose then WriteLn('Přesouvám "' + OldFileName + '" na "' + NewFileName + '". Perioda ' + IntToStr(Trunc(Power(ExponentBase, I))) + ' kroků.'); if FileExists(NewFileName) then DeleteFile(PChar(NewFileName)); RenameFile(OldFileName, NewFileName); end; end; end; Inc(Counter); end; procedure TBackup.CheckParameters; //var // ErrorMsg: string; begin // quick check parameters (* ErrorMsg := CheckOptions('h', 'help'); WriteLn(ErrorMsg); if ErrorMsg <> '' then begin ShowException(Exception.Create(ErrorMsg)); Halt; end; *) // parse parameters if HasOption('h', 'help') then begin WriteHelp; Halt; end; if HasOption('version') then begin WriteLn('backup version 1.0'); Halt; end; if HasOption('c', 'count') then begin FileCount := StrToInt(GetOptionValue('c', 'count')); end; if HasOption('b', 'base') then begin ExponentBase := StrToFloat(GetOptionValue('b', 'base')); if ExponentBase < 1 then begin ShowException(Exception.Create('Základ mocniny musí být větší než 1.')); Halt; end; end; if HasOption('f', 'file') then begin BackupFileName := GetOptionValue('f', 'file'); end; if HasOption('e', 'file-extension') then begin BackupFileExtension := GetOptionValue('e', 'file-extension'); end; if HasOption('t', 'table') then begin PrintStatTable; Halt; end; if HasOption('v', 'verbose') then begin Verbose := True; end; end; procedure TBackup.PrintStatTable; var I: Integer; Period: Int64; PeriodSum: Int64; begin PeriodSum := 0; WriteLn('Pořadové číslo Perioda Interval staří'); for I := 0 to FileCount - 1 do begin Period := Trunc(Power(ExponentBase, I)); PeriodSum := PeriodSum + Period; WriteLn(IntToStr(I + 1) + ' ' + IntToStr(Period) + ' ' + IntToStr(PeriodSum - Period + 1) + '-' + IntToStr(PeriodSum)); end; end; var Application: TBackup; {$IFDEF WINDOWS}{$R backup.rc}{$ENDIF} {$R *.res} begin Application:=TBackup.Create(nil); Application.Run; Application.Free; end.