delphi中 有用的函数.doc

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; /检查备份文件是否存在，不存在或存在按 确定 返回“真” function CheckFileExists(aFileNameString: string): Boolean; public Public declarations end;var FormBackUp: TFormBackUp; IsClickStop: Boolean = False;/按取消按钮时返回真。 DirectorySize: Int64;/文件夹大小。implementation$R *.DFMconst a1 = 系统已经完成对记录“ ; a2 = ”的备份。是否将记录“ ; a3 = ”删除？ ;function TFormBackUp.GetPath: string;begin if RbAlias.Checked then begin if cbAlias.Text = then raise Exception.Create( 请选择别名。 ); Result := D:aaa + CbAlias.Text; end else if RbFlolder.Checked then Result := edPath.Text else Result := ; if Result = then raise Exception.Create( 您没有选择路径！ ); if not DirectoryExists(Result) then raise Exception.CreateFmt( 文件夹 “%s”不存在。 , Result);end;function TFormBackUp.CheckFileSize(aPath: string): Int64;begin DirectorySize := 0; try Screen.Cursor := crHourGlass; FFileName := *.* ; FindFiles(aPath); Result := DirectorySize; Result := Result div 5; finally Screen.Cursor := crDefault; end;end;function TFormBackUp.GetDirectoryName(Dir: string): string;begin if DirLength(Dir) then Result := Dir + else Result := Dir;end;procedure TFormBackUp.FindFiles(aPath: string);var FSearchRec, DSearchRec: TSearchRec; FindResult: Integer; function IsDirNotation(aDirName: string): Boolean; begin Result := (aDirName = . ) or (aDirName = . ); end;begin aPath := GetDirectoryName(aPath); FindResult := FindFirst(aPath + FFileName, faAnyFile + faHidden + faSysFile + faReadOnly, FSearchRec); try while FindResult = 0 do begin DirectorySize := DirectorySize + FSearchRec.Size; FindResult := FindNext(FSearchRec); end; FindResult := FindFirst(aPath + *.* , faDirectory, DSearchRec); while FindResult = 0 do begin if (DSearchRec.Attr and faDirectory) = faDirectory) and not IsDirNotation(DSearchRec.Name) then begin FindFiles(aPath + DSearchRec.Name); /递归。 DirectorySize := DirectorySize + DSearchRec.Size; end; FindResult := FindNext(DSearchRec); end; finally FindClose(FSearchRec); FindClose(DSearchRec); end;end;function TFormBackUp.CheckDisk(Drive: Byte; aSize: Int64): Boolean;var Bn, Chk: Integer; MySize: Int64;begin Result := True; Chk := 0; while Chk = 0 do begin MySize := DiskFree(Drive); if MySize = -1 then begin Bn := MessageDlg( 未插入磁盘或提供备份文件的位置不正确！如果未插入磁盘，请插入后单击“是”。 , mtWarning, mbYes, mbNo, 0); if bn = mrYes then Continue else begin Result := False; break; end; end else begin if MySize aSize then begin bn := MessageDlg( 驱动器剩余空间不足，如果使用磁盘，请插入另一张后单击“是”。 , mtWarning, mbYes, mbNo, 0); if bn = mrYes then Continue else begin Result := False; break; end; end else break; end; end;end;function TFormBackUp.CheckFileExists(aFileNameString: string): Boolean;var aFileExistText: string;begin Result := True; while FileExists(aFileNameString) do begin aFileExistText := 文件 + aFileNameString + 已存在，如果单击“确定”，将会以覆盖原文件的形式备份，继续吗？ ; if (MessageDlg(aFileExistText, mtConfirmation, mbOKCancel, 0) idCancel) then begin Result := True; break; end else begin Result := False; break; end; end;end;procedure TFormBackUp.SpRestoreClick(Sender: TObject);begin if not FileExists(edFileName.Text) then begin MessageDlg(Format( 文件 %s 不存在！ , edFileName.Text), mtError, mbOk, 0); Exit; end; with Archiver1 do begin FileName := edFileName.Text; ExtractPath := GetPath; Open; try ExtractFiles; finally Close; end; end;end;procedure TFormBackUp.SpSelectFileClick(Sender: TObject);begin with OpenDialog1 do begin if Execute then edFileName.Text := FileName; end;end;procedure TFormBackUp.SpBackUpClick(Sender: TObject);var tmp: string; mmmPath: string; DriveNumber: Integer; vByte: Char; DirectorySize: LongInt; aAliasText: string;begin try tmp := GetPath; mmmPath := UpperCase(trim(edFileName.Text); vByte := mmmPath1; DirectorySize := CheckFileSize(tmp); DriveNumber := Ord(vByte) - Ord( A ) + 1; if CheckDisk(DriveNumber, DirectorySize) = False then Exit; if CheckFileExists(mmmPath) then begin with Archiver1 do begin FileName := edFileName.Text; Open; try AddDirectory(tmp); finally Close; end; end; if RbAlias.Checked then begin aAliasText := a1 + CbAlias.Text + a2 + CbAlias.Text + a3; if (MessageDlg(aAliasText, mtConfirmation, mbYes, mbNo, 0) MrNo) then begin Bggl_Form.N1Click(nil); Form_DM.ADOD_Hzxx.Delete; end; end; end; except if IsClickStop then begin IsClickStop := False; raise Exception.Create( 进程被取消。 ); end else raise Exception.Create( 文件路径不合法，请仔细检查！ ); end;end;procedure TFormBackUp.btnAbortClick(Sender: TObject);begin Archiver1.RequestAbort; IsClickStop := True;end;procedure TFormBackUp.Archiver1DisplayMessage(Sender: TObject; const msg: string);begin LFile.Caption := msg;end;procedure TFormBackUp.Archiver1FileProgress(Sender: TObject; Percent: Integer);begin ProgressBar1.Position := Percent; btnAbort.Enabled := Archiver1.CanAbort; Application.ProcessMessages;end;procedure TFormBackUp.Archiver1FinishOperation(Sender: TObject);begin NoteBook1.PageIndex := 0; Application.ProcessMessages;end;procedure TFormBackUp.Archiver1StartOperation(Sender: TObject);begin with Sender as TArchiver do begin if Operation = opAdd then begin lTitle.Caption := 正在备份. ; AnimateBackUp.Visible := True; AnimateRestore.Visible := False; end else if Operation = opExtract then begin lTitle.Caption := 正在恢复. ; AnimateBackUp.Visible := False; AnimateRestore.Visible := True; end else begin lTitle.Caption := ; AnimateBackUp.Visible := False; AnimateRestore.Visible := False; end; end; NoteBook1.PageIndex := 1;end;procedure TFormBackUp.FormCloseQuery(Sender: TObject; var CanClose: Boolean);begin CanClose := not Archiver1.IsBusy; if not CanClose then MessageDlg( 操作正在进行中.按“取消”按钮会退出操作。 , mtWarning, mbOk, 0);end;procedure TFormBackUp.FormCreate(Sender: TObject);var ApplicationPath: string;begin ApplicationPath := ExtractFilePath(Application.ExeName); RbAlias.Checked := True; with Form_DM.ADODataSet1 do begin try Close; OPen; CbAlias.Items.Clear; First; while not Eof do begin CbAlias.Items.Add(Fields0.AsString); Next; end; finally Close; end; end; AnimateBackUp.FileName := ReturnFileName(aviBackUp); AnimateRestore.FileName := ReturnFileName(aviRestore); AnimateBackUp.Active := True; AnimateRestore.Active := True; AnimateRestore.Visible := False; Notebook1.PageIndex := 0;end;procedure TFormBackUp.FormShow(Sender: TObject);var iCount: Integer;begin with CbAlias do begin for iCount := 0