unit foBafMigration;

// this code is under the BAF fair use license (BFUL) - https://bafbal.de/index.php?title=Bful
// for data migration

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Controls.Presentation, System.Rtti, FMX.Grid.Style, FMX.Grid, uBafTypes,
  FMX.ScrollBox, FMX.Memo, FMX.TabControl, FMX.ListBox, System.IniFiles,
  Data.DB, System.Math, FMX.Layouts, uBafControls, FMX.Edit, FMX.ComboEdit,
  FMX.Memo.Types, contnrs, StrUtils, foBafCode, dmMain, foBafDialog,
  Winapi.Windows, foBafSqlOpen;

type
  TfrmBafMigration = class(TForm)
    pnlDesk: TPanel;
    btnClose: TButton;
    TabControl1: TTabControl;
    cmbDatabase: TComboBox;
    tabSelect: TTabItem;
    tabSqlExec: TTabItem;
    pnlSqlExecOben: TPanel;
    Panel3: TPanel;
    Splitter2: TSplitter;
    memSqlExec1: TMemo;
    memSqlExec2: TMemo;
    btnSqlExec1: TButton;
    btnSqlExec2: TButton;
    lblSqlExec1: TLabel;
    lblSqlExec2: TLabel;
    btnSqlGuid1: TButton;
    btnSqlGuid2: TButton;
    tabDataMigration: TTabItem;
    pnlDataMigration: TPanel;
    sgDataMigration: TStringGrid;
    lbDataMigration: TBafListBox;
    Panel1: TPanel;
    memDataMigration: TMemo;
    btnDmOpen: TButton;
    btnDmInvestigate: TButton;
    pbDmProgress: TProgressBar;
    panel2: TPanel;
    edtDmKey: TEdit;
    Label1: TLabel;
    btnDmTransfer: TButton;
    cmbDmReduce: TComboBox;
    btnDmReduce: TButton;
    btnDmCompare: TButton;
    tabCode: TTabItem;
    pnlCodeLeft: TPanel;
    Splitter3: TSplitter;
    sgCode: TStringGrid;
    scSource: TStringColumn;
    scDest: TStringColumn;
    scCode: TStringColumn;
    btnCodeExecute: TButton;
    cbExecOnly: TCheckBox;
    timProgress: TTimer;
    cbDmDetailed: TCheckBox;
    pnlSqlExecDesk: TPanel;
    pnlSqlExecTools: TPanel;
    cbSqlExpedite: TCheckBox;
    TabItem1: TTabItem;
    memAdbTables: TMemo;
    memAdbLog: TMemo;
    btnAdmTable: TButton;
    btnAdmExecute: TButton;
    cbAdmIgnoreHist: TCheckBox;
    cbSqlReplaceColumnNames: TCheckBox;
    edtDmTableName: TEdit;
    lblDmTableName: TLabel;
    pnlCodeRight: TPanel;
    cbCodeExecuteWeiter: TCheckBox;
    cbCodeParent: TCheckBox;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cmbDatabaseChange(Sender: TObject);
    procedure btnSqlExec1Click(Sender: TObject);
    procedure btnSqlGuid1Click(Sender: TObject);
    procedure lbDataMigrationDblClick(Sender: TObject);
    procedure btnDmOpenClick(Sender: TObject);
    procedure btnDmInvestigateClick(Sender: TObject);
    procedure btnDmTransferClick(Sender: TObject);
    procedure btnDmReduceClick(Sender: TObject);
    procedure btnDmCompareClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure sgCodeDrawColumnCell(Sender: TObject; const Canvas: TCanvas;
      const Column: TColumn; const Bounds: TRectF; const Row: Integer;
      const Value: TValue; const State: TGridDrawStates);
    procedure btnCodeExecuteClick(Sender: TObject);
    procedure timProgressTimer(Sender: TObject);
    procedure btnAdmTableClick(Sender: TObject);
    procedure btnAdmExecuteClick(Sender: TObject);
  private
    FParentList: TStringList;
    FNameList: TStringList;
  private
    FHasInit: boolean;
    FSqlExecButttonList: TObjectList;
    FDriver: string;
    FMigrationTableName: string;
    FDmKeyCol: integer;
    procedure InitSqlExecButtons;
    procedure SqlExecButttonClick(Sender: TObject);
    function GetMemo1Text: string;
  private
    tvCode: TBafTreeView;
    FSelectedData: TCodeItemData;
    FCodeSource, FCodeDest: TStringList;
    FDestId, FDestParent: string;
    FBafSqlOpen1: TfrmSqlOpen;
    procedure LoadCode;
    procedure ItemExpanded(Sender: TObject);
    procedure tvCodeChange(Sender: TObject);
    procedure FindDest;
    procedure CodeCompare;
  public
    procedure Execute;
    procedure Init;
    property DriverName: string read FDriver write FDriver;
  end;

var
  frmBafMigration: TfrmBafMigration;

implementation

{$R *.fmx}

uses uBafFmxUtils, udataHistSql, foBafDmCompare, uBafCodeUtils,
  uOsStuff;

var
  mvCodeUpdating: boolean;

