?? datafrm.pas
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -