捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  沪ICP备05001939号 DELPHI盒子 | 盒子论坛 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 论坛检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
盒子资源分类
全部展开 - 全部合拢
FireBird 数据库自动备份程序
关键字:FireBird 备份
来 自:原创
平 台:Win2k/XP/NT,Win2003 下载所需:0 火柴
深浅度:初级 完成时间:2009/11/13
发布者:aszou 发布时间:2009/11/15
编辑器:delphi2009 语  种:简体中文
分 类:数据库 下载浏览:2435/15369
加入到我的收藏
下载错误报错
登陆以后才能下载
 用户名:
 密 码:
自动登陆(30天有效)
图片如果打不开,说明流量不够了,请稍候下载……
一个简单的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.
Google
 
本站原创作品,未经作者许可,严禁任何方式转载;转载作品,如果侵犯了您的权益,请联系我们
龙脉加密锁 15元起 Grid++Report 报表 申请支付@网
 相关文章
没有相关文章
相关评论
共有评论4条 当前显示最后4条评论
zh2000 2009/11/15 12:03:36
特地登陆来顶...呵呵
ouyongke 2009/11/26 21:27:47
代码看不懂的初学者,可以上论坛去,我在“发布代码”写了个加了注释的。
您的回复就是对我们最好的激励!
zwz_good 2009/12/5 21:14:54
谢谢,最近正在关注Firebird数据库,正好学习一下.
zenzero 2009/12/26 19:54:09
不能下载?
我要发表评论 查看全部评论
 
  DELPHI盒子版权所有 1999-2023 V4.01 粤ICP备10103342号-1 更新RSS列表