{ TfrmBafMigration }

procedure TfrmBafMigration.btnAdmExecuteClick(Sender: TObject);
var
  i: integer;
  s: string;
begin
  memAdbLog.Lines.Clear;
  Application.ProcessMessages;
  for i := 0 to memAdbTables.Lines.Count - 1 do begin
    s := memAdbTables.Lines[i];
    if Trim(s) = '' then
      // not table name, nothing to do...
    else if copy(s, 1, 2) = '--' then
      memAdbLog.Lines.Add('o  Do not migrate: ' + copy(s, 3, MaxInt))
    else begin
      FMigrationTableName := s;
      memAdbLog.Lines.Add('v  Migrate: ' + FMigrationTableName);
      memDataMigration.Lines.Text := 'select * from ' + FMigrationTableName;
      edtDmKey.Text := FMigrationTableName + '_id';
      edtDmTableName.Text := FMigrationTableName;
      sgDataMigration.ClearColumns;
      sgDataMigration.RowCount := 0;
      try
        btnDmOpenClick(nil);
        memAdbLog.Lines.Add('v      Table opened');
        Application.ProcessMessages;
        btnDmInvestigateClick(nil);
        memAdbLog.Lines.Add('v      Differences investigated');
        Application.ProcessMessages;
        btnDmTransferClick(nil);
        memAdbLog.Lines.Add('v      Data transferred');
      except
        on E: Exception do begin
          memAdbLog.Lines.Add('x  Exception: ' + E.Message);
          memAdbLog.Lines.Add('x  Migration aborted.');
          raise;
        end;
      end;
    end;
    memAdbLog.Lines.Add('');
    Application.ProcessMessages;
  end;
  memAdbLog.Lines.Add('v  Data migration finished');
// procedure TfrmBafMigration.btnAdmExecuteClick
end;

procedure TfrmBafMigration.btnAdmTableClick(Sender: TObject);
var
  i: integer;
begin
  dataMain.GetTables(DC_MIG, memAdbTables.Lines);
  if cbAdmIgnoreHist.IsChecked then begin
    for i := memAdbTables.Lines.Count - 1 downto 0 do begin
      if Pos('_hist', AnsiLowerCase(memAdbTables.Lines[i])) > 1 then
      memAdbTables.Lines.Delete(i);
    end;
  end;
end;

procedure TfrmBafMigration.btnCodeExecuteClick(Sender: TObject);
var
  LSql: string;
  LParams: TBafParams;
  LDataSet: TDataSet;
  LItem: TBafTreeViewItem;
begin
  if btnCodeExecute.Text = 'Insert' then begin
    LSql := Format('select * from %s where %s = :kid',
        [dataMain.MigCon.CommandTable, dataMain.MigCon.CommandTableId]);
    LParams := dataMain.QueryPrepare(dataMain.MigCon, 'MIG-Select', LSql);
    LParams.ParamAsString('kid', FSelectedData.Parent);
    LDataSet := dataMain.QueryOpen(dataMain.MigCon, 'MIG-Select');
    if (FDestParent = '') and cbCodeParent.IsChecked then
        FDestParent := FSelectedData.Parent;

    dataMain.WriteCommand(DC_MIG, FSelectedData.ID, FSelectedData.Name,
        FSelectedData.Code, FDestParent, 'I', FSelectedData.FTimestamp);
  end
  else if btnCodeExecute.Text = 'Update' then
    if not dataMain.WriteCommand(DC_MIG, FDestId, FSelectedData.Name,
        FSelectedData.Code, FDestParent, 'U', FSelectedData.FTimestampDest) then
      TfrmBafDialog.ShowMessage(dataMain.ProgName, 'Kommando '
          + FSelectedData.Name + ' konnte nicht migriert werden, da es '
          + 'zwischenteitlich geändert wurde.', frmBafCode);
  FindDest;
  CodeCompare;
  if cbCodeExecuteWeiter.IsChecked then begin
    Application.ProcessMessages;
    if tvCode.BafSelected.Count > 0 then
      tvCode.BafSelected := tvCode.BafSelected.Items[0]
    else if (tvCode.BafSelected.Index + 1) < tvCode.BafSelected.ParentItem.Count then
      tvCode.BafSelected := (tvCode.BafSelected.ParentItem.Items[ tvCode.BafSelected.Index + 1] as TBafTreeViewItem)
    else begin
      LItem := nil;
      if tvCode.BafSelected.ParentItem.ParentItem <> nil then begin
          if ((tvCode.BafSelected.ParentItem.Index + 1) < tvCode.BafSelected.ParentItem.ParentItem.Count) then
        LItem := (tvCode.BafSelected.ParentItem.ParentItem.Items[tvCode.BafSelected.ParentItem.Index + 1] as TBafTreeViewItem);
      end;
      if Assigned(LItem) then
        tvCode.BafSelected := LItem;
    end;
  end;
end;

procedure TfrmBafMigration.btnDmCompareClick(Sender: TObject);
var
  LSql: string;
  LParams: TBafParams;
  LDataSet: TDataSet;
