unit1.pas

在自己的程序中完成SQK2K中的数据库的备份和恢复。虽然调用外部程序来完成

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB, CheckLst, ComCtrls, DateUtils, ActnList,
  ExtCtrls, DBTables, Registry, StrUtils;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ProcessBtn: TButton;
    PVTableNameMemo: TMemo;
    PVTableCaptionMemo: TMemo;
    RTUTableNameMemo: TMemo;
    RTUTableCaptionMemo: TMemo;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    BakJobLstBox: TListBox;
    ActionList1: TActionList;
    LoadDataDict: TAction;
    DisplayTableCaption: TAction;
    GenZipDesc: TAction;
    ProcessBackup: TAction;
    GetBakJobLst: TAction;
    ReadZipDesc: TAction;
    GenSltdZipTblNameLst: TAction;
    SelectAllZipTable: TAction;
    ProcessRestore: TAction;
    DeleteZipFile: TAction;
    ConnectDatabase: TAction;
    ADOQuery1: TADOQuery;
    PVLV: TListView;
    DataBaseRdoGrp: TRadioGroup;
    ProgressBar1: TProgressBar;
    MakeBakJobDir: TAction;
    RTULV: TListView;
    Button1: TButton;
    Button2: TButton;
    BakPVLV: TListView;
    BakRTULV: TListView;
    BakRdoGrp: TRadioGroup;
    ShowBakTbl: TAction;
    ADOTable1: TADOTable;
    TabSheet3: TTabSheet;
    BcpOutputMemo: TMemo;
    ValidateBCP: TAction;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure CheckAllItem(Tick:Boolean; cList:TCheckListBox);
    procedure LoadDataDictExecute(Sender: TObject);
    procedure ConnectDatabaseExecute(Sender: TObject);
    procedure DisplayTableCaptionExecute(Sender: TObject);
    procedure PVLVColumnClick(Sender: TObject; Column: TListColumn);
    procedure PVLVChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure ProcessBackupExecute(Sender: TObject);
    procedure MakeBakJobDirExecute(Sender: TObject);
    procedure ProcessBtnClick(Sender: TObject);
    procedure PVLVEdited(Sender: TObject; Item: TListItem; var S: String);
    procedure DataBaseRdoGrpClick(Sender: TObject);
    procedure RTULVChange(Sender: TObject; Item: TListItem;
      Change: TItemChange);
    procedure GetBakJobLstExecute(Sender: TObject);
    procedure BakJobLstBoxClick(Sender: TObject);
    procedure BakRdoGrpClick(Sender: TObject);
    procedure ShowBakTblExecute(Sender: TObject);
    procedure ProcessRestoreExecute(Sender: TObject);
    procedure ValidateBCPExecute(Sender: TObject);

  private
    { Private declarations }
    //获取表的中文显示名
    function GetTableCaption(TableNameLst:TStringList; DDictName:TStringList; DDictCaption:TStringList):TStringList;
    //返回表的记录数
    function RecCount(DBName:string; TblName:string):Integer;
    procedure BcpBackup(DBName,TblName,TblFilename:string);
    procedure BcpRestore(DBName,TblName,TblFilename:string);
    procedure RunBcp(Parameter:string);
    procedure EnableDataBaseConstraint(DBName:string; Enable:Boolean);
  public
    { Public declarations }
  end;

type
  TableRecordCount=record
    TableName:string[50];
    RecordCount:Integer;
end; //type TableRecordCount

type
  FileSizeLst=array[0..50] of Integer;

var
  Form1: TForm1;
  ExeDir,BakDir,BakJobDir:string;
  DBConnected:Boolean=False;
//  ADOC:TADOConnection;
  PVTableNameLst, PVTableCaptionLst, RTUTableNameLst, RTUTableCaptionLst:TStringList;
  SltdPVTableCaptionLst, SltdRTUTableCaptionLst:TStringList;
  SltdPVTableNameLst, SltdRTUTableNameLst:TStringList;
  BCPFullName:string;
  FetchingLV:Boolean=False;
//  PVTblRecCount=array[0..42] of TableRecordCount;

const
  PVDBName:string='PV3000';
  RTUDBName:string='PVRTU';
  TblFileExtName:string='tbk';
  PVTableCount:Integer=42;
  RTUTableCount:Integer=9;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

