main.pas

本软件实现单机数据压缩打包备份功能.数据压缩级别,压缩速度可选!备份可采取增量备份或全备份.

  Handled := false;

  if Screen.activeform = self then
  case Msg.message of
  WM_LBUTTONDOWN:
     if BtnContexthelp.down then
        Handled := HandleMouseMsg(Msg.hwnd, mbLeft, KeysToShiftState(Msg.wParam), Loword(Msg.lParam), Hiword(Msg.lParam));
  WM_RBUTTONUP:
        Handled := HandleMouseMsg(Msg.hwnd, mbRight, KeysToShiftState(Msg.wParam), Loword(Msg.lParam), Hiword(Msg.lParam));
  end;
end; }

function TBackupDialog.SaveFileSet(FileName: String): Boolean;
var
  BackupIni: TIniFile;
  i: Integer;
begin
  Result := False;
  // if the file exists, delete it
  if FileExists(FileName) then
    if not DeleteFile(FileName) then
      if MessageDlg('不能删除存在的文件，要继续吗？',
        mtConfirmation, [mbYes, mbNo], 0) = mrNo then
        Exit;
  try
    // Set cursor
    Screen.Cursor := crHourglass;

    // Create the IniFile
    BackupIni := TIniFile.Create(FileName);

    // Save the Details
    // File Title
    BackupIni.WriteString('Title','Title', BackupTitleEdit.text);

    // Save File Details?
    BackupIni.WriteBool('Save File Details', 'SaveFileDetails', cbSaveFileId.Checked);

    // Backup Mode
    BackupIni.WriteInteger('Backup Mode', 'BackupMode', BackupModeRadioGroup.ItemIndex);

    // Compression Level
    BackupIni.WriteInteger('CompressionLevel', 'CompressionLevel', CompressionLevelRadioGroup.ItemIndex);

    // File Names
    for i := 0 to FileListbox.Items.Count-1 do
      BackupIni.WriteString('Files', IntToStr(i), FileListBox.Items[i]);

    // Close the IniFile
    BackupIni.Free;

    // Update the Modified Flag
    fModified := False;

    // Set Return value
    Result := True;
    ShowMessage('恭喜您，备份集保存成功！！');

    SetButtons;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TBackupDialog.SetButtons;
var
  ItemSelected: Boolean;
begin
  AddFilesBitBtn.Enabled := True;
  AddWildCardsBitBtn.Enabled := True;
  DefaultSetBitBtn.Enabled := True;
  OpenSetBitBtn.Enabled := True;

  ItemSelected := FileListBox.ItemIndex > -1;
  DeleteBitBtn.Enabled := ItemSelected;
  UpButton.Enabled := ItemSelected and not SortListCheckBox.Checked;
  DownButton.Enabled := ItemSelected and not SortListCheckBox.Checked;

  ClearBitBtn.Enabled := (FileListbox.Items.Count > 0);
  SaveSetBitBtn.Enabled := (FileListbox.Items.Count > 0) and
    ((fBackupSet <> '') or fModified);
  SaveSetAsBitBtn.Enabled := SaveSetBitBtn.Enabled;
  BackupBitBtn.Enabled := SaveSetBitBtn.Enabled;
  RestoreBitBtn.Enabled := FileListBox1.ItemIndex > -1;

  EdPath.enabled := rbOtherPath.checked;
  RestorePathButton.Enabled := EdPath.Enabled;
  cbFullPath.enabled := rbOtherPath.checked;
end;

procedure TBackupDialog.FormCreate(Sender: TObject);
begin
  ShowHint := True;
  fBackupSet := '';
  fModified := False;
  DirectoryListBox1.Directory := ExtractFilePath(Application.ExeName);
  EdPath.Text := ExtractFilePath(Application.ExeName);
  Application.helpfile := changefileext(application.exename, '.hlp');
//  Application.onMessage := AppMessage;
  SetButtons;
end;

procedure TBackupDialog.RestoreBitBtnClick(Sender: TObject);
var
   S: string;
   Success: Boolean;
begin
  Screen.Cursor := crAppStart;
  Label_Flag:='Restore';
  try
     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;
     ProgressBar1.Visible := True;
     RestorePathButton.Enabled := False;
     RestoreBitBtn.Enabled := False;
     CancelRestoreBitBtn.Caption := '&Cancel';
     Success := backupfile1.restore(filelistbox1.filename, S);
     Label2.Caption := '';
     if Success then
       showmessage('恭喜你，恢复成功！ '+inttostr(backupfile1.FilesTotal)+'分之'+inttostr(backupfile1.FilesProcessed)+' 的文件'+'被成功处理！')
     else
       showmessage('恢复失败或用户取消操作！');
  finally
    CancelRestoreBitBtn.Caption := '&Close';
    SetButtons;
   // ProgressBar1.Visible := False;
    Screen.Cursor := crDefault;
  end;

