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
  try
    DBTables.Session.AddPassword('jIGGAe');
  except
    MessageDlg('BDE error. Please check whether BDE is installed on this machine. Also this error could be caused by Vista/Windows7 UAC (User Account Control) limitations.'+#13#10+
    'Switch off UAC using configuration option in the "User Accounts" control panel to disable User Account Control and run DBImportExport after that.',mtError, [mbOK],0);
    exit;
  end;
  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;
  try
    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.AsWideString := VChk.DefValue;
           if (VChk.HasMin) then
             MinValue.AsWideString := VChk.MinValue;
           if (VChk.HasMax) then
             MaxValue.AsWideString := VChk.MaxValue;
           DoRestructureTable := true;
         end;
     if (DoRestructureTable) then
       begin
         s := '';
         ABSTable.RestructureTable(s);
         Log := Log+s;
       end;
  except
    Log := Log+'importing default, min, max values for table "'+Table.TableName+'" fields skipped';
  end;
end;


begin
  PromptOverwrite := True;
  IsStopped := False;
  AbsDB.Close;
  Table.Close;
  mImportDetails.Clear;
  AbsDB.DatabaseFileName := edImportDestDB.Text;
//  AbsDB.PageSize := 16*1024;
  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;
          Table.IndexDefs.Update;
          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;
      end;
    if (IsStopped) then
      mImportDetails.Lines.Add('Import stopped by user')
    else
      mImportDetails.Lines.Add('Import finished');
end;


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

function ValToStr(VCHK: DBIVCHK; FldType: word): string;
var
  L: longint;
  I: Integer;
  D: Double;
  MyDate: BDE.DBIDATE;
  MyTime: BDE.Time;
  Hour, Minute, MSecond: Word;
  MyTS: BDE.TimeStamp;
  W1: word;
  Month, Day: word;
  Year: Smallint;
begin

  case FldType of

    fldZSTRING: Result := PChar(@VCHK);

    fldFLOAT:

    begin

      Move(VCHK, D, sizeof(D));

      Result := FloatToStr(D);

    end;

    fldINT32, fldUINT32:

    begin

      Move(VCHK, L, sizeof(L));

      Result := IntToStr(L);

    end;

    fldINT16:

    begin

      Move(VCHK, I, sizeof(I));

      Result := IntToStr(I);

    end;

    fldUINT16:

    begin

      Move(VCHK, W1, sizeof(W1));

      Result := IntToStr(W1);

    end;

    fldDATE:

    begin

      Move(VCHK, MyDate, sizeof(MyDate));

      if MyDate < 0 then

        Result := 'TODAY'

      else

      begin

        Check(DbiDateDecode(MyDate, Month, Day, Year));

        Result := Format('%d/%d/%d', [Month, Day, Year]);

      end;

    end;

    fldTIME:

    begin

      Move(VCHK, MyTime, sizeof(MyTime));

      if MyTime < 0 then

        Result := 'NOW'

      else

      begin

        Check(DbiTimeDecode(MyTime, Hour, Minute, MSecond));

        if Hour < 12 then

          Result := Format('%d:%d:%d AM', [Hour, Minute, MSecond div 1000])

        else

          Result := Format('%d:%d:%d PM', [Hour - 12, Minute, MSecond div 1000]);

      end;

    end;

    fldTIMESTAMP:

    begin

      Move(VCHK, MyTS, sizeof(MyTS));

      if MyTS = 0 then

        Result := 'NOW'

      else

      begin

        Check(DbiTimeStampDecode(MyTS, MyDate, MyTime));

        Check(DbiDateDecode(MyDate, Month, Day, Year));

        Check(DbiTimeDecode(MyTime, Hour, Minute, MSecond));

        if Hour < 12 then
          Result := Format('%d/%d/%d @ %d:%d:%d AM',
                   [Month, Day, Year, Hour, Minute, MSecond div 1000])
        else
          Result := Format('%d/%d/%d @ %d:%d:%d PM',

                   [Month, Day, Year, Hour - 12, Minute, MSecond div 1000]);
      end;
    end;
  end;
end;

var
  Props: CURProps;
  V: VCHKDesc;
  hCur: hDBICur;
  pField: pFLDDesc;
begin
  Result := False;
  Check(DbiGetCursorProps(Table.Handle, Props));
  if Props.iValChecks > 0 then
  begin
    Check(DbiOpenVChkList(Table.DBHandle, PAnsiChar(Table.TableName),
              Props.szTableType, hCur));
    pField := AllocMem(Props.iFields * sizeof(FLDDesc));
    try
      while DbiGetNextRecord(hCur, dbiNOLOCK, @V, nil) = DBIERR_NONE do

      begin

        if V.iFldNum = Field.Index + 1 then

        begin

          Result := true;

          VChk.Required := V.bRequired;

          VChk.HasDefault := V.bHasDefVal;

          VChk.HasMin := V.bHasMinVal;

          VChk.HasMax := V.bHasMaxVal;



          Check(DbiGetFieldDescs(Table.Handle, pField));

          Inc(pField, Field.Index);

          if VChk.HasDefault = TRUE then

            VChk.DefValue := ValToStr(V.aDefVal, pField^.iFldType);

          if VChk.HasMin = TRUE then

            VChk.MinValue := ValToStr(V.aMinVal, pField^.iFldType);

          if VChk.HasMax = TRUE then

            VChk.MaxValue := ValToStr(V.aMaxVal, pField^.iFldType);

          Dec(pField, Field.Index);

        end;

      end;

    finally
      FreeMem(pField);
      Check(DbiCloseCursor(hCur));
    end;
  end;
