umain.pas

AbsDataBase5.16 最新版

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, FileCtrl, DBTables, DB, ABSMain, Gauges;

type
  TfMain = class(TForm)
    nbWizard: TNotebook;
    Panel1: TPanel;
    btBack: TButton;
    btNext: TButton;
    btCancel: TButton;
    Label1: TLabel;
    rgImportExport: TRadioGroup;
    Label2: TLabel;
    rgImportSource: TRadioGroup;
    Label3: TLabel;
    lbImportAliases: TListBox;
    Label4: TLabel;
    lbImportAliasTables: TListBox;
    Label5: TLabel;
    DriveComboBox1: TDriveComboBox;
    dlbImport: TDirectoryListBox;
    Label6: TLabel;
    lbImportFolderTables: TListBox;
    Label7: TLabel;
    Label8: TLabel;
    edImportDestDB: TEdit;
    btBrowseImportDestinationDB: TButton;
    odAbsDb: TOpenDialog;
    mImportDetails: TMemo;
    Label9: TLabel;
    Label10: TLabel;
    edExportedDB: TEdit;
    btSelectDBToExport: TButton;
    Label11: TLabel;
    lbExportTables: TListBox;
    Label12: TLabel;
    lbExportAlias: TListBox;
    Label13: TLabel;
    mExportDetails: TMemo;
    ABSDb: TABSDatabase;
    ABSTable: TABSTable;
    Table: TTable;
    Label14: TLabel;
    Label15: TLabel;
    gTableImport: TGauge;
    gOverallImport: TGauge;
    btStopImport: TButton;
    lImportTable: TLabel;
    lExportTable: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    gTableExport: TGauge;
    gOverallExport: TGauge;
    btStopExport: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btCancelClick(Sender: TObject);
    procedure btNextClick(Sender: TObject);
    procedure btBackClick(Sender: TObject);
    procedure lbImportAliasesClick(Sender: TObject);
    procedure lbImportAliasTablesClick(Sender: TObject);
    procedure dlbImportChange(Sender: TObject);
    procedure lbImportFolderTablesClick(Sender: TObject);
    procedure btBrowseImportDestinationDBClick(Sender: TObject);
    procedure btStopImportClick(Sender: TObject);
    procedure ABSTableBeforeImport(Sender: TObject);
    procedure ABSTableImportProgress(Sender: TObject; PercentDone: Integer;
      var Continue: Boolean);
    procedure btSelectDBToExportClick(Sender: TObject);
    procedure lbExportTablesClick(Sender: TObject);
    procedure btStopExportClick(Sender: TObject);
    procedure ABSTableBeforeExport(Sender: TObject);
    procedure ABSTableExportProgress(Sender: TObject; PercentDone: Integer;
      var Continue: Boolean);
    procedure ABSTableAfterExport(Sender: TObject);
  private
    IsStopped: Boolean;
    { Private declarations }
    procedure SetWizardPage(step: integer);
    procedure PerformImport;
    procedure PerformExport;
  public
    { Public declarations }
  end;

type
  TVChk = record
    Required, HasDefault, HasMin, HasMax: boolean;
    DefValue, MinValue, MaxValue: string;
  end;

function HasVChk(Table: TTable; Field: TField; var VChk: TVChk): boolean;

procedure CreateTableProc;

var
  fMain: TfMain;

implementation

uses BDE;

{$R *.dfm}

procedure TfMain.FormCreate(Sender: TObject);
begin
  DBTables.Session.AddPassword('jIGGAe');
  nbWizard.PageIndex := 0;
end;

procedure TfMain.btCancelClick(Sender: TObject);
begin
   if (MessageDlg('Abort operation and exit the program?', mtConfirmation, [mbYes, mbNo],0) = mrYes) then
     begin
       Application.Terminate;
       Close;
     end;
end;

procedure TfMain.btNextClick(Sender: TObject);
begin
  SetWizardPage(1);
end;

procedure TfMain.btBackClick(Sender: TObject);
begin
  SetWizardPage(-1);
end;


procedure TfMain.SetWizardPage(step: integer);
var
  cLastChar: widestring;
