unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellAPI;
type
TBack_it_up = class(TForm)
cmd_start: TButton;
cmd_close: TButton;
lbl_start: TLabel;
lbl_stop: TLabel;
lbl_start_2: TLabel;
lbl_stop_2: TLabel;
lbl_status: TLabel;
procedure cmd_startClick(Sender: TObject);
procedure cmd_closeClick(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
Function DeleteDir(DirName : string): Boolean;
function Sh_FileCopyMove(aWND: HWND; const Source,Dest: string; DoMove: boolean;
var IsAborted: boolean; Flags: FILEOP_FLAGS=0): Boolean;
var
Back_it_up: TBack_it_up;
const
backup_this = 'R:\';
backup_new = 'C:\Backup-FSS';
backup_old = 'C:\Backup-FSS(Old)';
implementation
{$R *.dfm}
procedure TBack_it_up.cmd_startClick(Sender: TObject);
var
IsAborted: boolean;
f : TSearchRec;
s : Integer;
begin
cmd_start.Enabled:=false;
lbl_start_2.Caption:=DateTimeToStr(Now);
Application.ProcessMessages;
if DirectoryExists(backup_old) then DeleteDir(backup_old);
if DirectoryExists(backup_new) then MoveFile(backup_new, backup_old);
begin
s := FindFirst(backup_this + '*.*', faDirectory, f);
try
while s = 0 do
begin
if f.Attr and faDirectory = faDirectory then
if (f.name <> '.') and (f.name <> '..') then
begin
lbl_status.Caption:='Current directory: ' + f.Name;
Application.ProcessMessages;
Sh_FileCopyMove(Back_it_up.Handle, backup_this+f.Name, backup_new, false, IsAborted)
end;
s := FindNext(f);
end;
finally
FindClose(f);
end;
end;
lbl_stop_2.caption:=DateTimeToStr(Now);
lbl_status.Caption:='Backup completed';
end;