jvbdemove.pas

East make Tray Icon in delphi

        Inc(FRecordCount, FSTable.RecordCount);
      end;
  end;

begin
  CompatTables;
  FSTable := TTable.Create(Self);
  FDTable := TTable.Create(Self);
  FRTable := TTable.Create(Self);
  try
    FSTable.DatabaseName := FSource;
    FDTable.DatabaseName := FDestination;
    FRecordCount := -1;
    if FProgress then
      CalcRecords;
    CreateTmpTable;
    try
      FRTable.Open;
      CompileReferences;
      FDTable.OnPostError := FOnPostError;
      DoMove;
    finally
      FRTable.Close;
      FRTable.DeleteTable;
    end;
  finally
    FSTable.Free;
    FDTable.Free;
    FRTable.Free;
  end;
end;

procedure TJvDBMove.CompileReferences;
var
  I, J: Integer;
  S: string;
  Master, Detail: string;
  FieldRef: TFieldRef;
begin
  FFieldRefs.Clear;
  for I := 0 to FReferences.Count - 1 do
  begin
    S := FReferences[I];
    if CmdString(S) then
    begin
      Detail := SubStr(S, 0, '=');
      Master := SubStr(S, 1, '=');
      if (Detail = '') or (Pos('.', Detail) = 0) or
        (Master = '') or (Pos('.', Master) = 0) then
        raise EJvDBMoveError.CreateRes(@RsEInvalidReferenceDescriptor);
      FieldRef := TFieldRef.Create;
      FieldRef.STableName := Trim(SubStr(Master, 0, '.'));
      FieldRef.SFieldName := Trim(SubStr(Master, 1, '.'));
      FieldRef.DTableName := Trim(SubStr(Detail, 0, '.'));
      FieldRef.DFieldName := Trim(SubStr(Detail, 1, '.'));
      FieldRef.STableIndex := -1;
      FieldRef.STableIndex := -1;
      FieldRef.SFieldIndex := -1;
      FieldRef.DFieldIndex := -1;
      FieldRef.DTFieldIndex := -1;
      FieldRef.MasterRef := True;
      for J := 0 to FFieldRefs.Count - 1 do
        with TFieldRef(FFieldRefs[J]) do
          if Cmp(STableName, FieldRef.STableName) and
            Cmp(SFieldName, FieldRef.SFieldName) then
          begin
            FieldRef.MasterRef := False;
            Break;
          end;
      FFieldRefs.Add(FieldRef);
    end;
  end;
end;

procedure TJvDBMove.DoMove;
type
  TRef = record
    IsRef: Boolean;
    Value: Integer;
    HasRef: Boolean;
  end;
