Were you thinking of this? I posted parts of this on the forum previously.
Если вы подумали об этом, я ранее публиковал часть этого на форуме.
function CountBackups(dir: string) : string;
var
fileList : TStringList;
// count : integer;
begin
result := '0';
fileList := TStringList.Create;
fileList.Text := GetFilesList(dir, '*.db',False);
result := intToStr(fileList.Count -1);
fileList.Free;
end;
procedure frmMain_OnClose (Sender: TObject; Action: string);
begin
CopyFile('Test.db', 'backup/backup '+ FormatDateTime('dd-mm-yyyy hh-nn-ss', now)+'.db');
dbBackup(b);
Timer.Free;
end;
procedure OnTimer;
begin
iSeconds := iSeconds + 1;
frmMain.lbCounter.Caption := ' '+intToStr(iSeconds);
AutocloseSet;
if iSeconds > 30 then // backup every 3.5 hours (14400 seconds)
begin
// dbBackup(b);
dbUpdateTimer;
iSeconds := 0;
end;
end;
procedure dbBackup(d: string);
var
z : boolean;
begin
z := ForceDirectories(d);
if z then
CopyFile(dbName, d + '/WOS_backup '+ FormatDateTime('dd-mm-yyyy hh-nn-ss',now)+'.db')
else
messageBox('Folder '+d +' does not exist', 'Backup Folder', 0);
frmMain.lbFileCount.Caption := CountBackups(d);
end;
procedure frmMain_OnShow (Sender: TObject; Action: string);
var
b,y :string;
begin
b := ExtractFilePath(Application.ExeName);
y := b;
b := b + 'backup\backup ' + dtToday;
y := y + 'backup\backup ' + dtYesterday;
//CreateDir(y); // this is required to stop file does not exist message on first open
{ if y < b then
DeleteDB(y); move this to onClose}
dbBackup(b);
//global code
var
Timer : TTimer;
iSeconds : integer;
On a clear disk you can seek forever