1 | program backup;
|
---|
2 |
|
---|
3 | {$mode objfpc}{$H+}
|
---|
4 |
|
---|
5 | uses
|
---|
6 | {$IFDEF UNIX}{$IFDEF UseCThreads}
|
---|
7 | cthreads,
|
---|
8 | {$ENDIF}{$ENDIF}
|
---|
9 | Classes, SysUtils, CustApp
|
---|
10 | { you can add units after this }, UMemoryStreamEx, math;
|
---|
11 |
|
---|
12 | type
|
---|
13 |
|
---|
14 | { TBackup }
|
---|
15 |
|
---|
16 | TBackup = class(TCustomApplication)
|
---|
17 | protected
|
---|
18 | procedure DoRun; override;
|
---|
19 | public
|
---|
20 | Counter: Integer;
|
---|
21 | FileCount: Integer;
|
---|
22 | BackupFileExtension: string;
|
---|
23 | BackupFileName: string;
|
---|
24 | ExponentBase: Double;
|
---|
25 | Verbose: Boolean;
|
---|
26 | constructor Create(TheOwner: TComponent); override;
|
---|
27 | destructor Destroy; override;
|
---|
28 | procedure WriteHelp; virtual;
|
---|
29 | procedure MoveFiles;
|
---|
30 | procedure CheckParameters;
|
---|
31 | procedure PrintStatTable;
|
---|
32 | end;
|
---|
33 |
|
---|
34 | { TBackup }
|
---|
35 |
|
---|
36 | procedure TBackup.DoRun;
|
---|
37 | var
|
---|
38 | CounterFile: TFileStream;
|
---|
39 | CounterFileName: string;
|
---|
40 | begin
|
---|
41 | CheckParameters;
|
---|
42 | CounterFileName := BackupFileName + '.counter';
|
---|
43 | if FileExists(CounterFileName) then begin
|
---|
44 | CounterFile := TFileStream.Create(CounterFileName, fmOpenReadWrite);
|
---|
45 | Counter := StrToInt(CounterFile.ReadAnsiString);
|
---|
46 | CounterFile.Free;
|
---|
47 | end else begin
|
---|
48 | Counter := 0;
|
---|
49 | end;
|
---|
50 | if not FileExists(BackupFileName) then begin
|
---|
51 | WriteLn('ZdrojovÜ soubor "' + BackupFileName + '" nenalezen.');
|
---|
52 | Halt;
|
---|
53 | end;
|
---|
54 | if Verbose then WriteLn('Hodnota ÄÃtaÄe kroků: ' + IntToStr(Counter));
|
---|
55 | MoveFiles;
|
---|
56 | CounterFile := TFileStream.Create(CounterFileName, fmCreate);
|
---|
57 | CounterFile.WriteAnsiString(IntToStr(Counter));
|
---|
58 | CounterFile.Free;
|
---|
59 | Terminate;
|
---|
60 | end;
|
---|
61 |
|
---|
62 | constructor TBackup.Create(TheOwner: TComponent);
|
---|
63 | begin
|
---|
64 | inherited Create(TheOwner);
|
---|
65 | StopOnException := True;
|
---|
66 | BackupFileExtension := '';
|
---|
67 | BackupFileName := '';
|
---|
68 | FileCount := 10;
|
---|
69 | ExponentBase := 1;
|
---|
70 | Verbose := False;
|
---|
71 | end;
|
---|
72 |
|
---|
73 | destructor TBackup.Destroy;
|
---|
74 | begin
|
---|
75 | inherited Destroy;
|
---|
76 | end;
|
---|
77 |
|
---|
78 | procedure TBackup.WriteHelp;
|
---|
79 | begin
|
---|
80 | WriteLn('PouÅŸitÃ: backup [pÅepÃnaÄe]');
|
---|
81 | WriteLn('VytváÅà kopie záloÅŸnÃho souboru s exponenciálnÄ rostoucÃm stáÅÃm.');
|
---|
82 | WriteLn(' -f --file=SOUBOR zálohovanÜ soubor');
|
---|
83 | WriteLn(' -b --base=ÄÃSLO základ mocniny');
|
---|
84 | WriteLn(' -c --count=ÄÃSLO max. poÄet zaloÅŸnÃch souborů');
|
---|
85 | WriteLn(' -e --file-extension=TEXT rozÅ¡ÃÅenà názvu vytváÅenÃœch souborů');
|
---|
86 | WriteLn(' -t --table zobrazenà tabulky stáÅà záloh');
|
---|
87 | WriteLn(' -v --verbose upovÃdanÃœ reÅŸim');
|
---|
88 | WriteLn(' --version zobrazenà verze');
|
---|
89 | WriteLn(' -h --help zobrazenà nápovÄdy');
|
---|
90 | end;
|
---|
91 |
|
---|
92 | procedure TBackup.MoveFiles;
|
---|
93 | var
|
---|
94 | I: Integer;
|
---|
95 | NewFileName: string;
|
---|
96 | OldFileName: string;
|
---|
97 | ReducedBackupFileName: string;
|
---|
98 | begin
|
---|
99 | if Copy(BackupFileName, 1 + Length(BackupFileName) - Length(BackupFileExtension), 255) = BackupFileExtension then
|
---|
100 | ReducedBackupFileName := Copy(BackupFileName, 1, Length(BackupFileName) - Length(BackupFileExtension))
|
---|
101 | else ReducedBackupFileName := BackupFileName;
|
---|
102 | for I := FileCount downto 0 do begin
|
---|
103 | if (Counter mod Trunc(Power(ExponentBase, I))) = 0 then begin
|
---|
104 | if I = 0 then OldFileName := BackupFileName
|
---|
105 | else OldFileName := ReducedBackupFileName + '-' + IntToStr(I) + BackupFileExtension;
|
---|
106 | NewFileName := ReducedBackupFileName + '-' + IntToStr(I + 1) + BackupFileExtension;
|
---|
107 | if FileExists(OldFileName) then begin
|
---|
108 | if Verbose then
|
---|
109 | WriteLn('PÅesouvám "' + OldFileName + '" na "' + NewFileName + '". Perioda ' +
|
---|
110 | IntToStr(Trunc(Power(ExponentBase, I))) + ' kroků.');
|
---|
111 | if FileExists(NewFileName) then DeleteFile(PChar(NewFileName));
|
---|
112 | RenameFile(OldFileName, NewFileName);
|
---|
113 | end;
|
---|
114 | end;
|
---|
115 | end;
|
---|
116 |
|
---|
117 | Inc(Counter);
|
---|
118 | end;
|
---|
119 |
|
---|
120 | procedure TBackup.CheckParameters;
|
---|
121 | //var
|
---|
122 | // ErrorMsg: string;
|
---|
123 | begin
|
---|
124 | // quick check parameters
|
---|
125 | (*
|
---|
126 | ErrorMsg := CheckOptions('h', 'help');
|
---|
127 | WriteLn(ErrorMsg);
|
---|
128 | if ErrorMsg <> '' then begin
|
---|
129 | ShowException(Exception.Create(ErrorMsg));
|
---|
130 | Halt;
|
---|
131 | end;
|
---|
132 | *)
|
---|
133 |
|
---|
134 | // parse parameters
|
---|
135 | if HasOption('h', 'help') then begin
|
---|
136 | WriteHelp;
|
---|
137 | Halt;
|
---|
138 | end;
|
---|
139 |
|
---|
140 | if HasOption('version') then begin
|
---|
141 | WriteLn('backup version 1.0');
|
---|
142 | Halt;
|
---|
143 | end;
|
---|
144 |
|
---|
145 | if HasOption('c', 'count') then begin
|
---|
146 | FileCount := StrToInt(GetOptionValue('c', 'count'));
|
---|
147 | end;
|
---|
148 |
|
---|
149 | if HasOption('b', 'base') then begin
|
---|
150 | ExponentBase := StrToFloat(GetOptionValue('b', 'base'));
|
---|
151 | if ExponentBase < 1 then begin
|
---|
152 | ShowException(Exception.Create('Základ mocniny musà bÃœt vÄtÅ¡Ã neÅŸ 1.'));
|
---|
153 | Halt;
|
---|
154 | end;
|
---|
155 | end;
|
---|
156 |
|
---|
157 | if HasOption('f', 'file') then begin
|
---|
158 | BackupFileName := GetOptionValue('f', 'file');
|
---|
159 | end;
|
---|
160 |
|
---|
161 | if HasOption('e', 'file-extension') then begin
|
---|
162 | BackupFileExtension := GetOptionValue('e', 'file-extension');
|
---|
163 | end;
|
---|
164 |
|
---|
165 | if HasOption('t', 'table') then begin
|
---|
166 | PrintStatTable;
|
---|
167 | Halt;
|
---|
168 | end;
|
---|
169 |
|
---|
170 | if HasOption('v', 'verbose') then begin
|
---|
171 | Verbose := True;
|
---|
172 | end;
|
---|
173 | end;
|
---|
174 |
|
---|
175 | procedure TBackup.PrintStatTable;
|
---|
176 | var
|
---|
177 | I: Integer;
|
---|
178 | Period: Int64;
|
---|
179 | PeriodSum: Int64;
|
---|
180 | begin
|
---|
181 | PeriodSum := 0;
|
---|
182 | WriteLn('PoÅadové ÄÃslo Perioda Interval staÅÃ');
|
---|
183 | for I := 0 to FileCount - 1 do begin
|
---|
184 | Period := Trunc(Power(ExponentBase, I));
|
---|
185 | PeriodSum := PeriodSum + Period;
|
---|
186 | WriteLn(IntToStr(I + 1) + ' ' + IntToStr(Period) +
|
---|
187 | ' ' + IntToStr(PeriodSum - Period + 1) + '-' + IntToStr(PeriodSum));
|
---|
188 | end;
|
---|
189 | end;
|
---|
190 |
|
---|
191 | var
|
---|
192 | Application: TBackup;
|
---|
193 |
|
---|
194 | {$IFDEF WINDOWS}{$R backup.rc}{$ENDIF}
|
---|
195 |
|
---|
196 | {$R *.res}
|
---|
197 |
|
---|
198 | begin
|
---|
199 | Application:=TBackup.Create(nil);
|
---|
200 | Application.Run;
|
---|
201 | Application.Free;
|
---|
202 | end.
|
---|
203 |
|
---|