unit Unit1;

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.