end;

procedure TBackupDialog.OpenSetBitBtnClick(Sender: TObject);
var
  BackupIni: TIniFile;
  i, DelCount: Integer;
  WorkString: String;
begin
  if fModified then
    if MessageDlg('你想保存更改到当前的备份集吗？',mtConfirmation,
      [mbYes,mbNo], 0) = mrYes then
      SaveSetBitBtnClick(NIL);

  // Set up the Open Dialog
  OpenDialog.Filter := 'Backup File Sets (*.bfs)|*.bfs';
  OpenDialog.InitialDir := ExtractFilePath(Application.ExeName);

  // Show Open Dialog
  if not OpenDialog.Execute then
    Exit;

  try
    // reset the Cursor
    Screen.Cursor := crHourGlass;

    // Clear any existing files
    FileListBox.Items.Clear;
    
    // Open Ini File
    BackupIni := TIniFile.Create(OpenDialog.FileName);

    // Load Set Name
    fBackupSet := OpenDialog.FileName;
    BackupSetEdit.Text := ExtractFileName(fBackupSet);

    // Load Backup Title
    BackupTitleEdit.Text := BackupIni.ReadString('Title', 'Title', 'Untitled');

    // Save File Details?
    cbSaveFileID.Checked := BackupIni.ReadBool('Save File Details', 'SaveFileDetails', True);

    // Backup Mode
    BackupModeRadioGroup.ItemIndex := BackupIni.ReadInteger('Backup Mode', 'BackupMode', 0);

    // Compression Level
    CompressionLevelRadioGroup.ItemIndex := BackupIni.ReadInteger('CompressionLevel', 'CompressionLevel', 0);

    // Turn off the listbox during the Update
    FileListBox.Items.BeginUpdate;

    // Load Files
    BackupIni.ReadSectionValues('Files', FileListBox.Items);

    // Strip out the Keys
    for i := 0 to FileListBox.Items.Count-1 do
      begin
        Workstring := FileListBox.Items[i];
        DelCount := Pos('=', Workstring);
        Delete(Workstring, 1, DelCount );
        FileListBox.Items[i] := WorkString;
      end;

    // Turn the listbox back on
    FileListBox.Items.EndUpdate;

    // Close Ini File
    BackupIni.Free;

    // Set Modification flag
    fModified := False;

    // Set up the buttons to reflect changes
    SetButtons;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TBackupDialog.SaveSetAsBitBtnClick(Sender: TObject);
begin

  // Set up the Save Dialog
  SaveDialog.Filter := 'Backup File Sets (*.bfs)|*.bfs';
  SaveDialog.Title := '另存为.....';
  // Display the Save Dialog
  if SaveDialog.Execute then
     if not SaveFileSet(SaveDialog.FileName) then
       MessageDlg('不能保存当前备份集.', mtError, [mbOk], 0)
     else
       fBackupSet := SaveDialog.FileName;
end;

procedure TBackupDialog.BackupTitleEditChange(Sender: TObject);
begin
  fModified := True;
end;

procedure TBackupDialog.FileListBoxClick(Sender: TObject);
begin
  SetButtons;
end;

procedure TBackupDialog.DeleteBitBtnClick(Sender: TObject);
begin
  FileListBox.Items.Delete(FileListBox.ItemIndex);
  fModified := True;
  SetButtons;
end;