begin
  cLastChar := #$FFEF;
  cLastChar := cLastChar + #$FFEF;
  if (nbWizard.PageIndex in [5,9]) and (step = 1) then
    Application.Terminate
  else
    begin
       btNext.Enabled := True;
       case nbWizard.PageIndex of
         0: // import or export was selected
            begin
              nbWizard.PageIndex := nbWizard.PageIndex + step;
              if (rgImportExport.ItemIndex = 1) then
                nbWizard.PageIndex := 6;
            end;
         1: // import source was selected
            begin
              if (Step = -1) then
                nbWizard.PageIndex := nbWizard.PageIndex - 1
              else
                begin
                  if (rgImportSource.ItemIndex = 0) then
                    begin
                      DBTables.Session.GetAliasNames(lbImportAliases.Items);
                      lbImportAliasTablesClick(nil);
                      nbWizard.PageIndex := nbWizard.PageIndex + 1;
                    end
                  else
                    begin
                      lbImportFolderTablesClick(nil);
                      nbWizard.PageIndex := nbWizard.PageIndex + 2;
                    end;
                end;
            end;
         2: // import alias and tables were selected
            begin
              if (Step = -1) then
                nbWizard.PageIndex := nbWizard.PageIndex - 1
              else
                nbWizard.PageIndex := nbWizard.PageIndex + 2;
            end;
         3: // import folder and tables were selected
            begin
              if (Step = -1) then
                nbWizard.PageIndex := nbWizard.PageIndex - 2
              else
                nbWizard.PageIndex := nbWizard.PageIndex + 1;
            end;
         4: // import dest db was selected
            begin
              if (Step = -1) then
                if (rgImportSource.ItemIndex = 0) then
                  nbWizard.PageIndex := nbWizard.PageIndex - 2
                else
                  nbWizard.PageIndex := nbWizard.PageIndex - 1
              else
                nbWizard.PageIndex := nbWizard.PageIndex + 1;
              PerformImport;
            end;
         6: // export db was selected
            begin
              if (Step = -1) then
                nbWizard.PageIndex := 0
              else
                begin
                  AbsDb.DatabaseFileName := edExportedDB.Text;
                  try
                    AbsDb.GetTablesList(lbExportTables.Items);
                    lbExportTablesClick(nil);
                    nbWizard.PageIndex := nbWizard.PageIndex + 1;
                  except
                    MessageDlg(Format('Invalid database %s.', [AbsDb.DatabaseFileName]),
                               mtWarning, [mbOK], 0);
                  end;
                end;
            end;
         7: // export tables were selected
            begin
              if (Step = -1) then
                nbWizard.PageIndex := nbWizard.PageIndex - 1
              else
                begin
                  DBTables.Session.GetAliasNames(lbExportAlias.Items);
                  nbWizard.PageIndex := nbWizard.PageIndex + 1;
                end;
            end;
         8: // export alias was selected
            begin
              if (Step = -1) then
                nbWizard.PageIndex := nbWizard.PageIndex - 1
              else
                begin
                  nbWizard.PageIndex := nbWizard.PageIndex + 1;
                  PerformExport;
                end;
            end;
       end;
      btBack.Enabled := (nbWizard.PageIndex <> 0);
      if (nbWizard.PageIndex in [5,9]) then
        begin
          btNext.Caption := 'Finish';
          btBack.Enabled := False;
        end
      else
        btNext.Caption := 'Next >';

    end;
end;


procedure TfMain.PerformImport;
var
  i, tableCount: Integer;
  tables: TListBox;
  tableName: String;
  PromptOverwrite: Boolean;
  mr: TModalResult;
  Log: String;

procedure AddDefaultMinMaxFieldValues;
var
  VChk: TVChk;
  i: Integer;
  DoRestructureTable: Boolean;
  s: String;
begin
  ABSTable.Open;
  ABSTable.Close;
  DoRestructureTable := false;
  for i:=0 to Table.FieldCount-1 do
   if (HasVChk(Table,Table.Fields[i],VChk)) then
     with ABSTable.RestructureFieldDefs.Find(Table.Fields[i].FieldName) do
       begin
         if (VChk.HasDefault) then
           DefaultValue.AsString := VChk.DefValue;
         if (VChk.HasMin) then
           MinValue.AsString := VChk.MinValue;
         if (VChk.HasMax) then
           MaxValue.AsString := VChk.MaxValue;
         DoRestructureTable := true; 
       end;
   if (DoRestructureTable) then
     begin
       s := '';
       ABSTable.RestructureTable(s);
       Log := Log+s;
     end;
