用Delphi写的备份sqlserver数据库的小工具

unit Unit1;  //20030428 20:12

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Db, ADODB, TFlatButtonUnit, Grids, DBGrids, ExtCtrls, DBCtrls,inifiles,filectrl;

type
  TForm1 = class(TForm)
    ADOQuery1: TADOQuery;
    Label1: TLabel;
    Backup_Button: TButton;
    Exit_Button: TButton;
    ADOConnection1: TADOConnection;
    Button1: TButton;
    Option_Panel: TPanel;
    Label2: TLabel;
    ComputerName_Edit: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    UserName_Edit: TEdit;
    Password_Edit: TEdit;
    DatabaseName_Edit: TEdit;
    BackupOption_Panel: TPanel;
    Label6: TLabel;
    BackupTo_Edit: TEdit;
    Label7: TLabel;
    BackupToOtherComputer_Edit: TEdit;
    Winrar_Panel: TPanel;
    UseWinrar_CheckBox: TCheckBox;
    winrarPath_Label: TLabel;
    WinrarPath_Edit: TEdit;
    Panel1: TPanel;
    Memo1: TMemo;
    Button2: TButton;
    procedure FlatButton3Click(Sender: TObject);
    procedure Backup_ButtonClick(Sender: TObject);
    procedure Exit_ButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure UseWinrar_CheckBoxClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
      DataBaseName : string;         //要登录的数据库名
      UserName : string;         //登录数据库的用户名
      ComputerName : string;     //登录的计算机名
      BackupToFile : string;  //备份到的目的文件名，设为全局
      BackupToOtherComputer : string; //异地备份的路径
      sDateTime : string;      //备份时的日期和时间,将它加到源数据库名的后面
      CustomConnectionString : string;
      CustomSqlString : string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  inifile : Tinifile;

implementation

{$R *.DFM}

function WinExecAndWait32(FileName:String; Visibility : integer):integer;
var
  zAppName:array[0..512] of char;
  zCurDir:array[0..255] of char;
  WorkDir:String;
  StartupInfo:TStartupInfo;
  ProcessInfo:TProcessInformation;
begin
  Result :=0;
  StrPCopy(zAppName,FileName);
  GetDir(0,WorkDir);
  StrPCopy(zCurDir,WorkDir);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb := Sizeof(StartupInfo);

  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    zAppName,                      { pointer to command line string }
    nil,                           { pointer to process security attributes }
    nil,                           { pointer to thread security attributes }
    false,                         { handle inheritance flag }
    CREATE_NEW_CONSOLE or          { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,                           { pointer to new environment block }
    nil,                           { pointer to current directory name }
    StartupInfo,                   { pointer to STARTUPINFO }
    ProcessInfo) then Result := -1 { pointer to PROCESS_INF }

  else begin
    WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
//    GetExitCodeProcess(ProcessInfo.hProcess,Result);
  end;
end;

procedure TForm1.FlatButton3Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Backup_ButtonClick(Sender: TObject);
var
  stmp : string;
