unit1.pas

文件备份程序,可以对文件进行备份管理,D7下运行成功

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.