unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, FileCtrl;
type
TForm1 = class(TForm)
DriveComboBox1: TDriveComboBox;
FileListBox1: TFileListBox;
DirectoryListBox1: TDirectoryListBox;
Button1: TButton;
Button2: TButton;
ListBox1: TListBox;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Edit2: TEdit;
Label10: TLabel;
Label11: TLabel;
Edit3: TEdit;
Label12: TLabel;
procedure Start(Sender: TObject);
procedure changedrive(Sender: TObject);
procedure SelectFolder(Sender: TObject);
procedure DirectoryListBox1Change(Sender: TObject);
procedure Addit(Sender: TObject);
procedure Del(Sender: TObject);
procedure Savelist(Sender: TObject);
procedure foldercheck(Sender: TObject);
procedure Search(Sender: TObject);
procedure findlist(sender: TObject);
procedure main(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Bak:string;
implementation
{$R *.DFM}
procedure TForm1.Start(Sender: TObject);
{copies files when backup required only replaces ones with newer time date}
var dir,newstr,oldstr,s,ss:string;
d,f,n,nod,nof,age,bakage,len,lendir,newF:integer; {number of directories ,number of files}
a,b:boolean;
begin
NewF:=0;
a:=false;
dir:=DirectoryListBox1.Directory;
nod:=ListBox1.items.count;
for d:=0 to (nod-1) do begin
DirectoryListBox1.Directory:=listbox1.items[d];
FileListBox1.Directory:=DirectoryListBox1.Directory;
dir:=DirectoryListBox1.Directory;
nof:=FileListBox1.items.count;
for f:=0 to (nof-1) do begin
oldstr:=Bak;
newstr:=dir+'\'+FilelistBox1.items[f];
lendir:=length(dir);
{oldstr:=Bak+'\'+copy(dir,4,len-3);}
n:=pos('\',dir);
s:=copy(dir,n+1,lendir);
n:=pos('\',s);
repeat
ss:=copy(s,1,n-1);
oldstr:=oldstr+'\'+ss;
b:=DirectoryExists(oldstr);
if b=false then mkdir(oldstr);
len:=length(oldstr);
s:=copy(dir,len-2,lendir);
n:=pos('\',s);
until n=0;
len:=length(newstr);
oldstr:=bak+'\'+copy(newstr,4,len-3);
age:=fileage(newstr);
bakage:=Fileage(oldstr);
if (age<bakage) or (bakage=-1) then begin
copyfile(pchar(newstr),pchar(oldstr),a);
newF:=newF+1;
end;
end;
end;
edit3.text:=inttostr(newF);
end;
procedure TForm1.changedrive(Sender: TObject);
begin
DirectoryListBox1.Drive:=DriveComboBox1.Drive;
FileListBox1.Drive:=DriveComboBox1.Drive;
end;
procedure TForm1.SelectFolder(Sender: TObject);
begin
FileListBox1.Directory:=DirectoryListBox1.Directory;
end;
procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
FileListBox1.Directory:=DirectoryListBox1.Directory;
end;
procedure TForm1.Addit(Sender: TObject);
{Adds a folder to the bakup list and saves list - click button when added}
begin
ListBox1.items.Add(DirectoryListBox1.Directory);
Savelist(sender);
end;
procedure TForm1.Del(Sender: TObject);
var n:integer;
begin
n:=listbox1.itemindex;
Listbox1.items.Delete(n);
end;
procedure TForm1.Savelist(Sender: TObject);
{saves as bakup disk\bakup folder\folderlist.txt
to disk the list of folders requiring bakup on }
var folderlist:textfile;
n,m:integer;
s:string;
begin
n:=listbox1.items.count;
assignfile(folderlist,bak+'\folderlist.txt');
rewrite(folderlist);
for m:=0 to (n-1) do begin
s:=listbox1.items[m];
writeln(folderlist,s);
end;
closefile(folderlist);
end;
procedure TForm1.findlist(sender: TObject);
{Finds the list as saved on Disk and loads it at startup}
var folderlist:textfile;
s,ss:string;
begin
Bak:=edit1.text;
ss:=bak+'\folderlist.txt';
assignfile(folderlist,ss{bak+'\folderlist.txt'});
reset(folderlist);
repeat
readln(folderlist,s);
listbox1.items.add(s);
until (s='eof') or (s='');
closefile(folderlist);
end;
procedure TForm1.foldercheck(Sender: TObject);
{check folders in Listbox and makes ones not already existing}
var n,nod,d:integer;
s,sFront,sTemp:string;
b:boolean;
begin
nod:=ListBox1.items.count;
{first see if all folders exist in Bakup folder starting from the top
make any not existing - ie sets up the Bakup folder structure}
for d:=0 to nod-1 do begin
s:=listbox1.items[d];
s:=s+'\';
delete(s,1,3);
sFront:=Bak;
repeat
n:=pos('\',s);
if n<>0 then begin
sTemp:=copy(s,1,n-1);
sFront:=sFront+'\'+sTemp;
b:=DirectoryExists(sFront);
if b=false then MkDir(sFront);
Delete(s,1,n);
end;
until n=0;
end;
end;
procedure TForm1.Search(Sender: TObject);
{Takes folder list in listbox1 and looks to see if one next level down
has new folders. If yes then it makes the new folder and adds it to the listbox
this enables bakup of new web pages with a PageFiles folder
then saves list
Does not seem to add to list box new directories found so that it digs deeper next time
appears to add directory tried this saw it in .txt file (notpad) but on closing it must save in it original form as it has them gone
has this to do with the blank lie that gets added in??????????????????}
var nod,numinbox,nn,d,NewDir,len:integer;
s,ss,dir:string;
b:boolean;
begin
NewDir:=0;
nod:=ListBox1.items.count;
for d:=0 to nod-1 do begin
DirectoryListBox1.Directory:=listbox1.items[d];
FileListBox1.Directory:=DirectoryListBox1.Directory;
dir:=DirectoryListBox1.Directory;
numinbox:=directoryListBox1.items.count;
{top:=directoryListBox1.items[0];
top2nd:=directoryListBox1.items[1];}
for nn:=3 to numinbox-1 do begin
s:=listbox1.items[d]+'\'+DirectoryListBox1.items[nn];
b:=DirectoryExists(s);
if b=true then begin
len:=length(s);
ss:=copy(s,4,len);
ss:=Bak+'\'+ss;
b:=DirectoryExists(ss);
if b=false then begin
mkdir(ss);
listbox1.items.add(s);
NewDir:=NewDir+1;
end;
end;
end;
end;
Edit2.text:=inttostr(NewDir);
savelist(sender);
end;
procedure TForm1.main(Sender: TObject);
begin
findlist(sender); {find list of directories from disk};
foldercheck(sender);{check directories from list exist and if not make them}
search(sender); {search for folder one level down}
start(sender); {save files if there is a more up to date one}
end;
end.