begin
  try
    DataBaseName :=DatabaseName_Edit.Text;            //要登录的数据库名
    UserName :=UserName_Edit.Text;                  //登录数据库的用户名
    ComputerName :=ComputerName_Edit.Text;     //登录的计算机名
    sDateTime :=FormatDateTime('_yyyymmdd_hhmmss',now);

    BackupToFile :=BackupTo_Edit.Text+DatabaseName+sDateTime;
    BackupToOtherComputer :=BackupToOtherComputer_Edit.Text;
    label1.Caption :='正在对数据库'+DatabaseName+'进行备份,请稍等一会儿......';
    self.Update;  //刷新窗体,否则label1的标题将是一片白板

    CustomConnectionString :='Provider=SQLOLEDB.1;'+
                             'Persist Security Info=False;'+
                             'User ID='+UserName+';'+
                             'Initial Catalog='+DatabaseName+';'+
                             'Data Source='+ComputerName;
    ADOConnection1.ConnectionString :=CustomConnectionString;
    ADOConnection1.Connected :=True;  //连接数据库
    Adoquery1.connection :=ADOConnection1;


    CustomSqlString :='backup database '+DatabaseName+
                        ' to disk = '+
                        ''''+BackupToFile+'''';
    AdoQuery1.sql.clear;
    Adoquery1.close;
    AdoQuery1.SQL.Text :=CustomSqlString;

    screen.Cursor :=crHourGlass;

    AdoQuery1.ExecSQL;
    ADOConnection1.Connected :=False;  //断开数据库连接

    if UseWinrar_CheckBox.Checked then  //用户要求进行压缩数据库
    begin
      label1.caption :='正在对'+DatabaseName+'进行压缩......';
      SetCurrentDir(WinrarPath_Edit.Text);

      sTmp :=WinrarPath_Edit.text+'rar m '+backupTofile+'.rar'+' '+backupTofile;
      if WinexecAndWait32(sTmp,1)=-1 then
        label1.caption :='压缩失败！';
      if trim(BackupToOtherComputer_Edit.Text)<>'' then  //压缩后备份到异机上
      begin
        if not copyFile(pchar(BackupToFile+'.rar'),pchar(BackupToOtherComputer+DatabaseName+sDateTime+'.rar'),false) then
          showMessage('压缩异地备份时出错！');
      end;
    end
    else
    begin
      if trim(BackupToOtherComputer_Edit.Text)<>'' then  //不压缩备份到异机上
      begin
        if not copyFile(pchar(BackupToFile),pchar(BackupToOtherComputer+DatabaseName+sDateTime),false) then
          showMessage('完全异地备份时出错！');
      end;
    end;
    screen.Cursor :=crDefault;
    label1.caption :='操作完成';
  except
    Messagebox(application.handle,'在备份过程中发生错误','提示',mb_OK+mb_iconwarning);
    screen.Cursor :=crDefault;
    label1.caption :='';
    ADOConnection1.Connected :=False;  //断开数据库连接
  end;
  if fileexists('c:\tmp.txt') then application.Terminate;
end;

procedure TForm1.Exit_ButtonClick(Sender: TObject);
begin
  close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  iniFile :=Tinifile.Create('SaveMe.ini');
  ComputerName_Edit.text               :=inifile.ReadString('info','ComputerName',ComputerName_Edit.Text);
  DatabaseName_Edit.text               :=inifile.ReadString('info','databaseName',DatabaseName_Edit.Text);
  UserName_Edit.text                   :=inifile.ReadString('info','UserName',UserName_Edit.Text);
  Password_Edit.text                   :=inifile.ReadString('info','Password',Password_Edit.Text);
  BackupTo_Edit.text                   :=inifile.ReadString('info','BackupTo',BackupTo_Edit.Text);
  BackupToOtherComputer_Edit.text      :=inifile.ReadString('info','BackupToOtherComputer',BackupToOtherComputer_Edit.Text);
  UseWinrar_CheckBox.Checked           :=inifile.ReadBool('info','UseWinrar',UseWinrar_CheckBox.Checked);
  WinrarPath_Edit.text                 :=inifile.ReadString('info','WinrarPath',WinrarPath_Edit.Text);

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  inifile.WriteString('info','ComputerName',ComputerName_Edit.Text);
  inifile.WriteString('info','DatabaseName',DatabaseName_Edit.Text);
  inifile.WriteString('info','UserName',UserName_Edit.Text);
  inifile.WriteString('info','Password',Password_Edit.Text);
  inifile.WriteString('info','BackupTo',BackupTo_Edit.Text);
  inifile.WriteString('info','BackupToOtherComputer',BackupToOtherComputer_Edit.Text);
  inifile.WriteBool('info','UseWinrar',UseWinrar_CheckBox.Checked);
  inifile.WriteString('info','WinrarPath',WinrarPath_Edit.Text);

  inifile.Free;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  if UseWinrar_CheckBox.Checked then
  begin
    WinrarPath_Edit.Visible :=True;
    WinrarPath_Label.Visible :=True;
  end
  else
  begin
    WinrarPath_Edit.Visible :=False;
    WinrarPath_Label.Visible :=False;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i : integer;
begin
  for i :=1 to 10 do
   if not copyFile(pchar('c:\aaa.txt'),pchar('g:\no_'+intTostr(i)+'.txt'),false) then
     showMessage('error');
end;

procedure TForm1.UseWinrar_CheckBoxClick(Sender: TObject);
begin
  if UseWinrar_CheckBox.Checked then
  begin
    WinrarPath_Edit.Visible :=True;
    WinrarPath_Label.Visible :=True;
  end
  else
  begin
    WinrarPath_Edit.Visible :=False;
    WinrarPath_Label.Visible :=False;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  showMessage('kkkkkkkk');
  winexecAndWait32('D:\Program Files\WinRAR\RAR.exe a c:\hnzgddd.rar c:\hnzg.rar',1);
  showMessage('oooooo');
end;

end.