var
  MasterFields: array [0..1023] of TRef; // Max_Columns
  HasMaster, HasDetail: Boolean;
  AllFixups: Boolean;
  I, TableIndex: Integer;
 // Er : Integer;

  procedure UpdateRefList(ATableIndex: Integer);
  var
    I, F: Integer;
  begin
    FillChar(MasterFields, SizeOf(MasterFields), 0);
    for I := 0 to FFieldRefs.Count - 1 do
      with TFieldRef(FFieldRefs[I]) do
      begin
        if Cmp(STableName, ChangeFileExt(FSTable.TableName, '')) then
        begin
          STableIndex := ATableIndex;
          for F := 0 to FSTable.FieldCount - 1 do
            if Cmp(SFieldName, FSTable.Fields[F].FieldName) then
            begin
              SFieldIndex := F;
              DTFieldIndex := FDTable.FieldByName(
                Map(FSTable.TableName, FSTable.Fields[SFieldIndex].FieldName)).Index;
              MasterFields[F].IsRef := True;
              HasMaster := True;
            end;
        end;
        if Cmp(Map(DTableName, ''), ChangeFileExt(FDTable.TableName, '')) then
        begin
          DTableIndex := ATableIndex;
          for F := 0 to FDTable.FieldCount - 1 do
            if Cmp(Map(DTableName, DFieldName), FDTable.Fields[F].FieldName) then
            begin
              DFieldIndex := F;
              MasterFields[F].HasRef := True;
              HasDetail := True;
            end;
        end;
      end;
  end;

  procedure AppendRef(TableIndex: Integer);
  var
    I: Integer;
  begin
    for I := 0 to FFieldRefs.Count - 1 do
      with TFieldRef(FFieldRefs[I]) do
        if MasterRef and (STableIndex = TableIndex) then
        try
          FRTable.AppendRecord([TableIndex + 1, SFieldIndex + 1,
            MasterFields[SFieldIndex].Value,
              FDTable.Fields[DTFieldIndex].AsVariant]);
        except;
        end;
  end;

  function FixupRef(TableIndex: Integer): Boolean;
  var
    I: Integer;
  begin
    for I := 0 to FFieldRefs.Count - 1 do
      with TFieldRef(FFieldRefs[I]) do
        if (DTableIndex = TableIndex) and
          (DFieldIndex <> -1) and
          (FDTable.Fields[DFieldIndex].AsVariant <> Null) then
        begin
         { FDTable.Fields[DFieldIndex].AsVariant :=
            FRTable.Lookup(cTable + ';' + cField + ';' + cOldValue, VarArrayOf([
              STableIndex + 1,
              SFieldIndex + 1,
              FDTable.Fields[DFieldIndex].AsVariant]),
              cNewValue); }
          if FRTable.Locate(cTable + ';' + cField + ';' + cOldValue,
            VarArrayOf([STableIndex + 1, SFieldIndex + 1,
              FDTable.Fields[DFieldIndex].AsVariant]), []) then
            FDTable.Fields[DFieldIndex].AsVariant := FRTable[cNewValue]
          else
          begin
           // record not found, may be in second pass
            AllFixups := False;
            Result := False;
            Inc(FErrorCount);
            Exit;
          end;
        end;
    Result := True;
  end;

  procedure MoveRecord(TableIndex: Integer);
  var
    F: Integer;
    Action: TMoveAction;

    procedure MoveField(FieldIndex: Integer);
    begin
      try
        FDTable.FieldByName(Map(FSTable.TableName,
          FSTable.Fields[FieldIndex].FieldName)).AsVariant :=
          FSTable.Fields[FieldIndex].AsVariant;
      except
        on E: EDBEngineError do
          if E.Errors[0].ErrorCode = DBIERR_BLOBMODIFIED then
          begin
            Inc(FErrorCount);
            Inc(FErrorBlobCount);
          end
          else
            raise;
      end;
    end;

  begin
    FDTable.Append;
    try
      for F := 0 to FSTable.FieldCount - 1 do
        if FDTable.FindField(Map(FSTable.TableName,
          FSTable.Fields[F].FieldName)) <> nil then
        begin
          MoveField(F);
          if MasterFields[F].IsRef then
            MasterFields[F].Value := FSTable.Fields[F].AsInteger;
        end;
      Action := maMove;
      if HasDetail and not FixupRef(TableIndex) then
        Action := maIgnore;
      if (Action = maMove) and Assigned(FOnMoveRecord) then
        FOnMoveRecord(Self, FDTable, Action);
      if HasMaster and (Action in [maMove, maMap]) then
        AppendRef(TableIndex);
      if Action = maMove then
      try
        FDTable.Post
      except
        on E: EAbort do
        begin
          FDTable.Cancel;
          Inc(FErrorCount);
        end;
      end
      else
        FDTable.Cancel;
    except
      on E: EAbort do
        raise
    else
      if FDTable.State = dsInsert then
        FDTable.Cancel;
     // raise;
    end;
  end;

  procedure MoveTable(TableIndex: Integer);
  begin
    FSTable.Close;
    FDTable.Close;
    FSTable.TableName := FTables[TableIndex];
    FDTable.TableName := Map(FTables[TableIndex], '');
    FSTable.Open;
    FDTable.Open;
    UpdateRefList(TableIndex);
    while not FSTable.Eof do
    begin
      try
        Inc(FCurrentRecord);
        MoveRecord(TableIndex);
      except
        //
        raise;
      end;
      FSTable.Next;
    end;
  end;

begin
  FCurrentRecord := 0;
  FErrorCount := 0;
  FErrorBlobCount := 0;
  for I := 0 to FTables.Count - 1 do
    if CmdString(FTables[I]) then
    begin
     { in Tables list one table can be appear more than once,
       but we must use one TableIndex for all appearance }
      TableIndex := FTables.IndexOf(FTables[I]);
     // if (TableIndex = I) or not AllFixups then
      begin
        AllFixups := True;
        MoveTable(TableIndex);
      end;
     { if TableIndex = I then
        Er := FErrorCount else
        FErrorCount := Er; }
    end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.