begin
  LSql := 'select * from ' + edtDmTableName.Text + ' where ' + edtDmKey.Text + ' = :kid';
  LParams := dataMain.QueryPrepare(dataMain.MigCon, 'MIG-Select', LSql);
  LParams.ParamAsString('kid', sgDataMigration.Cells[FDmKeyCol, sgDataMigration.Row]);
  LDataset := dataMain.QueryOpen(dataMain.MigCon, 'MIG-Select');
  frmBafDmCompare.ShowDialog(sgDataMigration, sgDataMigration.Row, LDataSet);
end;

procedure TfrmBafMigration.btnDmInvestigateClick(Sender: TObject);
var
  i: integer;
  LSql, LFieldName: string;
  LParams: TBafParams;
  LDataset: TDataset;

  function lokDifference: string;
  var
    j: integer;
    LDiff: boolean;
  begin
    LParams.ParamAsString('kid', sgDataMigration.Cells[FDmKeyCol, i]);
    LDataset := dataMain.QueryOpen(dataMain.MigCon, 'MIG-Select');
    if not LDataset.Eof then begin
      LDiff := false;
      for j := 2 to sgDataMigration.ColumnCount - 1 do begin
        LFieldName := AnsiLowerCase(sgDataMigration.Columns[j].Header);
        if (LFieldName <> 'datechg') and (LFieldName <> 'usrchg')
            and (LFieldName <> 'progchg') then begin
          if sgDataMigration.Cells[j, i]
              <> LDataset.FieldByName(LFieldName).AsString then begin
            LDiff := true;
            Break;
          end;
        end;
      end;
      result := IfThen(LDiff, 'U', '');
    end
    else
      result := 'I';
    LDataset.Close;
  end; // function lokDifference

begin
  pbDmProgress.Max := sgDataMigration.RowCount;
  pbDmProgress.Value := 0;
  LSql := 'select * from ' + edtDmTableName.Text + ' where ' + edtDmKey.Text + ' = :kid';
  FDmKeyCol := -1;
  for i := 0 to sgDataMigration.ColumnCount - 1 do begin
    if AnsiCompareText(edtDmKey.Text, sgDataMigration.Columns[i].Header) = 0 then begin
      FDmKeyCol := i;
      Break;
    end;
  end;
  if FDmKeyCol > 1 then begin
    LParams := dataMain.QueryPrepare(dataMain.MigCon, 'MIG-Select', LSql);
    for i := 0 to sgDataMigration.RowCount - 1 do begin
      sgDataMigration.Cells[1, i] := lokDifference;
      pbDmProgress.Value := i + 1;
    end;
  end;
  timProgress.Enabled := true;
// procedure TfrmBafMigration.btnDmInvestigateClick
end;

procedure TfrmBafMigration.btnDmOpenClick(Sender: TObject);
var
  LData: TDataset;
  LText: string;
  LColumn: TColumn;

  procedure lokColumns;
  var
    i, w: integer;
  begin
    LColumn := TStringColumn.Create(sgDataMigration);
    LColumn.Parent := sgDataMigration;
    LColumn.Header := 'Row';
    LColumn.Width := 50;
    LColumn := TStringColumn.Create(sgDataMigration);
    LColumn.Parent := sgDataMigration;
    LColumn.Header := 'Mode';
    LColumn.Width := 50;
    for i := 0 to LData.FieldCount - 1 do begin
      LText := LData.Fields[i].FieldName;
      LColumn := TStringColumn.Create(sgDataMigration);
      LColumn.Parent := sgDataMigration;
      LColumn.Header := LText;
      LColumn.Width := sgDataMigration.Canvas.TextWidth(LText) + 10;
      if LData.Fields[i].DataType in [ftString, ftWideString] then begin
        w := System.Math.Min(40, LData.Fields[i].DataSize) * 7;
        if LColumn.Width < w then
          LColumn.Width := w;
      end
      else if LData.Fields[i].DataType in [ftDate, ftDateTime] then
        LColumn.Width := 70;
    end;
  end; // procedure lokColumns

  procedure lokData;
  var
    i, LCount, LRow: integer;
  begin
    LCount := 0;
    while not LData.Eof do begin
      LRow := sgDataMigration.RowCount;
      sgDataMigration.RowCount := sgDataMigration.RowCount + 1;
      for i := 0 to LData.FieldCount - 1 do
        sgDataMigration.Cells[i + 2, LRow] := LData.Fields[i].AsString;

      inc(LCount);
      sgDataMigration.Cells[0, LRow] := LCount.ToString;
      LData.Next;
    end;
  end; // procedure lokData

begin
  if Trim(memDataMigration.Lines.Text) = '' then begin
    edtDmTableName.Text := lbDataMigration.Items[lbDataMigration.ItemIndex];
    memDataMigration.Lines.Text := 'select * from ' + edtDmTableName.Text;
    edtDmKey.Text := edtDmTableName.Text + '_id';
    sgDataMigration.ClearColumns;
    sgDataMigration.RowCount := 0;
  end;

  sgDataMigration.ClearColumns;
  sgDataMigration.RowCount := 0;
  dataMain.QueryPrepare(dataMain.DefaultCon, 'MIG-DataMig',
      memDataMigration.Lines.Text);
  LData := dataMain.QueryOpen(dataMain.DefaultCon, 'MIG-DataMig');
  lokColumns;
  lokData;
  pbDmProgress.Value := 0;