end;


begin
  PromptOverwrite := True;
  IsStopped := False;
  AbsDB.Close;
  Table.Close;
  mImportDetails.Clear;
  AbsDB.DatabaseFileName := edImportDestDB.Text;
  if (rgImportSource.ItemIndex = 0) then
    mImportDetails.Lines.Add(Format('Import tables from "%s" to "%s"',[lbImportAliases.Items[lbImportAliases.ItemIndex],AbsDB.DatabaseFileName]))
  else
    mImportDetails.Lines.Add(Format('Import tables from "%s" to "%s"',[dlbImport.Directory,AbsDB.DatabaseFileName]));
  if (not AbsDB.Exists) then
    AbsDB.CreateDatabase;
  try
    AbsDB.Open;
  except
    MessageDlg(Format('Cannot open "%s" database file',[AbsDB.DatabaseFileName]),mtError,[mbOk],0);
    btBack.Enabled := True;
    exit;
  end;
  if (rgImportSource.ItemIndex = 0) then
    begin
      tableCount := lbImportAliasTables.Count;
      tables := lbImportAliasTables;
      Table.DatabaseName := lbImportAliases.Items[lbImportAliases.ItemIndex]
    end
  else
    begin
      tableCount := lbImportFolderTables.Count;
      tables := lbImportFolderTables;
      Table.DatabaseName := dlbImport.Directory;
    end;
  gOverallImport.MaxValue := tables.SelCount;
  gOverallImport.Progress := 0;
  // import tables
  for i := 0 to tableCount - 1 do
    if (tables.Selected[i]) then
      begin
        if (IsStopped) then
          break;
        ABSTable.Close;
        Table.Close;
        tableName := tables.Items[i];
        Table.TableName := tableName;
        // SQL Server: dbo.table -> table
        if (Pos('dbo.', LowerCase(tableName)) = 1) then
          ABSTable.TableName := Copy(tableName, 5, Length(tableName)-4)
        else
          if (LowerCase(ExtractFileExt(tableName))='.dbf') or
             (LowerCase(ExtractFileExt(tableName))='.cds') or
             (LowerCase(ExtractFileExt(tableName))='.db') then
            ABSTable.tableName := Copy(tableName, 1,
                           Length(tableName)-Length(ExtractFileExt(tableName)))
          else
            ABSTable.TableName := tableName;
        // overwrite existing table?
        if (ABSTable.Exists and PromptOverwrite) then
          begin
            mr := MessageDlg(Format('Table "%s" exists in "%s" database. Do you want to overwrite it?',[ABSTable.TableName, ABSDb.DatabaseFileName]),
        			               mtConfirmation,[mbYes,mbNo,mbAll],0);
            if (mr = mrNo) then
              begin
                mImportDetails.Lines.Add(Format('Tables "%s" already exists, its import cancelled by user',[ABSTable.TableName]));
                gOverallImport.Progress := gOverallImport.Progress + 1;
                continue;
              end
            else
              if (mr = mrAll) then
                PromptOverwrite := False;
          end;
        // import table
        lImportTable.Caption := Format('Importing table "%s"',[tableName]);
        mImportDetails.Lines.Add(lImportTable.Caption);
        Log := '';
        try
          Table.Open;
          ABSTable.ImportTable(Table, Log, Table.IndexDefs);
          AddDefaultMinMaxFieldValues;
          ABSTable.Open;
          if (Log = '') then Log := 'No errors';
          mImportDetails.Lines.Add(Format('Table "%s" imported. %d records transferred, %d records skipped.'+#13#10+'ErrorLog: %s',
             [tableName, ABSTable.RecordCount, Table.RecordCount-ABSTable.RecordCount, Log]));
        except
          on E: Exception do
             mImportDetails.Lines.Add(Format('Table "%s" import failed. Error: %s. ErrorLog: %s',
                                   [tableName, E.Message, Log]));
        end;
        gOverallImport.Progress := gOverallImport.Progress + 1;