//  ADOC:=TADOConnection.Create(nil);
  ValidateBCPExecute(nil);  //获取BCP的全文件名

  //真实的目录
  ExeDir:=ExtractFileDir(Application.ExeName);
  BakDir:=ExeDir+'\DataBackup';

  PVTableNameLst:=TStringList.Create;
  PVTableCaptionLst:=TStringList.Create;
  RTUTableNameLst:=TStringList.Create;
  RTUTableCaptionLst:=TStringList.Create;
  SltdPVTableCaptionLst:=TStringList.Create;
  SltdRTUTableCaptionLst:=TStringList.Create;
  SltdPVTableNameLst:=TStringList.Create;
  SltdRTUTableNameLst:=TStringList.Create;

  LoadDataDictExecute(nil);//装入数据字典
  ConnectDatabaseExecute(nil);//联接数据库
  FetchingLV:=True;//正在填充,不要打扰
  DisplayTableCaptionExecute(nil);//填充LISTVIEW
  FetchingLV:=False;//完了

  GetBakJobLstExecute(nil);//取已有的备份列表

end;

//获取表的中文显示名
function TForm1.GetTableCaption(TableNameLst:TStringList; DDictName:TStringList; DDictCaption:TStringList):TStringList;
var
  I,II:Integer;
begin
  Result:=TStringList.Create;
  //逐条取出查表翻译
  for I:=0 to TableNameLst.Count-1 do
  begin
    for II:=0 to DDictName.Count-1 do
    begin
      if TableNameLst[I]=DDictName[II] then
      begin
        Result.Add(DDictCaption[II]);
        break;
      end; //if
    end; //for II
//    Result.Add('未知Caption的表：'+TableNameLst[I]);
  end;
end;

procedure TForm1.CheckAllItem(Tick: Boolean; cList: TCheckListBox);
var
  I:Integer;
begin
  for I:=0 to cList.Count-1 do cList.Checked[I]:=Tick;

end;

procedure TForm1.LoadDataDictExecute(Sender: TObject);
begin
  PVTableNameMemo.Lines.LoadFromFile('PVTableName.txt');
  PVTableCaptionMemo.Lines.LoadFromFile('PVTableCaption.txt');
  RTUTableNameMemo.Lines.LoadFromFile('RTUTableName.txt');
  RTUTableCaptionMemo.Lines.LoadFromFile('RTUTableCaption.txt');
end;

procedure TForm1.ConnectDatabaseExecute(Sender: TObject);
begin
  if DBConnected then Exit; //一次就行,重入无意义
  ADOConnection1.Connected:=True;
  DBConnected:=True;
end;

procedure TForm1.DisplayTableCaptionExecute(Sender: TObject);
var
  I:Integer;
begin

  //先联接PV
  ADOConnection1.DefaultDatabase:=PVDBName;
  ADOConnection1.GetTableNames(PVTableNameLst,False);
  PVTableCaptionLst:=GetTableCaption(PVTableNameLst, TStringList(PVTableNameMemo.Lines), TStringList(PVTableCaptionMemo.Lines));
  //填充PVLV
  PVLV.Clear;
  for I:=0 to PVTableCaptionLst.Count-1 do
  begin
    PVLV.AddItem(PVTableCaptionLst.Strings[I],nil);
    PVLV.Items[I].SubItems.Add('');
    PVLV.Items[I].SubItems.Add(PVTableNameLst[I]);
    PVLV.Items[I].SubItems.Add('');
  end;
  PVLV.SortType:=stText;

  //先联接RTU
  ADOConnection1.DefaultDatabase:=RTUDBName;
  ADOConnection1.GetTableNames(RTUTableNameLst,False);
  RTUTableCaptionLst:=GetTableCaption(RTUTableNameLst, TStringList(RTUTableNameMemo.Lines), TStringList(RTUTableCaptionMemo.Lines));
  //填充RTULV
  RTULV.Clear;
  for I:=0 to RTUTableCaptionLst.Count-1 do
  begin
    RTULV.AddItem(RTUTableCaptionLst.Strings[I],nil);
    RTULV.Items[I].SubItems.Add('');
    RTULV.Items[I].SubItems.Add(RTUTableNameLst[I]);
    RTULV.Items[I].SubItems.Add('');
  end;
  RTULV.SortType:=stText;
end;

procedure TForm1.PVLVColumnClick(Sender: TObject; Column: TListColumn);
var
  Tick:Boolean;
  I:Integer;
begin
  //全选或全否
  case Column.Index of
    0:Tick:=True;
    1:Tick:=False;
  else
    Exit;
  end;

  //循环
  for I:=0 to TListView(Sender).Items.Count-1 do
    TListView(Sender).Items[I].Checked:=Tick;

end;

function TForm1.RecCount(DBName, TblName: string): Integer;
begin
  ADOConnection1.DefaultDatabase:=DBName;
  ADOQuery1.SQL.Clear;
  ADOQuery1.SQL.Text:='Select count(*) from '+TblName;
  ADOQuery1.Open;
  Result:=ADOQuery1.Fields[0].Value;
  ADOQuery1.Close;
