《delphi中 有用的函数》由会员分享，可在线阅读，更多相关《delphi中 有用的函数（9页珍藏版）》请在金锄头文库上搜索。
1、uses FileCtrl; private Private declarations FFileName: string;/得到路径。function GetPath: string;/获得目录名称。function GetDirectoryName(Dir: string): string;procedure FindFiles(aPath: string);/磁盘检查function CheckDisk(Drive: Byte; aSize: Int64): Boolean;/检查目录的大小function CheckFileSize(aPath: string): Int64;/检查备
2、份文件是否存在，不存在或存在按 确定 返回“真”function CheckFileExists(aFileNameString: string): Boolean;public Public declarations end;varFormBackUp: TFormBackUp;IsClickStop: Boolean = False;/按取消 按钮时返回真 。DirectorySize: Int64;/文件夹大小。implementation$R *.DFMconsta1 = 系统已经完成对记录“ ;a2 = ”的备份。是否将记录“ ;a3 = ”删除？ ;function TFormBa
3、ckUp.GetPath: string;beginif RbAlias.Checked thenbeginif cbAlias.Text = thenraise Exception.Create( 请选择别名。 );Result := D:aaa + CbAlias.Text;endelse if RbFlolder.Checked thenResult := edPath.Textelse Result := ;if Result = thenraise Exception.Create( 您没有选择路径！ );if not DirectoryExists(Result) thenrais
4、e Exception.CreateFmt( 文件夹 “%s”不存在。 , Result);end;function TFormBackUp.CheckFileSize(aPath: string): Int64;beginDirectorySize := 0;tryScreen.Cursor := crHourGlass;FFileName := *.* ;FindFiles(aPath);Result := DirectorySize;Result := Result div 5;finallyScreen.Cursor := crDefault;end;end;function TFor
5、mBackUp.GetDirectoryName(Dir: string): string;beginif DirLength(Dir) thenResult := Dir + elseResult := Dir;end;procedure TFormBackUp.FindFiles(aPath: string);varFSearchRec, DSearchRec: TSearchRec;FindResult: Integer;function IsDirNotation(aDirName: string): Boolean;beginResult := (aDirName = . ) or
6、(aDirName = . );end;beginaPath := GetDirectoryName(aPath);FindResult := FindFirst(aPath + FFileName, faAnyFile + faHidden+ faSysFile + faReadOnly, FSearchRec);try while FindResult = 0 dobeginDirectorySize := DirectorySize + FSearchRec.Size;FindResult := FindNext(FSearchRec);end;FindResult := FindFir
7、st(aPath + *.* , faDirectory, DSearchRec);while FindResult = 0 dobeginif (DSearchRec.Attr and faDirectory) = faDirectory) andnot IsDirNotation(DSearchRec.Name) thenbeginFindFiles(aPath + DSearchRec.Name); /递归。DirectorySize := DirectorySize + DSearchRec.Size;end;FindResult := FindNext(DSearchRec);end
8、;finallyFindClose(FSearchRec);FindClose(DSearchRec);end;end;function TFormBackUp.CheckDisk(Drive: Byte; aSize: Int64): Boolean;varBn, Chk: Integer;MySize: Int64;beginResult := True;Chk := 0;while Chk = 0 dobeginMySize := DiskFree(Drive);if MySize = -1 thenbeginBn := MessageDlg( 未插入磁盘或提供备份文件的位置不正确！如果
9、未插入磁盘，请插入后单击“是”。 , mtWarning, mbYes, mbNo, 0);if bn = mrYes then ContinueelsebeginResult := False;break;end;end elsebeginif MySize idCancel) thenbeginResult := True;break;endelsebeginResult := False;break;end;end;end;procedure TFormBackUp.SpRestoreClick(Sender: TObject);begin if not FileExists(edFil
10、eName.Text) thenbeginMessageDlg(Format( 文件 %s 不存在！ , edFileName.Text), mtError, mbOk, 0);Exit;end;with Archiver1 dobeginFileName := edFileName.Text;ExtractPath := GetPath;Open;tryExtractFiles;finallyClose;end;end;end;procedure TFormBackUp.SpSelectFileClick(Sender: TObject);beginwith OpenDialog1 dobe
11、ginif Execute thenedFileName.Text := FileName;end;end;procedure TFormBackUp.SpBackUpClick(Sender: TObject);vartmp: string;mmmPath: string;DriveNumber: Integer;vByte: Char;DirectorySize: LongInt;aAliasText: string;begintrytmp := GetPath;mmmPath := UpperCase(trim(edFileName.Text);vByte := mmmPath1;Dir
12、ectorySize := CheckFileSize(tmp);DriveNumber := Ord(vByte) - Ord( A ) + 1;if CheckDisk(DriveNumber, DirectorySize) = False then Exit;if CheckFileExists(mmmPath) thenbeginwith Archiver1 dobeginFileName := edFileName.Text;Open;tryAddDirectory(tmp);finallyClose;end;end;if RbAlias.Checked thenbeginaAlia
13、sText := a1 + CbAlias.Text + a2 + CbAlias.Text + a3;if (MessageDlg(aAliasText, mtConfirmation, mbYes, mbNo, 0) MrNo) thenbeginBggl_Form.N1Click(nil);Form_DM.ADOD_Hzxx.Delete;end;end;end;exceptif IsClickStop thenbeginIsClickStop := False;raise Exception.Create( 进程被取消。 );endelseraise Exception.Create(
14、 文件路径不合法，请仔细检查！ );end;end;procedure TFormBackUp.btnAbortClick(Sender: TObject);beginArchiver1.RequestAbort;IsClickStop := True;end;procedure TFormBackUp.Archiver1DisplayMessage(Sender: TObject;const msg: string);beginLFile.Caption := msg;end;procedure TFormBackUp.Archiver1FileProgress(Sender: TObject;Percent: Integer);beginProg
