unit9.pas

以前在某高校做外聘教师时做的学生学籍管理系统(delphi+access)。献丑献丑

unit Unit9;

interface

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

type
  TBakupDataBase = class(TForm)
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    Timer1: TTimer;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormActivate(Sender: TObject);

  private

    { Private declarations }
  public

    { Public declarations }
  end;

var
  BakupDataBase: TBakupDataBase;

implementation

uses implemntation;

var
msgstr:string;    //用来显示备份是否成功的提示信息

{$R *.dfm}

procedure TBakupDataBase.FormClose(Sender: TObject; var Action: TCloseAction);
begin
showmessage(msgstr);
Action := cafree;
end;

procedure TBakupDataBase.Timer1Timer(Sender: TObject);
begin
//用于显示进度条及文字提示
  self.ProgressBar1.Position:=self.ProgressBar1.Position+1;
  if label1.Caption='正在备份数据库.....' then label1.Caption:='正在备份数据库' else label1.Caption:=label1.Caption+'.';
  if self.ProgressBar1.Position=self.ProgressBar1.Max then begin timer1.Enabled:=false;close; end;

end;




procedure TBakupDataBase.FormActivate(Sender: TObject);
var
n:integer;
from_file,to_file:string;
begin
  from_file:=Product_Dir+data_path;
  to_file:=Product_Dir+Bakup_Dir+'data';
try
CreateDir(Product_Dir+Bakup_Dir);
deletefile(to_file+'.001');
for n:=1 to Bakup_Num do begin
if FileExists(to_file+'.00'+inttostr(n)) then RenameFile(to_file+'.00'+inttostr(n),to_file+'.00'+inttostr(n-1));
 end;
if copyfile(pchar(from_file),pchar(to_file+'.00'+inttostr(Bakup_Num)),true) then
     begin msgstr:='备份数据库成功完成!';   end
     else msgstr:='数据库备份出错!请检查数据文件或磁盘。';
except
   msgstr:='数据库备份出错!请检查数据文件或磁盘。';
end;

end;


procedure TBakupDataBase.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
state:='数据库备份';

end;

end.