end;

procedure TfrmBafMigration.btnDmReduceClick(Sender: TObject);
var
  LRow, LMode, LRowDest: integer;
  LModeCell: string;

  procedure lokCopy;
  var
    LCol: integer;
  begin
    if LRow > LRowDest then begin
      for LCol := 0 to sgDataMigration.ColumnCount - 1 do
        sgDataMigration.Cells[LCol, LRowDest] := sgDataMigration.Cells[LCol, LRow];
    end;
    inc(LRowDest);
  end; // procedure lokCopy

begin
  LMode := cmbDmReduce.ItemIndex;
  LRowDest := 0;
  for LRow := 0 to sgDataMigration.RowCount - 1 do begin
    LModeCell := AnsiUpperCase(sgDataMigration.Cells[1, LRow]);
    case LMode of
      0: if (LModeCell = 'I') or (LModeCell = 'U') then
        lokCopy;
      1: if (LModeCell = 'I') then
        lokCopy;
      2: if (LModeCell = 'U') then
        lokCopy;
    end;
  end;
  sgDataMigration.RowCount := LRowDest;
end;

procedure TfrmBafMigration.btnDmTransferClick(Sender: TObject);
var
  LRow: integer;
  LMode, LSqlInsert, LSqlUpdate: string;
  LParamsInsert, LParamsUpdate: TBafParams;

  procedure lokInit;
  var
    i: integer;
    LIns1, LIns2, LUpd1, LUpd2, s: string;
  begin
    for i := 2 to sgDataMigration.ColumnCount - 1 do begin
      s := sgDataMigration.Columns[i].Header;
      LIns1 := LIns1 + ', ' + s;
      LIns2 := LIns2 + ', :' + s;
      if AnsiCompareStr(s, edtDmKey.Text) <> 0 then
        LUpd1 := LUpd1 + ', ' + s + ' = :' + s
      else
        LUpd2 := 'where ' + s + ' = :' + s;
    end;
    LSqlInsert := Format('insert into %s (%s) values (%s)', [edtDmTableName.Text,
        copy(LIns1, 3, MaxInt), copy(LIns2, 3, MaxInt)]);
    LSqlUpdate := Format('update %s set %s %s', [edtDmTableName.Text,
        copy(LUpd1, 3, MaxInt), LUpd2]);
    LParamsInsert := dataMain.QueryPrepare(dataMain.MigCon, 'MIG-Insert', LSqlInsert);
    LParamsUpdate := dataMain.QueryPrepare(dataMain.MigCon, 'MIG-Update', LSqlUpdate);
  end; // procedure lokInit

  procedure lokSetParams(AParams: TBafParams);
  var
    i: integer;
    s, t: string;
    LBafGen: TBafGeneration;
    LTyp: Char;
  begin
    for i := 2 to sgDataMigration.ColumnCount - 1 do begin
      s := AnsiLowerCase(sgDataMigration.Columns[i].Header);
      if s = 'datechg' then
        AParams.ParamAsDateTime('datechg', now)
      else if s = 'usrchg' then begin
        LBafGen := dataMain.MigCon.BafGen;
        if LBafGen in [bg303TT] then
          AParams.ParamAsString('usrchg', dataMain.UserId)
        else
          AParams.ParamAsString('usrchg', dataMain.UserGuid);
      end
      else if s = 'progchg' then
        AParams.ParamAsString('progchg', 'BAF Migration')
      else begin
        t := sgDataMigration.Cells[i, LRow];
        LTyp := dataMain.GetFieldDef(DC_MIG, edtDmTableName.Text, s);
        if t <> '' then begin
          case LTyp of
            'F': AParams.ParamAsFloat(s, StrToFloat(t));
            'D': AParams.ParamAsDateTime(s, StrToDateTime(t));
            'C': AParams.ParamAsCurrency(s, StrToCurr(t));
          else
            AParams.ParamAsString(s, t);
          end;
        end
        else
          AParams.ParamNull(s);
      end;
//        AParams.ParamAsString(s, sgDataMigration.Cells[i, LRow]);
    end;
  end; // procedure lokSetParams

begin
  pbDmProgress.Max := sgDataMigration.RowCount;
  pbDmProgress.Value := 0;
  lokInit;
  for LRow := 0 to sgDataMigration.RowCount - 1 do begin
    LMode := AnsiUpperCase(sgDataMigration.Cells[1, LRow]);
    if LMode = 'I' then begin
      lokSetParams(LParamsInsert);
      dataMain.QueryExecute(dataMain.MigCon, 'MIG-Insert');
    end
    else if LMode = 'U' then begin
      lokSetParams(LParamsUpdate);
      dataMain.QueryExecute(dataMain.MigCon, 'MIG-Update');
    end;;
    pbDmProgress.Value := LRow + 1;
  end;
  btnDmInvestigateClick(nil);
  timProgress.Enabled := true;
end;

