一个简单的FireBird数据库自动定时备份程序，
可以保存一周以内的数据库备份。
使用了DevExoress控件，在Delphi 2009下调试通过。
为了开机自动运行时能最小化到托盘，启动加 -h 参数。
供初学者参考。
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxSpinEdit, cxTimeEdit, cxControls, cxContainer, cxEdit, cxTextEdit,
cxMaskEdit, cxButtonEdit, StdCtrls, ExtCtrls, Menus,ShellAPI,Registry,IniFiles,
cxGraphics, cxLookAndFeels, cxLookAndFeelPainters;
type
TForm2 = class(TForm)
Label1: TLabel;
Label2: TLabel;
cxButtonEdit1: TcxButtonEdit;
cxButtonEdit2: TcxButtonEdit;
cxTimeEdit1: TcxTimeEdit;
Label3: TLabel;
Button1: TButton;
TrayIcon1: TTrayIcon;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
SaveDialog1: TSaveDialog;
Timer1: TTimer;
OpenDialog1: TOpenDialog;
procedure cxButtonEdit1PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
procedure cxButtonEdit2PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
function FixPathStr(path: string): string;
public
{ Public declarations }
end;
var
Form2: TForm2;
atom:Integer; fbpath:string;
implementation
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
var fdb,fbk,CmdLines,binpath:string;
begin
fdb:=FixPathStr(cxButtonEdit1.Text);
fbk:=FixPathStr(cxButtonEdit2.Text);
if (fdb='')or(fbk='') then Exit;
binpath :=fbpath+'bin\';
CmdLines:=' /c '+'gbak -v -t -user SYSDBA -password "masterkey" '+fdb+' '+fbk;
Screen.Cursor :=crHourGlass;
Timer1.Enabled :=False;
ShellExecute(handle, 'open', pchar('cmd'), pchar(CmdLines),pchar(binPath), SW_Show);
Timer1.Enabled :=True;
Screen.Cursor :=crDefault;
end;
procedure TForm2.cxButtonEdit1PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
begin
if OpenDialog1.Execute then
cxButtonEdit1.Text :=OpenDialog1.FileName;
end;
procedure TForm2.cxButtonEdit2PropertiesButtonClick(Sender: TObject;
AButtonIndex: Integer);
begin
if SaveDialog1.Execute then
cxButtonEdit2.Text :=SaveDialog1.FileName;
end;
procedure TForm2.FormActivate(Sender: TObject);
var i:Integer;
begin
if ParamCount = 0 then exit;
for i := 1 to ParamCount do
begin
if LowerCase(ParamStr(i)) = '-h' then
postMessage(Application.handle,WM_SYSCOMMAND,SC_CLOSE,0);
end;
end;
procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Self.Hide;
canclose:=False;
end;
procedure TForm2.FormCreate(Sender: TObject);
var reg:TRegistry ; ini:TIniFile;
begin
reg:=TRegistry.create;
try
reg.rootkey:=HKEY_LOCAL_MACHINE;
if reg.openkey('\SOFTWARE\Firebird Project\Firebird Server\Instances',false) then
fbpath:=reg.ReadString('DefaultInstance')
else begin
MessageBox(Handle, PChar('此计算机未安装Firebird！'), PChar('提示'), $00000030);
application.Terminate;
end;
finally
reg.Free;
end;
TrayIcon1.Icon := Application.Icon;
if GlobalFindAtom('seidb_backup')=0 then
atom:=GlobalAddAtom('seidb_backup')
else begin
Application.MessageBox('程序已经在运行！', '确认', MB_OK + MB_ICONWARNING);
Halt;
end;
ini:=TIniFile.Create(ExtractFilePath(ParamStr(0))+'path.ini');
try
cxButtonEdit1.Text :=ini.ReadString('path','fdb','');
cxButtonEdit2.Text :=ini.ReadString('path','fbk','');
cxTimeEdit1.Text := ini.ReadString('time','time','');
finally
ini.Free;
end;
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
GlobalDeleteAtom(atom);
end;
procedure TForm2.N1Click(Sender: TObject);
begin
Form2.Show;
end;
procedure TForm2.N2Click(Sender: TObject);
var ini:TIniFile;
begin
ini:=TIniFile.Create(ExtractFilePath(ParamStr(0))+'path.ini');
try
ini.WriteString('path','fdb',cxButtonEdit1.Text);
ini.WriteString('path','fbk',cxButtonEdit2.Text);
ini.WriteString('time','time',cxTimeEdit1.Text);
finally
ini.Free;
end;
GlobalDeleteAtom(atom);
halt;
end;
procedure TForm2.Timer1Timer(Sender: TObject);
var fdb,fbk,CmdLines,binpath:string;
days: array[1..7] of string;
begin
if cxTimeEdit1.Text =FormatDateTime('hh:mm',Now) then
begin
fdb:=FixPathStr(cxButtonEdit1.Text);
fbk:=cxButtonEdit2.Text;
if (fdb='')or(fbk='') then Exit;
days[1] := 'Sunday';
days[2] := 'Monday';
days[3] := 'Tuesday';
days[4] := 'Wednesday';
days[5] := 'Thursday';
days[6] := 'Friday';
days[7] := 'Saturday';
fbk:=ChangeFileExt(fbk,'');
fbk:=fbk+'_'+days[DayOfWeek(date)]+'.fbk';
fbk:=FixPathStr(fbk);
binpath :=fbpath+'bin\';
CmdLines:=' /c '+'gbak -v -t -user SYSDBA -password "masterkey" '+fdb+' '+fbk;
Screen.Cursor :=crHourGlass;
Timer1.Enabled :=False;
ShellExecute(handle, 'open', pchar('cmd'), pchar(CmdLines),pchar(binPath), SW_HIDE);
Timer1.Enabled :=True;
Screen.Cursor :=crDefault;
end;
end;
function TForm2.FixPathStr(path: string): string;
begin
if pos(' ',path)=0 then
Result:=path else Result:='"'+path+'"' ;
end;
end. |
