datafrm.pas

delphi7,源代码 主要的是进行DELPHI7的源代码进行管理和维护

unit datafrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Buttons, ExtCtrls, ADOBackUP, FileCtrl, Registry,
  XPMenu;

type
  Tfrm_Data = class(TForm)
    Bevel1: TBevel;
    lbl_Caption: TLabel;
    edt_Path: TEdit;
    SpeedButton1: TSpeedButton;
    ProgressBar: TProgressBar;
    btnOK: TButton;
    btnCancel: TButton;
    ADOBackUP: TADOBackUP;
    OpenDialog: TOpenDialog;
    Panel_Hide: TPanel;
    Label2: TLabel;
    Edt_FileName: TEdit;
    XPMenu1: TXPMenu;
    ADOBackUP2: TADOBackUP;
    procedure btnCancelClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure ADOBackUPProcession(Sender: TObject; Ratio: Integer);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    FOK: Boolean;
  public
    { Public declarations }
  end;

function Show_Backup: Boolean;
function Show_Restore: Boolean;

implementation

uses DM;

{$R *.DFM}

function Show_Backup: Boolean;
begin
  with Tfrm_data.Create(Application) do
    begin
      Caption := '数据备份';
      lbl_Caption.Caption := '备份路径:';
      Edt_FileName.Text := FormatdateTime('yyyy-mm-dd', now) + '.dat';
      FOK := False;
      try
        Showmodal;
      finally
        Result := FOK;
        free;
      end;
    end;
end;

function Show_Restore: Boolean;
var
  mHeight           : Integer;
begin
  with Tfrm_data.Create(Application) do
    begin
      Caption := '数据恢复';
      mHeight := Panel_Hide.Height;
      panel_Hide.Visible := False;
      Bevel1.Height := Bevel1.Height - mHeight;
      ProgressBar.Top := ProgressBar.Top - mHeight;
      btnOK.Top := btnOK.Top - mHeight;
      btnCancel.Top := btnCancel.Top - mHeight;
      Height := Height - mHeight;
      lbl_Caption.Caption := '备份文件:';
      FOK := False;
      try
        Showmodal;
      finally
        Result := FOK;
        free;
      end;
    end;
end;

procedure Tfrm_Data.btnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure Tfrm_Data.SpeedButton1Click(Sender: TObject);
var
  mPath, mFile      : string;
begin
  if caption = '数据备份' then
    begin
      if Selectdirectory('请选择备份路径', 'C:', mPath) then
        edt_Path.Text := mPath;
    end
  else
    if caption = '数据恢复' then
      begin
        mFile := ADOBackup.BrowseBackFile;
        if mFile <> '' then
          edt_Path.Text := mFile;
      end;
end;

procedure Tfrm_Data.btnOKClick(Sender: TObject);

  function mIsWrong: Boolean;
  begin
    edt_path.Text := trim(edt_Path.text);
    Result := True;
    if edt_Path.Text = '' then
      begin
        Application.MessageBox('请选择备份路径！', '系统提示',
          MB_ICONINFORMATION);
        exit;
      end;
    try
      ForceDirectories(edt_path.Text);
    except
      Application.MessageBox('创建路径不合法，请检查！', '系统提示',
        MB_ICONINFORMATION);
      exit;
    end;
    Result := False;
  end;
var
  Reg               : TRegistry;
  mPath             : string;
  mTables, mSql, mTab2, mSQL2     : TStrings;
  i, j                 : integer;
begin
  FOK := True;
  if caption = '数据备份' then
    begin
      mSql := TStringList.Create;
      mSQL2 := TStringList.Create;
      mTables := TStringlist.Create;
      mTab2 := TStringlist.Create;
      try
        DMMain.ADOConnection1.GetTableNames(mTables);
        DMMain.ADOConnection2.GetTableNames(mTab2);
        for i := mtables.Count - 1 downto 0 do
          begin
            msql.Add('Select * from ' + mTables[i]);
          end;
        ADOBackUP.SQLStrings.Assign(mSql);
        for j := mTab2.Count - 1 downto 0 do
          mSQL2.Add('Select * from ' + mTab2[j]);
        ADOBackUP2.SQLStrings.Assign(mSQL2);
      finally
        msql.Free;
        mtables.Free;
        mTab2.Free ;
      end;
      mPath := edt_Path.Text;
      if mPath[Length(mPath)] <> '\' then
        mPath := mPath + '\';
      Edt_fileName.Text := Trim(Edt_FileName.text);
      if Edt_fileName.Text = '' then
      begin
        ADOBackup.BackUpFileName := FormatdateTime('yyyy-mm-dd', now) + '.dat' ;
        ADOBackup2.BackUpFileName := FormatdateTime('yyyy-mm-dd', now) + '.dat.tip' ;
      end
      else
      begin
        ADOBackup.BackUpFileName := Edt_FileName.Text;
        ADOBackup2.BackUpFileName := Edt_FileName.Text + '.tip';
      end;
      ADOBackup.Info.Add('* 所有数据');
      ADOBackup2.Info.Add('* 所有数据');
      if ADOBackUP.Backup(mPath) and ADOBackUP2.Backup(mPath) then
        begin
          Reg := TRegistry.Create;
          try
            Reg.RootKey := HKey_Local_Machine;
            if Reg.OpenKey('\Software\hmjwfsoft\hmj\2.0', True) then
              Reg.WriteString('BackupPath', mPath + ADOBackup.BackUpFileName);
          finally
            Reg.Free;
          end;
          Application.MessageBox('备份成功！', '系统提示', MB_ICONINFORMATION);
        end
      else
        begin
          FOK := False;
          Application.MessageBox('备份失败！', '系统提示', MB_ICONINFORMATION);
        end;
    end
  else
    if Caption = '数据恢复' then
      begin
        try
          if ADOBackUP.Restore(edt_Path.text) and ADOBackUP2.Restore(edt_Path.text + '.tip') then
            Application.MessageBox('恢复成功！', '系统提示', MB_ICONINFORMATION)
          else
            begin
              FOK := False;
              Application.MessageBox('恢复失败！', '系统提示',
                MB_ICONINFORMATION);
            end;
        except
          Application.MessageBox('恢复失败！', '系统提示', MB_ICONINFORMATION);
        end;
      end;
  Self.Close;
end;

procedure Tfrm_Data.ADOBackUPProcession(Sender: TObject; Ratio: Integer);
begin
  ProgressBar.Position := Ratio;
end;

procedure Tfrm_Data.FormShow(Sender: TObject);
var
  Reg               : TRegistry;
  mFile             : string;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKey_Local_Machine;
    if Reg.OpenKey('\Software\hmjwfsoft\hmj\2.0', True) then
      begin
        mFile := Reg.ReadString('BackupPath');
        if mFile <> '' then
          begin
            try
              if Caption = '数据恢复' then
                edt_path.text := mFile
              else
                if Caption = '数据备份' then
                  edt_Path.Text := extractfilePath(mFile);
            except
            end;
          end;
      end;
  finally
    Reg.Free;
  end;
end;

end.