Delphi控件源码

开发平台：
Delphi

datafrm.pas：源码内容
							unit datafrm;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Buttons, ExtCtrls, ADOBackUP, FileCtrl, Registry;
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;
    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: TStrings;
  i: integer;
begin
  FOK := True;
  if caption = '数据备份' then
  begin
    mSql := TStringList.Create;
    mTables := TStringlist.Create;
    try
      DMMain.ADOConnection1.GetTableNames(mTables);
      for i := mtables.Count - 1 downto 0 do
      begin
        msql.Add('Select * from ' + mtables[i]);
      end;
      ADOBackUP.SQLStrings.Assign(mSql);
    finally
      msql.Free;
      mtables.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
      ADOBackup.BackUpFileName := FormatdateTime('yyyy-mm-dd', now) + '.dat'
    else
      ADOBackup.BackUpFileName := Edt_FileName.Text;
    ADOBackup.Info.Add('* 所有数据');
    if ADOBackUP.Backup(mPath) then
    begin
      Reg := TRegistry.Create;
      try
        Reg.RootKey := HKey_Local_Machine;
        if Reg.OpenKey('SoftwareWolfSofttest1.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) 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('SoftwareWolfSofttest1.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.

						