procedure TBackupDialog.DefaultSetBitBtnClick(Sender: TObject);
begin
  // If file already exists, warn and get instructions
  if FileExists(ExtractFilePath(Application.ExeName)+'Default.bfs') then
    if MessageDlg('默认备份集已经存在，你想覆盖它吗？',
      mtConfirmation, [mbYes,mbNo], 0) = mrNo then
      Exit;

  // Clear existing stuff
  ClearBitBtnClick(NIL);

  // Update the BackupSet variable
  fBackupSet := ExtractFilePath(Application.ExeName)+'Default.bfs';

  // Update the Backup Set Edit
  BackupSetEdit.Text := 'Default.bfs';

  // Update the Title
  BackupTitleEdit.Text := '默认备份';

  // Save File Details
  cbSaveFileId.Checked := True;

  // Backup Mode
  BackupModeRadioGroup.ItemIndex := 0;

  // CompressionLevel
  CompressionLevelRadioGroup.ItemIndex := 0;

  // Turn off the listbox during the Update
  FileListBox.Items.BeginUpdate;

  // Add multiple Default files using Wildcards
  // xBase Data Files
  FileListBox.Items.Add(ExtractFilePath(Application.ExeName)+'*.dbf');

  // xBase Memo Files
  FileListBox.Items.Add(ExtractFilePath(Application.ExeName)+'*.fpt');

  // Data List files
  FileListBox.Items.Add(ExtractFilePath(Application.ExeName)+'*.lst');

  // Data files
  FileListBox.Items.Add(ExtractFilePath(Application.ExeName)+'*.dta');

  //  Program IniFiles
  FileListBox.Items.Add(ExtractFilePath(Application.ExeName)+'*.ini');

  // Program List Files
  FileListBox.Items.Add(ExtractFilePath(Application.ExeName)+'*.lst');

  // Turn the listbox back on
  FileListBox.Items.EndUpdate;


  if not SaveFileSet(fBackupSet) then
    MessageDlg('不能保存当前备份集.', mtError, [mbOk], 0);

end;

procedure TBackupDialog.PageControl1Change(Sender: TObject);
begin
  if fModified and (PageControl1.ActivePage = RestoreTabSheet) then
    if MessageDlg('你想保存更改到当前备份集吗？',mtConfirmation,
      [mbYes,mbNo], 0) = mrYes then
      SaveSetBitBtnClick(NIL);
end;

procedure TBackupDialog.Backupfile1NeedDisk(Sender: TObject; DiskID: Word;
  var Continue: Boolean);
begin
  Continue := MessageDlg('请插入磁盘 ' +
       inttostr(DiskID)+' and click OK to continue', 
         mtInformation, mbOKCancel, 0) = mrOK;
end;

procedure TBackupDialog.CompressionLevelRadioGroupClick(Sender: TObject);
begin
  fModified := True;
end;

procedure TBackupDialog.BackupModeRadioGroupClick(Sender: TObject);
begin
  fModified := True;
end;

procedure TBackupDialog.RestorePathButtonClick(Sender: TObject);
var
  Dir: String;
begin
  if DirectoryExists(EdPath.Text) then
    Dir := EdPath.Text
  else
    Dir := '';
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
     EdPath.Text := Dir;
end;

procedure TBackupDialog.DownButtonClick(Sender: TObject);
var
  NewPosition: Integer;
begin
  with FileListbox do
    begin
      if ItemIndex = -1 then
        begin
          ItemIndex := 0;
          fModified := True;
          SetButtons;
          Exit;
        end;
      If ItemIndex < Items.Count -1 then
        begin
          NewPosition := ItemIndex+1;
          Items.Exchange(NewPosition, ItemIndex);
          ItemIndex := NewPosition;
          fModified := True;
          SetButtons;
        end;
end;
end;

procedure TBackupDialog.UpButtonClick(Sender: TObject);
var
  NewPosition: Integer;
begin
  with FileListbox do
    if ItemIndex > 0 then
      begin
        NewPosition := ItemIndex-1;
        Items.Exchange(NewPosition, ItemIndex);
        ItemIndex := NewPosition;
        fModified := True;
        SetButtons;
      end;
end;


procedure TBackupDialog.SortListCheckBoxClick(Sender: TObject);
begin
  FileListBox.Sorted := SortListCheckBox.Checked;
  fModified := True;
  SetButtons;
end;

procedure TBackupDialog.DriveComboBox1Change(Sender: TObject);
begin
  SetButtons;
end;

procedure TBackupDialog.DirectoryListBox1Change(Sender: TObject);
begin
  SetButtons;
end;

procedure TBackupDialog.BtnContexthelpClick(Sender: TObject);
begin
  
    Screen.Cursor := OldCursor;
end;

procedure TBackupDialog.BtnHelpTOCClick(Sender: TObject);
begin
  application.helpcommand(HELP_FINDER, 0);
end;

procedure TBackupDialog.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   //  if (key = VK_ESCAPE) and BtnContextHelp.down then BtnContextHelpClick(self);
end;

procedure TBackupDialog.PopupwhatsthisClick(Sender: TObject);
begin
     if TMenuItem(sender).tag < 0
       then Application.HelpCommand(HELP_CONTEXT, abs(TMenuItem(sender).tag)) //display in main window
       else Application.HelpCommand(HELP_CONTEXTPOPUP, TMenuItem(sender).tag);
end;

end.