procedure TfrmBafMigration.btnSqlExec1Click(Sender: TObject);
var
  LSql, s: string;
  LCount, LStart, LLength: integer;
begin
  lblSqlExec1.Text := '';
  lblSqlExec2.Text := '';
  LStart := memSqlExec1.SelStart;
  LLength := memSqlExec1.SelLength;
  Application.ProcessMessages;
  if Sender = btnSqlExec1 then
    LSql := GetMemo1Text
  else if Sender = btnSqlExec2 then
    LSql := memSqlExec2.Lines.Text;
  if LSql <> '' then begin
    dataMain.QueryPrepare(dataMain.MigCon, QEN_COMMAND, LSql);
    LCount := dataMain.QueryExecute(dataMain.MigCon, QEN_COMMAND);
    if LCount < 1000 then
      s := Format('Rows affected: %d', [LCount])
    else
      s := Format('Rows aff.: %d', [LCount]);
    if Sender = btnSqlExec1 then
      lblSqlExec1.Text := s
    else if Sender = btnSqlExec2 then
      lblSqlExec2.Text := s;
  end
  else
    ShowMessage('no statement');
  if cbExecOnly.IsChecked then begin
    if memSqlExec1.CanFocus then
      memSqlExec1.SetFocus;
    memSqlExec1.SelStart := LStart;
    memSqlExec1.SelLength := LLength;
  end;
end;

procedure TfrmBafMigration.btnSqlGuid1Click(Sender: TObject);
begin
  if Sender = btnSqlGuid1 then
    memSqlExec1.InsertAfter(memSqlExec1.CaretPosition, BafGetGuid,
        [TInsertOption.MoveCaret, TInsertOption.CanUndo])
  else if Sender = btnSqlGuid2 then
    memSqlExec2.InsertAfter(memSqlExec2.CaretPosition, BafGetGuid,
        [TInsertOption.MoveCaret, TInsertOption.CanUndo]);
end;

procedure TfrmBafMigration.cmbDatabaseChange(Sender: TObject);
begin
  Caption := 'Migration  -  '
      + dataMain.SetMigrationDB(cmbDatabase.ItemIndex + 1, FDriver);
  FBafSqlOpen1.Init;
  InitSqlExecButtons;
end;

procedure TfrmBafMigration.CodeCompare;
var
  LLine, LLineDest, LLineGrid: integer;
  LAbsA, LAbsB, LRes1A, LRes2A, LRes1B, LRes2B: integer;

  procedure lokSearchEqual(APos1, APos2: integer; ACode1, aCode2: TStrings;
    var ARes1, ARes2, AAbstand: integer);
  var
    i1, i2: integer;
  begin
    AAbstand := MaxInt;
    for i1 := APos1 to ACode1.Count - 1 do begin
      for i2 := APos2 to ACode2.Count - 1 do begin
        if AnsiCompareStr(ACode1[i1], aCode2[i2]) = 0 then begin
          ARes1 := i1;
          ARes2 := i2;
          AAbstand := (i1 - APos1) + (i2 - APos2);
          exit;
        end;
      end;
    end;
  end; // function lokSearchEqual

  procedure lokSingle(AUntil, AUntilDest: integer);
  begin
    while LLine < AUntil do begin
      sgCode.Cells[0, LLineGrid] := IntToStr(LLine + 1);
      sgCode.Cells[1, LLineGrid] := '';
      sgCode.Cells[2, LLineGrid] := FCodeSource[LLine];
      inc(LLine);
      inc(LLineGrid);
      sgCode.RowCount := LLineGrid + 1;
    end;
    while LLineDest < AUntilDest do begin
      sgCode.Cells[0, LLineGrid] := '';
      sgCode.Cells[1, LLineGrid] := IntToStr(LLineDest + 1);
      sgCode.Cells[2, LLineGrid] := FCodeDest[LLineDest];
      inc(LLineDest);
      inc(LLineGrid);
      sgCode.RowCount := LLineGrid + 1;
    end;
  end; // procedure lokEinzeln

begin
  LLine := 0;
  LLineDest := 0;
  LLineGrid := 0;
  sgCode.RowCount := LLineGrid + 1;
  while (LLine < FCodeSource.Count) or (LLineDest < FCodeDest.Count) do begin
    if (LLine < FCodeSource.Count) and (LLineDest < FCodeDest.Count)                     // we have concordance
        and (AnsiCompareStr(FCodeSource[LLine], FCodeDest[LLineDest]) = 0) then begin
      sgCode.Cells[0, LLineGrid] := IntToStr(LLine + 1);
      sgCode.Cells[1, LLineGrid] := IntToStr(LLineDest + 1);
      sgCode.Cells[2, LLineGrid] := FCodeSource[LLine];
      inc(LLine);
      inc(LLineDest);
      inc(LLineGrid);
      sgCode.RowCount := LLineGrid + 1;
    end
    else begin                                                                     // we have no concordance
      lokSearchEqual(LLine, LLineDest, FCodeSource, FCodeDest, LRes1A, LRes2A, LAbsA);
      lokSearchEqual(LLineDest, LLine, FCodeDest, FCodeSource, LRes1B, LRes2B, LAbsB);
      if (LAbsA < MaxInt) and (LAbsA <= LAbsB) then
        lokSingle(LRes1A, LRes2A)
      else if (LAbsB < MaxInt) and (LAbsB < LAbsA) then
        lokSingle(LRes2B, LRes1B)
      else
        lokSingle(FCodeSource.Count, FCodeDest.Count);
    end;
  end; // while
  sgCode.RowCount := LLineGrid;
