backckunit.pas

工资管理系统

unit BackckUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  backup, StdCtrls, ExtCtrls, ComCtrls, FileCtrl;

type
  TBackckForm = class(TForm)
    OpenDialog: TOpenDialog;
    Backupfile1: TBackupFile;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    FileListBox: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button4: TButton;
    Panel1: TPanel;
    Button3: TButton;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    rgBackupMode: TRadioGroup;
    Label2: TLabel;
    EdBackupTitle: TEdit;
    BtnCancel: TButton;
    SaveDialog: TSaveDialog;
    Button5: TButton;
    Button6: TButton;
    FileListBox1: TFileListBox;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    Edit2: TEdit;
    rgRestoreMode: TRadioGroup;
    Label3: TLabel;
    rgCompressionLevel: TRadioGroup;
    gbRestorepath: TGroupBox;
    rbOrigpath: TRadioButton;
    rbOtherPath: TRadioButton;
    EdPath: TEdit;
    CbFullPath: TCheckBox;
    Edit1: TEdit;
    Label4: TLabel;
    CbSaveFileID: TCheckBox;
    MeFiles: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Backupfile1Progress(Sender: TObject; Filename: String;
      Percent: TPercentage; var Continue: Boolean);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure BtnCancelClick(Sender: TObject);
    procedure FileListBox1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure rbOrigpathClick(Sender: TObject);
  private
  public
  end;

var
  BackckForm: TBackckForm;

implementation

{$R *.DFM}

procedure TBackckForm.Button1Click(Sender: TObject);
var
   I: Integer;
begin
   if OpenDialog.execute then with FileListbox.items do
   begin
     beginupdate;
     for I := 0 to OpenDialog.files.count-1 do
       if indexof(lowercase(OpenDialog.files[i])) = -1 then
          add(lowercase(OpenDialog.files[i]));
     endupdate;
  end;
end;
//压缩
procedure TBackckForm.Button2Click(Sender: TObject);
begin
     if Filelistbox.items.count = 0 then Showmessage('No files added')
     else with SaveDialog do if execute then
     begin
          if uppercase(copy(filename, 1, 1)) = 'A' then
          begin
               Showmessage('驱动器A 是一个软盘驱动器 - 请插入一个空白软盘.');
               BackupFile1.maxSize := 1400000;  //backup to floppy
          end
          else BackupFile1.maxSize := 0;

          backupfile1.backuptitle      := EdBackupTitle.text;
          backupfile1.backupmode       := TBackupMode(rgBackupmode.itemindex);
          backupfile1.compressionLevel := TCompressionLevel(rgCompressionLevel.itemindex);
          backupfile1.SaveFileID       := CbSaveFileID.checked;

          if backupfile1.backup(filelistbox.items, filename)
           then Showmessage('备份成功. 压缩率 = '+inttostr(BackupFile1.compressionrate)+' %')
           else Showmessage('备份失败或被用户中止.');
     end;
end;

procedure TBackckForm.Backupfile1Progress(Sender: TObject; Filename: String;
  Percent: TPercentage; var Continue: Boolean);
begin
     with Progressbar1 do
     begin
          visible := Percent < 100;
          if visible then position := Percent;
     end;
     if Percent < 100 then Label1.caption := Filename else Label1.caption := '';
end;

procedure TBackckForm.Button4Click(Sender: TObject);
var
   S: string;
begin
     S := extractFilepath(application.exename)+'*.*';
     if InputQuery('扩展输入', '请输入路径+文件通配符', S) then FileListBox.items.add(S);
end;

procedure TBackckForm.Button5Click(Sender: TObject);
begin
     filelistbox.items.clear;
end;

procedure TBackckForm.BtnCancelClick(Sender: TObject);
begin
     if not BackupFile1.busy then close
     else if MessageDlg('您要中断程序吗?',mtConfirmation, [mbYes,mbNo], 0) = mrYes then Backupfile1.Stop;
end;

function GetFileSize(const FileName: String): LongInt;
   var
       SearchRec: TSearchRec;
  begin
          if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
            Result := SearchRec.Size
           else
            Result := -1;
  end;
procedure TBackckForm.FileListBox1Click(Sender: TObject);
var
   files: tstringlist;
   I: integer;
   S, FA, SZ: string;
begin
     files := TStringlist.create;
     MeFiles.lines.clear;
     Edit2.text := backupfile1.getArchiveTitle(Filelistbox1.filename, files);
     if Edit2.text = '' then Edit1.text := ''
     else begin
       Edit1.text := inttostr(backupfile1.FilesTotal)+' 文件, '+inttostr(round(backupfile1.SizeTotal/1024))+' KB 合计'+'  实际大小：'+ floattostr(round(getFileSize(filelistbox1.FileName)/1024))+'KB';
       //+'KB 压缩比：'+floattostr(round((getFileSize(filelistbox1.FileName)/1024)/(backupfile1.SizeTotal/1024)))+'%';
       MeFiles.lines.beginupdate;
       for I := 0 to files.count-1 do
       begin
            S  := copy(files[i],1,pos(#9,Files[i])-1);  //file name
            FA := copy(files[i],pos(#9,Files[i])+1,pos('=',Files[i])-pos(#9,Files[i])-1);  //file age
            FA := DateToStr(
                  FileDateToDateTime(
                  StrtoInt(FA)       //integer file date is system + language independent!
                  ));
            SZ := copy(files[i],pos('=',Files[i])+1, length(Files[i])-pos('=',Files[i]));  //file size in Bytes
            MeFiles.lines.add(S + ' 压缩信息 ' + FA + ', ' +' 压缩前'+SZ + ' 字节');
            //+'压缩后'+'  实际大小：'+ floattostr(round(getFileSize(s)/1000))+'KB');
       end;
       if files.count = 0 then MeFiles.lines.add('没有扩展文件信息!!!');
       MeFiles.lines.endupdate;
     end;
     files.free;
end;
//恢复
procedure TBackckForm.Button3Click(Sender: TObject);
var
   S: string;
begin
     backupfile1.Restoremode  := TRestoreMode(rgRestoreMode.itemindex);
     if rbOrigpath.checked then S := ''
     else begin
          S := EdPath.text;
          if trim(s) = '' then
          begin
               showmessage('请输入目的路径:');
               exit;
          end;
     end;
     backupfile1.restoreFullpath := cbFullpath.enabled and cbFullpath.checked;
     if backupfile1.restore(filelistbox1.filename, S)
       then showmessage('恢复成功完成!!!, '+inttostr(backupfile1.FilesProcessed)+' 个合计文件之'+inttostr(backupfile1.FilesTotal))
       else showmessage('恢复失败或被用户中止!');
end;

procedure TBackckForm.rbOrigpathClick(Sender: TObject);
begin
     EdPath.enabled     := rbOtherPath.checked;
     cbFullPath.enabled := rbOtherPath.checked;
end;

end.