end;

procedure TForm1.PVLVChange(Sender: TObject; Item: TListItem;
  Change: TItemChange);
begin
  if FetchingLV then Exit; //正在填充,不要处理

  if Item.SubItems[2]='' then //取表记录数
    Item.SubItems[2]:=IntToStr(RecCount(PVDBName,Item.SubItems[1]));
end;

procedure TForm1.ProcessBackupExecute(Sender: TObject);
var
  I:Integer;
  SumRecCount:Integer;//要处理的所有表的总记录数
  FullName,TableName:string;
begin

  SumRecCount:=0;//统计记录数
  for I:=0 to PVLV.Items.Count-1 do
  begin
    if PVLV.Items[I].Checked then
      SumRecCount:=SumRecCount+StrToInt(PVLV.Items[I].SubItems[2]);
  end;

  for I:=0 to RTULV.Items.Count-1 do
  begin
    if RTULV.Items[I].Checked then
      SumRecCount:=SumRecCount+StrToInt(RTULV.Items[I].SubItems[2]);
  end;

  if SumRecCount=0 then //用户没有选表或表没有记录
  begin
    ShowMessage('无有效记录需要备份');
    Exit;
  end;

  BcpOutputMemo.Clear;//清空BCP曾有的显示内容
  TabSheet3.TabVisible:=True;
  PageControl1.ActivePage:=TabSheet3;  //切换到BCP输出显示页
  ProgressBar1.Max:=SumRecCount;

  // ------------- 实际处理 ------------- //
  //先处理PV3000数据库
  for I:=0 to PVLV.Items.Count-1 do //要LISTVIEW的ITEM中循环
  begin
    if PVLV.Items[I].Checked then //需要处理
    begin
      TableName:=PVLV.Items[I].SubItems[1];
      FullName:=BakJobDir+'\'+PVDBName+'.'+TableName+'.'+TblFileExtName;
      BcpBackup(PVDBName, TableName, '"'+FullName+'"');
      ProgressBar1.Position:=ProgressBar1.Position+StrToInt(PVLV.Items[I].SubItems[2]);
      ProgressBar1.Refresh;
    end;
  end;

  //再处理RTU
  for I:=0 to RTULV.Items.Count-1 do
  begin
    if RTULV.Items[I].Checked then
    begin
      TableName:=RTULV.Items[I].SubItems[1];
      FullName:=BakJobDir+'\'+RTUDBName+'.'+TableName+'.'+TblFileExtName;
      BcpBackup(RTUDBName, TableName, '"'+FullName+'"');
      ProgressBar1.Position:=ProgressBar1.Position+StrToInt(RTULV.Items[I].SubItems[2]);
      ProgressBar1.Refresh;
    end;
  end;

  PageControl1.ActivePage:=TabSheet1; //回到本页
//  TabSheet3.TabVisible:=False; //隐藏BCP输出页

end;

procedure TForm1.MakeBakJobDirExecute(Sender: TObject);
begin
  BakJobDir:=BakDir+'\'+FormatDateTime('yyyy-mm-dd hh.nn.ss',Now());
  if not(ForceDirectories(BakJobDir)) then
    begin
    MessageDlg('无法创建用于存放这次备份数据的文件夹！',mtError,[mbOK],0);
    end;
end;

procedure TForm1.ProcessBtnClick(Sender: TObject);
begin

  PageControl1.Enabled:=False;
  ProcessBtn.Enabled:=False;

  if PageCOntrol1.ActivePageIndex=0 then
  begin
    MakeBakJobDirExecute(nil);
    ProcessBackupExecute(nil);
    ShowMessage('备份任务已完成');
    GetBakJobLstExecute(nil);//刷新备份列表的显示
  end
  else
  begin
    ProcessRestoreExecute(nil);
    ShowMessage('恢复任务已完成');
  end;

  ProgressBar1.Position:=0;
  PageControl1.Enabled:=True;
  ProcessBtn.Enabled:=True;

end;

procedure TForm1.PVLVEdited(Sender: TObject; Item: TListItem;
  var S: String);
begin
  Caption:=Item.Caption;
end;

procedure TForm1.DataBaseRdoGrpClick(Sender: TObject);
begin
  if DataBaseRdoGrp.ItemIndex=0 then
  begin
    RTULV.Visible:=False;
    PVLV.Visible:=True;
  end
  else
  begin
    PVLV.Visible:=False;
    RTULV.Visible:=True;
  end;

end;