// procedure TfrmBafMigration.CodeCompare
end;

procedure TfrmBafMigration.Execute;
begin
  if not FHasInit then
    Init;
  ShowModal;
end;

procedure TfrmBafMigration.FindDest;
var
  LSql: string;
  LParams: TBafParams;
  LDataSet: TDataSet;
  LCount: integer;
begin
  FCodeDest.Clear;
  FDestId := '';
  LSql := Format('select * from %s where name = :kname or %s = :kid',
        [dataMain.MigCon.CommandTable, dataMain.MigCon.CommandTableId]);
  LParams := dataMain.QueryPrepare(dataMain.MigCon, 'MIG-Code', LSql);
  LParams.ParamAsString('kname', FSelectedData.Name);
  LParams.ParamAsString('kid', FSelectedData.ID);
  LDataset := dataMain.QueryOpen(dataMain.MigCon, 'MIG-Code');
  LCount := 0;
  FDestParent := '';
  while not LDataset.Eof do begin
    FCodeDest.Text := LDataSet.FieldByName('code').AsString;
    FDestId := LDataSet.FieldByName(dataMain.MigCon.CommandTableId).AsString;
    FDestParent := LDataSet.FieldByName('parent').AsString;
    FSelectedData.FTimestampDest := LDataSet.FieldByName('datechg').AsDateTime;
    inc(LCount);
    LDataSet.Next;
  end;
  case LCount of
    0: btnCodeExecute.Text := 'Insert';
    1: begin
      if Trim(FSelectedData.Code) = Trim(FCodeDest.Text) then
        btnCodeExecute.Text := '-'
      else
        btnCodeExecute.Text := 'Update';
    end
    else begin
      raise Exception.Create('Different name and id found');
      FCodeDest.Clear;
      FDestId := '';
      btnCodeExecute.Text := '-';
    end;
  end;
end;

procedure TfrmBafMigration.FormCreate(Sender: TObject);
begin
  FParentList := TStringList.Create;
  FParentList.OwnsObjects := true;
  FParentList.Sorted := true;
  FParentList.Duplicates := dupError;
  FNameList := TStringList.Create;
  FNameList.OwnsObjects := true;
  FNameList.Sorted := true;
  FNameList.Duplicates := dupError;

  FSqlExecButttonList := TObjectList.Create;
  tvCode := TBafTreeView.Place(Self, pnlCodeLeft);
  tvCode.OnChange := tvCodeChange;
  FCodeSource := TStringList.Create;
  FCodeDest := TStringList.Create;
  FBafSqlOpen1 := TfrmSqlOpen.Create(Self);
  FBafSqlOpen1.pnlDesk.Parent := tabSelect;
end;

procedure TfrmBafMigration.FormDestroy(Sender: TObject);
begin
  BafFormPos2Ini(Self, dataMain.UserIni, CAT_MIG);
  dataMain.UserIni.UpdateFile;
  FreeAndNil(FSqlExecButttonList);
  FreeAndNil(FCodeSource);
  FreeAndNil(FCodeDest);
  FreeAndNil(FParentList);
  FreeAndNil(FNameList);
end;

procedure TfrmBafMigration.FormShow(Sender: TObject);
begin
  LoadCode;
end;

function TfrmBafMigration.GetMemo1Text: string;
begin
  if cbExecOnly.IsChecked then
    result := copy(memSqlExec1.Lines.Text,
        memSqlExec1.SelStart, memSqlExec1.SelLength)
  else
    result := memSqlExec1.Lines.Text;
end;

procedure TfrmBafMigration.Init;
var
  LCat: string;
  i, LCount: integer;
  LIni: TCustomIniFile;
begin
  cmbDatabase.Items.Clear;
  LIni := dataMain.Ini;
  LCount := LIni.ReadInteger('DB', 'count', 0);
  for i := 1 to LCount do begin
    LCat := Trim(LIni.ReadString('DB', 'db_' + IntToStr(i), ''));
    if LCat <> '' then
      cmbDatabase.Items.Add(LCat + ' - ' + LIni.ReadString(LCat, 'Name', ''));
  end;
  cmbDatabase.ItemIndex := -1;
  dataMain.GetTables(DC_DEFAULT, lbDataMigration.Items);
  FHasInit := true;
end;

procedure TfrmBafMigration.InitSqlExecButtons;
var
  LCaption: string;
  i: integer;
  LCommandIndex: TDataHistCmdIx;
  LButton: TButton;
