delphi7系统文件备份系统

时间:2014-05-26 17:35:19
【文件属性】:

文件名称:delphi7系统文件备份系统

文件大小:10KB

文件格式:RAR

更新时间:2014-05-26 17:35:19

文件备份系统

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 (age0 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.


【文件预览】:
文件备份系统
----Bakup.cfg(325B)
----Unit1.dcu(10KB)
----Unit1.dfm(2KB)
----Bakup.res(876B)
----Bakup.dpr(185B)
----Unit1.pas(9KB)
----Bakup.dof(983B)

网友评论