end;
procedure CreateTableProc;
begin
  fMain.Table.CreateTable;
end;

procedure TfMain.PerformExport;
var
  i: Integer;
  PromptOverwrite: Boolean;
  mr: TModalResult;
  Log: String;
begin
  PromptOverwrite := True;
  IsStopped := False;
  AbsDB.Close;
  Table.Close;
  mExportDetails.Clear;
  mExportDetails.Lines.Add(Format('Export tables from "%s"',[edExportedDB.Text]));
  AbsDB.DatabaseFileName := edExportedDB.Text;
  try
    AbsDB.Open;
  except
    MessageDlg(Format('Cannot open "%s" database file',[AbsDB.DatabaseFileName]),mtError,[mbOk],0);
    btBack.Enabled := True;
    exit;
  end;
  Table.DatabaseName := lbExportAlias.Items[lbExportAlias.ItemIndex];
  gOverallExport.MaxValue := lbExportTables.SelCount;
  gOverallExport.Progress := 0;
  // Export tables
  for i := 0 to lbExportTables.Count - 1 do
    if (lbExportTables.Selected[i]) then
      begin
        if (IsStopped) then
          break;
        ABSTable.Close;
        Table.Close;
        Table.TableName := lbExportTables.Items[i];
        ABSTable.TableName := lbExportTables.Items[i];
        // overwrite existing table?
        if (Table.Exists and PromptOverwrite) then
          begin
            mr := MessageDlg(Format('Table "%s" exists in "%s" database. Do you want to overwrite it?',[Table.TableName, Table.DatabaseName]),
        			               mtConfirmation,[mbYes,mbNo,mbAll],0);
            if (mr = mrNo) then
              begin
                mExportDetails.Lines.Add(Format('Tables "%s" already exists, its Export cancelled by user',[Table.TableName]));
                gOverallExport.Progress := gOverallExport.Progress + 1;
                continue;
              end
            else
              if (mr = mrAll) then
                PromptOverwrite := False;
          end;
        // Export table
        lExportTable.Caption := Format('Exporting table "%s"',[ABSTable.TableName]);
        mExportDetails.Lines.Add(lExportTable.Caption);
        Log := '';
        try
          ABSTable.ExportTable(Table, CreateTableProc, Log);
          Table.Close;
          Table.Open;
          ABSTable.Open;
          if (Log = '') then Log := 'No errors';
          mExportDetails.Lines.Add(Format('Table "%s" Exported. %d records transferred, %d records skipped. ErrorLog: %s',
             [ABSTable.TableName, Table.RecordCount, ABSTable.RecordCount-Table.RecordCount, Log]));
        except
          on E: Exception do
             mExportDetails.Lines.Add(Format('Table "%s" Export failed. Error: %s. ErrorLog: %s',
                                   [ABSTable.TableName, E.Message, Log]));
        end;
        gOverallExport.Progress := gOverallExport.Progress + 1;
      end;
    if (IsStopped) then
      mExportDetails.Lines.Add('Export stopped by user')
    else
      mExportDetails.Lines.Add('Export finished');
end;


procedure TfMain.lbImportAliasesClick(Sender: TObject);
begin
 DBTables.Session.GetTableNames(lbImportAliases.Items[lbImportAliases.ItemIndex],'',True,True,lbImportAliasTables.Items);
 lbImportAliasTablesClick(Sender);
end;

procedure TfMain.lbImportAliasTablesClick(Sender: TObject);
begin
  btNext.Enabled := (lbImportAliasTables.SelCount > 0);
end;

procedure TfMain.dlbImportChange(Sender: TObject);
begin
  DBTables.Session.GetTableNames(dlbImport.Directory,'',True,True,lbImportFolderTables.Items);
  lbImportFolderTablesClick(Sender);
end;

procedure TfMain.lbImportFolderTablesClick(Sender: TObject);
begin
  btNext.Enabled := (lbImportFolderTables.SelCount > 0);
end;

procedure TfMain.btBrowseImportDestinationDBClick(Sender: TObject);
begin
  if (odAbsDb.Execute) then
    edImportDestDB.Text := odAbsDb.FileName;
end;

procedure TfMain.btStopImportClick(Sender: TObject);
begin
  IsStopped := True;
end;

procedure TfMain.ABSTableBeforeImport(Sender: TObject);
begin
  gTableImport.Progress := 0;
end;

procedure TfMain.ABSTableImportProgress(Sender: TObject;
  PercentDone: Integer; var Continue: Boolean);
begin
  gTableImport.Progress := PercentDone;
  Continue := not IsStopped;
  Application.ProcessMessages;
end;

procedure TfMain.btSelectDBToExportClick(Sender: TObject);
begin
  if (odAbsDb.Execute) then
    edExportedDB.Text := odAbsDb.FileName;
end;

procedure TfMain.lbExportTablesClick(Sender: TObject);
begin
  btNext.Enabled := (lbExportTables.SelCount > 0);
end;

procedure TfMain.btStopExportClick(Sender: TObject);
begin
  IsStopped := True;
end;

procedure TfMain.ABSTableBeforeExport(Sender: TObject);
begin
  gTableExport.Progress := 0;
end;

procedure TfMain.ABSTableExportProgress(Sender: TObject;
  PercentDone: Integer; var Continue: Boolean);
begin
  gTableExport.Progress := PercentDone;
  Continue := not IsStopped;
  Application.ProcessMessages;
end;

procedure TfMain.ABSTableAfterExport(Sender: TObject);
begin
  gTableExport.Progress := 100;
end;

end.