begin
  FSqlExecButttonList.Clear;
  for i := 1 to TDataHistSql.GetButtonCount(FDriver) do begin
    if TDataHistSql.GetButton(FDriver, i, LCaption, LCommandIndex) then begin
      LButton := TButton.Create(Self);
      LButton.Parent := pnlSqlExecTools;
      LButton.Width := 105;
      LButton.Height := 26;
      LButton.Position.X := 8;
      LButton.Position.Y := i * 34 + 38;
      LButton.Tag := integer(LCommandIndex);
      LButton.Text := LCaption;
      LButton.OnClick := SqlExecButttonClick;
      FSqlExecButttonList.Add(LButton);
    end;
  end;
//  FInit := true;
end;

procedure TfrmBafMigration.ItemExpanded(Sender: TObject);
begin
//var
//  LParent, LItem, LSubItem: TBafTreeViewItem;
//  LParentData, LData: TCodeItemData;
//  i: integer;
//  LSql: string;
//  LParams: TBafParams;
//  LDataSet: TDataSet;
//
//  procedure lokAddItem;
//  begin
//    LItem := TBafTreeViewItem.Create(tvCode);
//    LItem.Parent := LParent;
//    LData := TCodeItemData.Create(LItem);
//    LData.Inserted := 'U';
//    LData.ID := LDataSet.FieldByName(dataMain.DefaultCon.CommandTableId).AsString;
//    LData.Name := LDataSet.FieldByName('name').AsString;
//    LData.Code := LDataSet.FieldByName('code').AsString;
//    LData.Parent := LDataSet.FieldByName('parent').AsString;
//    LData.Item := LItem;
//    LData.Changed := false;
//    LItem.AddObject(LData);
//    LItem.OnChangeExpanded := ItemExpanded;
//    LSubItem := TBafTreeViewItem.Create(LItem);
//    LSubItem.Parent := LItem;
//    LSubItem.Text := BAF_DUMMYNODE_CAPTION;
//    tvCode.Selected := LItem;
//  end;
//
//  procedure lokLoadData;
//  begin
//    LSql := Format('select * from %s where parent = :k_parent '
//        + 'order by name', [dataMain.DefaultCon.CommandTable]);
//    LParams := dataMain.QueryPrepare(dataMain.DefaultCon, QEN_COMMAND, LSql);
//    LParams.ParamAsString('k_parent', LParentData.ID);
//    LDataSet := dataMain.QueryOpen(dataMain.DefaultCon, QEN_COMMAND);
//
//    if not LDataSet.Eof then begin
//      LParent.RemoveObject(LParent.Items[0]);
//      while not LDataSet.Eof do begin
//        lokAddItem;
//        LDataSet.Next;
//      end;
//    end;
//  end;
//
//begin
//  LParent := (Sender as TBafTreeViewItem);
//  if (LParent.Count = 1)
//      and (LParent.Items[0].Text = BAF_DUMMYNODE_CAPTION) then begin
//    LParentData := nil;
//    for i := 0 to LParent.ChildrenCount - 1 do begin
//      if LParent.Children.Items[i] is TCodeItemData then begin
//        LParentData := LParent.Children.Items[i] as TCodeItemData;
//        Break;
//      end;
//    end;
//
//    if Assigned(LParentData) then
//      lokLoadData;
//  end;
end;

procedure TfrmBafMigration.lbDataMigrationDblClick(Sender: TObject);

  procedure lokColumns;
  var
    LSql, LCols: string;
    LData: TDataset;
    i: integer;
  begin
//    edtDmTableName.Text := lbDataMigration.Items[lbDataMigration.ItemIndex];
    LSql := 'select * from ' + edtDmTableName.Text + ' where 1 = 0';
    dataMain.QueryPrepare(dataMain.MigCon, 'MIG-DataMig',
        memDataMigration.Lines.Text);
    LData := dataMain.QueryOpen(dataMain.MigCon, 'MIG-DataMig');
    for i := 0 to LData.Fields.Count - 1 do
      LCols := LCols + ', ' + AnsiLowerCase(LData.Fields[i].FieldName);
    memDataMigration.Lines.Text := 'select ' + copy(LCols, 3, MaxInt)
      + ' from ' + edtDmTableName.Text;
  end;

begin
  edtDmTableName.Text := lbDataMigration.Items[lbDataMigration.ItemIndex];
  memDataMigration.Lines.Text := 'select * from ' + edtDmTableName.Text;
  edtDmKey.Text := edtDmTableName.Text + '_id';
  sgDataMigration.ClearColumns;
  sgDataMigration.RowCount := 0;
  if cbDmDetailed.IsChecked then begin
    lokColumns;
    btnDmOpenClick(nil);
  end
  else
    btnDmOpenClick(nil);
end;

