umain.pas

一款自己编写的,简单的access数据库备分程序源码

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, cxLookAndFeelPainters, StdCtrls, cxButtons, cxProgressBar,
  cxDBProgressBar, cxControls, cxContainer, cxEdit, cxGroupBox, Buttons,
  DB, DBTables, ExtCtrls;

type
  TfmMain = class(TForm)
    cxGroupBox1: TcxGroupBox;
    processBarBackup: TcxProgressBar;
    btnOK: TBitBtn;
    btnCancel: TBitBtn;
    timerBackup: TTimer;
    connectionAsa: TDatabase;
    qyBackup: TQuery;
    labelBackup: TLabel;
    timerOK: TTimer;
    TimerError: TTimer;
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure timerBackupTimer(Sender: TObject);
    procedure timerOKTimer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure TimerErrorTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure threadDone(Sender :TObject);
  end;

var
  fmMain: TfmMain;

implementation
uses
  IniFiles,DateUtils ;
Type
  Threadbackup = Class(TThread)
  Public
    Procedure Execute ; Override ;
  end;
var
  SecondPast : Cardinal ;
  backupIni : TIniFile ;
  tBackup : ThreadBackup ;
  tBackupDone : Boolean ;
  bHasError : Boolean ;
{$R *.dfm}

procedure TfmMain.btnOKClick(Sender: TObject);
var
  cmdStr : String ;
begin
  btnCancel.Enabled := False ;
  btnOk.Enabled := False ;
  timerOK.Enabled := False ;
  labelBackup.Caption :='正在备份('+DateTimeToStr(Now)+'开始),请稍候...';
  labelBackup.Repaint ;
  backupIni.WriteDateTime('WeK'+IntToStr(dayOfTheWeek(date)),'BegTime',NOW);
  backupIni.WriteString('WeK'+IntToStr(dayOfTheWeek(date)),'EndTime','备份被中止');
  cmdStr := ExtractFileDir(Application.ExeName);
  cmdStr := stringReplace(cmdStr,'\','\\',[rfReplaceAll]);
  cmdStr := 'Backup DataBase directory '+ quotedStr(cmdStr)
  + ' TRANSACTION LOG TRUNCATE ';
  cmdStr := backupIni.ReadString('BackupSet','BackupCmd_WeK'+IntToStr(dayOfTheWeek(date)),cmdStr) ;
  backupIni.WriteString('BackupSet','BackupCmd_WeK'+IntToStr(dayOfTheWeek(date)),cmdStr);
  backupIni.WriteString('BackupSet','BackupComment','请注意:路径请用双斜杠表示!');
  timerBackup.Enabled := True ;
  Try
      Try
        if Not ConnectionAsa.Connected then
          connectionAsa.Connected := True ;
        if cmdStr <> '' then
        begin
           qyBackup.Active := False ;
           qyBackup.SQL.Text := cmdStr ;
           tBackup.Resume;
           While Not tBackupDone do
           begin
             Application.ProcessMessages ;
           end;
           labelBackup.Caption :='备份完毕!共耗时:'+ IntToStr(SecondPast) + '秒...';
        end;
      Except
        On E:Exception do
        begin
         labelBackup.Caption := E.Message;
         bHasError := True ;
        end;
      end;
  Finally
    begin
      processBarBackup.Position := 100 ;
      backupIni.WriteDateTime('WeK'+IntToStr(dayOfTheWeek(date)),'EndTime',NOW);
      timerBackup.Enabled := False ;
      backupIni.WriteFloat('WeK'+IntToStr(dayOfTheWeek(date)),'BackupUsedTime(Minutes)',
        MinutesBetween(
        backupIni.ReadDateTime('WeK'+IntToStr(dayOfTheWeek(date)),'EndTime',NOW),
        backupIni.ReadDateTime('WeK'+IntToStr(dayOfTheWeek(date)),'BegTime',NOW)
        )) ;
      btnCancel.Enabled := True ;
      if bHasError then
        timerError.Enabled := True
      else
        self.Close;
    end;
  end;
end;

procedure TfmMain.btnCancelClick(Sender: TObject);
begin
  if Not btnOk.Enabled then
    exit ;
  btnOk.Enabled := False ;
  timerOk.Enabled := False ;
  self.Close;
end;

procedure TfmMain.FormShow(Sender: TObject);
begin
  tBackupDone := False ;
  tBackup := threadBackup.Create(True);
  tBackup.FreeOnTerminate := True ;
  tBackup.OnTerminate := threadDone;
  backupIni := TIniFile.Create(ExtractFilePath(Application.ExeName)+'\SDBackupLog.INI');
  backupIni.WriteString('软件说明','<    使用指南    >:请指定ODBC数据源,名称为SDBACKUP,如设置得当,本软件可备份任何数据库系统!','');
  backupIni.WriteString('软件说明','<    原理说明    >:根据周次指定不同备份命令,例如备份到不同位置!','');
  backupIni.WriteString('软件说明','<    安装需要    >:需要安装BORLAND BDE驱动.','');
  backupIni.WriteString('软件说明','<    软件分发    >:不可用于商业用途,其余则不受限制!本人不承担由此软件引起的任何责任!','');
  backupIni.WriteString('软件说明','<    联系作者    >:QQ:395545770','');
  SecondPast := 0 ;
  ProcessBarBackup.Position := SecondPast ;
  timerOK.Enabled := True ;
  bHasError := False ;
end;

procedure TfmMain.timerBackupTimer(Sender: TObject);
begin
  SecondPast := SecondPast + 1 ;
  processBarBackup.Position := secondPast mod 101 ;
end;

procedure TfmMain.timerOKTimer(Sender: TObject);
begin
  SecondPast := SecondPast + 1 ;
  labelBackup.Caption := '请注意:系统将在 '+intToStr(5-SecondPast)+' 秒钟后启动备份...';
  if secondPast >=5 then
  begin
    secondPast := 0 ;
    btnOk.Click;
  end;
end;

procedure TfmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Not btnCancel.Enabled then
  begin
    showMessage('正在备份,不能关闭!');
    canClose := False ;
    Exit ;
  end;
  if Not tBackupDone then
  begin
    qyBackup.SQL.Text := '' ;
    tBackup.Resume;
  end;
  while Not tBackupDone do
    Application.ProcessMessages;
  backupIni.Free;
end;

{ Threadbackup }

procedure Threadbackup.Execute;
begin
  if fmMain.qyBackup.SQL.Text <>'' then
  fmMain.qyBackup.Active := True ;
end;

procedure TfmMain.threadDone(Sender: TObject);
begin
  tBackupDone := True ;
end;

procedure TfmMain.TimerErrorTimer(Sender: TObject);
begin
  SecondPast := SecondPast + 1 ;
  if SecondPast >= 10 then
  begin
    timerError.Enabled := False ;
    self.Close;
  end;
end;

end.