jvbdemove.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvDBMove.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s):

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
  database batchmove

History:
  1.23 - added suport for table names with extensions;

 Note: All referenced fields MUST be Integer

 Example :
  Source = dbChildCompany
  Destination = dbCompany
  Tables = (
    Employee
    Children
  );
  References = (
    Children.Employee = Employee.Uni
  );
  TempTable = '_RATMP1_.DB';
  BeforePost = user defined unique generation procedure;

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvBDEMove.pas,v 1.15 2005/02/17 10:19:59 marquardt Exp $

unit JvBDEMove;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Classes, DB, DBTables,
  JvComponent;

type
  TJvDBMove = class;
  TMoveAction = (maMove, maMap, maIgnore);

  TMoveEvent = procedure(Sender: TJvDBMove; Table: TTable; var Action: TMoveAction) of object;

  TJvDBMove = class(TJvComponent)
  private
    FSource: string;
    FDestination: string;
    FSTable: TTable;
    FDTable: TTable;
    FTempTable: string;
    FRTable: TTable; { temporary table }
    FTables: TStringList;
    FReferences: TStringList;
    FMappings: TStringList;
    FFieldRefs: TList;

    FProgress: Boolean;
    FRecordCount: Integer;
    FCurrentRecord: Integer;
    FErrorCount: Integer;
    FErrorBlobCount: Integer;
    FMaxPass: Integer;

    FOnMoveRecord: TMoveEvent;
    FOnPostError: TDataSetErrorEvent;

    procedure DoMove;
    function GetTables: TStrings;
    function GetReferences: TStrings;
    function GetMappings: TStrings;
    procedure SetTables(Value: TStrings);
    procedure SetReferences(Value: TStrings);
    procedure SetMappings(Value: TStrings);
    procedure CreateTmpTable;
    procedure CompileReferences;
    function Map(const TableName, FieldName: string): string;
    procedure CompatTables;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Execute;
    property RecordCount: Integer read FRecordCount;
    property CurrentRecord: Integer read FCurrentRecord;
    property ErrorCount: Integer read FErrorCount;
    property ErrorBlobCount: Integer read FErrorBlobCount;
  published
    property Source: string read FSource write FSource;
    property Destination: string read FDestination write FDestination;
    property Tables: TStrings read GetTables write SetTables;
    property TempTable: string read FTempTable write FTempTable;
    property References: TStrings read GetReferences write SetReferences;
    property Mappings: TStrings read GetMappings write SetMappings;
    property OnMoveRecord: TMoveEvent read FOnMoveRecord write FOnMoveRecord;
    property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
    property Progress: Boolean read FProgress write FProgress default False;
  end;

  EJvDBMoveError = class(EDatabaseError);

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvBDEMove.pas,v $';
    Revision: '$Revision: 1.15 $';
    Date: '$Date: 2005/02/17 10:19:59 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  SysUtils, BDE,
  JvBDEUtils, JvResources;

const
  cTable = 'Table';
  cField = 'Field';
  cOldValue = 'OldValue';
  cNewValue = 'NewValue';

type
  TFieldRef = class(TObject)
  private
    STableName: string;
    SFieldName: string;
    STableIndex: Integer;
    SFieldIndex: Integer;
    DTFieldIndex: Integer;
    MasterRef: Boolean;
    DTableName: string;
    DFieldName: string;
    DTableIndex: Integer;
    DFieldIndex: Integer;
  end;

function CmdString(S: string): Boolean;
begin
  S := Trim(S);
  Result := (S <> '') and (S[1] <> ';');
end;

constructor TJvDBMove.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTables := TStringList.Create;
  FReferences := TStringList.Create;
  FMappings := TStringList.Create;
  FFieldRefs := TList.Create;
  FTempTable := '_RATMP1_';
  FMaxPass := 1;
end;

destructor TJvDBMove.Destroy;
begin
  FTables.Free;
  FReferences.Free;
  FMappings.Free;
  FFieldRefs.Free;
  inherited Destroy;
end;

function TJvDBMove.GetTables: TStrings;
begin
  Result := FTables;
end;

procedure TJvDBMove.SetTables(Value: TStrings);
begin
  FTables.Assign(Value);
  CompatTables;
end;

procedure TJvDBMove.CompatTables;
var
  I: Integer;
begin
  { make compatible with previous version of TJvDBMove }
  for I := 0 to FTables.Count - 1 do
    if FTables[I] <> '' then
      FTables[I] := Trim(SubStr(FTables[I], 0, '='));
end;

function TJvDBMove.GetReferences: TStrings;
begin
  Result := FReferences;
end;

procedure TJvDBMove.SetReferences(Value: TStrings);
begin
  FReferences.Assign(Value);
end;

function TJvDBMove.GetMappings: TStrings;
begin
  Result := FMappings;
end;

procedure TJvDBMove.SetMappings(Value: TStrings);
begin
  FMappings.Assign(Value);
end;

function TJvDBMove.Map(const TableName, FieldName: string): string;
begin
  if FieldName = '' then
  begin
    Result := FMappings.Values[TableName];
    if Result = '' then
      Result := TableName;
  end
  else
  begin
    Result := SubStrEnd(FMappings.Values[ChangeFileExt(TableName, '') +
      '.' + FieldName], 0, '.');
    if Result = '' then
      Result := FieldName;
  end;
end;

procedure TJvDBMove.CreateTmpTable;
begin
  with FRTable do
  begin
    Active := False; { The Table component must not be active }
    { First, describe the type of table and give it a name }
    DatabaseName := FDestination;
    TableType := ttDefault;
    TableName := FTempTable;
    { Next, describe the fields in the table }
    with FieldDefs do
    begin
      Clear;
      Add(cTable, ftInteger, 0, True);
      Add(cField, ftInteger, 0, True);
      Add(cOldValue, ftInteger, 0, True);
      Add(cNewValue, ftInteger, 0, True);
    end;
    { Next, describe any indexes }
{    with IndexDefs do
    begin
      Clear;
      Add('', cTable + ';' + cField + ';' + cOldValue, [ixPrimary, ixUnique]);
    end;
   }{ Now that we have specified what we want, create the table }
    CreateTable;
  end;
end;

procedure TJvDBMove.Execute;

  procedure CalcRecords;
  var
    I: Integer;
  begin
    FRecordCount := 0;
    FCurrentRecord := 0;
    for I := 0 to FTables.Count - 1 do
      if CmdString(FTables[I]) then
      begin
        FSTable.Close;
        FSTable.TableName := FTables[I];
        FSTable.Open;