procedure TfrmBafMigration.LoadCode;
var
  LList: TStringList;
  s, LSql: string;
  LDataSet: TDataSet;
  LData: TCodeItemData;
  LItem, LSubItem: TBafTreeViewItem;
  ix: integer;
  c, t1, t2, t: int64;

  procedure lokData;
  begin
    LData := TCodeItemData.Create(nil);
    LData.Inserted := 'U';
    LData.ID := LDataSet.FieldByName(dataMain.DefaultCon.CommandTableId).AsString;
    LData.Name := LDataSet.FieldByName('name').AsString;
    LData.FNameOld := LDataSet.FieldByName('name').AsString;
    LData.Code := LDataSet.FieldByName('code').AsString;
    LData.FCodeOld := LDataSet.FieldByName('code').AsString;
    LData.Parent := LDataSet.FieldByName('parent').AsString;
    LData.FParentOld := LDataSet.FieldByName('parent').AsString;
    LData.Changed := false;
    LData.FTimestamp := LDataSet.FieldByName('datechg').AsDateTime;
    FNameList.AddObject(LData.Name, LData);
    ix := FParentList.IndexOf(LData.Parent);
    if ix = -1 then begin
      LList := TStringList.Create;
      ix := FParentList.AddObject(LData.Parent, LList);
    end;
    (FParentList.Objects[ix] as TStringList).AddObject(LData.Name, LData);
  end; // procedure lokData

  function lokAddItem(AData: TCodeItemData; AParent: TFmxObject): TBafTreeViewItem;
  begin
    LItem := TBafTreeViewItem.Create(tvCode);
    LItem.Parent := AParent;
    LItem.BafData := AData;
    LItem.Text := AData.Name;
    AData.ItemList.Add(LItem);
    result := LItem;
  end; // procedure lokAddItem

  procedure lokTree(AParent: string; AParentObject: TFmxObject);
  var
    i: integer;
    LList: TStringList;
    LItem: TBafTreeViewItem;
  begin
    ix := FParentList.IndexOf(AParent);
    if ix > -1 then begin
      LList := (FParentList.Objects[ix] as TStringList);
      LList.Sort;
      for i := 0 to LList.Count - 1 do begin
        LData := (LList.Objects[i] as TCodeItemData);
        LItem := lokAddItem(LData, AParentObject);
        lokTree(LData.Id, LItem);
      end;
    end;
  end; // procedure lokTree

begin
  tvCode.Clear;
  FNameList.Clear;
  FParentList.Clear;

  LSql := Format('select * from %s ', [dataMain.DefaultCon.CommandTable]);
  dataMain.QueryPrepare(dataMain.DefaultCon, QEN_COMMAND, LSql);
  LDataSet := dataMain.QueryOpen(dataMain.DefaultCon, QEN_COMMAND);
  while not LDataSet.Eof do begin
    lokData;
    LDataSet.Next;
  end;

  lokTree('', tvCode);
// procedure TfrmBafMigration.LoadCode
end;

procedure TfrmBafMigration.sgCodeDrawColumnCell(Sender: TObject;
  const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
  const Row: Integer; const Value: TValue; const State: TGridDrawStates);
begin
  case Column.Index of
    0: if (sgCode.Cells[0, Row] <> '') and (sgCode.Cells[1, Row] = '') then begin
      Canvas.Fill.Color := TAlphaColorRec.DarkGreen;
      Canvas.FillText(Bounds, Value.ToString, false, 1, [], TTextAlign.Leading);
    end;
    1: if (sgCode.Cells[1, Row] <> '') and (sgCode.Cells[0, Row] = '') then begin
      Canvas.Fill.Color := TAlphaColorRec.DarkRed;
      Canvas.FillText(Bounds, Value.ToString, false, 1, [], TTextAlign.Leading);
    end;
  end;
end;

procedure TfrmBafMigration.SqlExecButttonClick(Sender: TObject);
var
  LCommandIndex: TDataHistCmdIx;
  s: string;
begin
  LCommandIndex := TDataHistCmdIx((Sender as TButton).Tag);
  if not (LCommandIndex in [ciGeneralScript])
      or TfrmBafDialog.DialogYesNow('Script Execution',
        'Do you really want to execute the script?', frmBafMigration) then begin
    memSqlExec2.Lines.Text := TDataHistSql.GetText(DC_MIG, FDriver,
        GetMemo1Text, LCommandIndex, true, cbSqlReplaceColumnNames.IsChecked);
    if cbSqlExpedite.IsChecked then begin
      s := Trim(AnsiLowerCase(copy(memSqlExec2.Lines.Text, 1, 20)));
      if (Pos('drop table', s) = 1) or (Pos('drop  table', s) = 1) then
        TfrmBafDialog.ShowMessage(dataMain.ProgName, 'Drop Operation' + #13#10
            + 'Please Execute manually', Self)
      else
        btnSqlExec1Click(btnSqlExec2);
    end;
  end;
end;

procedure TfrmBafMigration.timProgressTimer(Sender: TObject);
begin
  timProgress.Enabled := false;
  pbDmProgress.Value := 0;
end;

procedure TfrmBafMigration.tvCodeChange(Sender: TObject);
var
  LItem: TBafTreeViewItem;
begin
  LItem := tvCode.BafSelected;
  mvCodeUpdating := true;
  try
    if TfrmBafCode.GetData(LItem, FSelectedData) then begin
      FCodeSource.Text := FSelectedData.Code;
      if cmbDatabase.ItemIndex >= 0 then begin
        FindDest;
        CodeCompare;
      end;
    end
    else begin
      FCodeSource.Clear;
      sgCode.RowCount := 0;
    end;
  finally
    mvCodeUpdating := false;
  end;
end;

end.
