Fast TJvMemoryData loader

unit DBLoader;

interface
uses
  SysUtils, Classes, Variants, DB, ADODB, JvMemoryDataset;

(***
 * TJvMemoryDataLoader - класс для ускоренной загрузки данных из ADODataSet в
 * JvMemoryData. Для использования необходимо создать экземпляр класса и вызвать
 * метод FastLoad, передав в него исходный ADO набор данных, целевой MemoryData
 * и строку правил для переноса полей.
 * Формат строки:
 *   <правило>[;<правило>][;<правило>]...
 *   Правило представляет собой:
 *     <целевой поле> = <поле источник>[:<модификатор>][:<модификатор>]...
 *
 *   Целевые поля должны быть полностью определены в структуре FieldDefs.
 *   (НЕ ВСЕ ТИПЫ ПОЛЕЙ, ПОДДЕРЖИВАЕМЫЕ JvMemoryData, поддерживаются классом!)
 *   Модификаторы позволяют выполнить неложные преобразования полей. Вы можете
 *   указывать их в любом порядке, но выполняться они будут исключительно в том,
 *   в котором определены в реализации класса.
 *   Для строковых полей (включая memo) определены модификаторы:
 *     trim - удаление лидирующих и завершающих пробелов
 *     upper - в верхний регистр
 *     lower - в нижний регистр
 *   Для вещественных:
 *     abs - взятие модуля
 *     round - отбрасывание дробной части
 *   Для целочисленных (но не для Int64):
 *     abs
 *   Для логических:
 *     not - инверсия значения
 *
 * Для более сложных преобразований и формирования значений, которые нельзя
 * получить из запроса существует два события: OnSetup и OnRowCopy.
 * В OnSetup вы должны, при помощи метода GetFieldIndex, получить цифровые
 * идентификаторы полей и в дальнейшем использовать только их при обращении к
 * полям.
 * Событие OnRowCopy происходит при копировании каждой строки. В событие
 * передаются параметры DestHasData и Dest.
 * Первый представляет собой массив Boolean, в который необходимо установить
 * True для заполняемых полей. (Издержки низкоуровневой обработки).
 * Второй массив ссылочных элементов, представляющих содержимое полей. Т.е. для
 * полей типа ftString, ftMemo, ftFixedChar значением будет PString, для
 * ftWideString, ftWideMemo - PWideString, для ftInteger - PInteger и т.д.
 * Подробнее - необходимо сверятся по исходникам. (Опять же - издержки
 * низкоуровневой обработки.)
 * На момент этого события поля по автоматическим правилам в Dest уже заполнены
 * и преобразованы модификаторами. Однако, для скорости значения неиспользуемых
 * полей не очищаются и необходимо самостоятельно проверять их по значению в
 * DestHasData перед использованием.
 *
 * После загрузки JvMemoryData устанавливается на первую запись. Не стоит делать
 * предположений о состоянии ADODataSet.
 *
 * Общие рекомендации по ускорению загрузки:
 *  1. Отбирайте в ADODataSet только необходимые поля. Чем меньше полей - тем
 *     быстрее загрузка.
 *  2. Если в результирующем JvMemoryData нет вычислимых или lookup-полей - не
 *     ленитесь отключать свойство AutoCalcFields. (Помогает выиграть ещё до 10%
 *     скорости.) Не пытайтесь схитрить и отключить это свойство перед
 *     загрузкой, чтобы включить после. JvMemoryData устроен так, что подобное
 *     переключение не даст эффекта - поля останутся не вычисленными.
 *
 * P.S. Не надо хранить строки в поле типа ftVariant. В jvMemoryData ошибка,
 * приводящая к утечке памяти.
 *)

{$I jvcl.inc}

type
  PFieldCopyRule = ^TFieldCopyRule;
  TFieldCopyRule = record
    SrcField,
    DstField: Integer;
  end;

  TLoaderFieldModifier = (lfmStrTrim, lfmStrUpper, lfmStrLower, lfmOrdAbs,
    lfmFloatRound, lfmBoolNot);
  TLoaderModifiersSet = set of TLoaderFieldModifier;

  TLoaderDataMark = array of Boolean;
  TLoaderCopyBuffer = array of Pointer;

  TJvMemoryDataLoader = class;
  TLoaderSetupEvent = procedure(Sender: TJvMemoryDataLoader;
    Src: TCustomADODataSet; Dest: TJvMemoryData) of object;
  TLoaderRowCopyEvent = procedure(Sender: TJvMemoryDataLoader;
    const Src: TCustomADODataSet; const Dest: TLoaderCopyBuffer;
    const DestHasData: TLoaderDataMark; CurrentRow, RowCount: Integer) of object;

  TJvMemoryDataLoader = class
  private
    FOnSetup: TLoaderSetupEvent;
    FOnRowCopy: TLoaderRowCopyEvent;
    function CalcFieldLen(FieldType: TFieldType; Size: Word): Integer;
    function CreateTemplate(FieldType: TFieldType): Pointer;
    procedure AdjustBuffer(NewSize: Integer);
  protected
    FMemData: TJvMemoryData;
    FAdoData: TCustomADODataSet;
    FBuffer: PJvMemBuffer;
    FFieldModifiers: array of TLoaderModifiersSet;
    FFieldTypes: array of TFieldType;
    FCopyRules: array of PFieldCopyRule;
    FCopyBuffer: TLoaderCopyBuffer;
    FFieldSizes,
    FOffsets,
    FBlobIndexes: array of Integer;
    FNotNull: TLoaderDataMark;
    FRow,
    FRowsCount,
    FBookmarkOfs,
    FBlobOfs,
    FRecordSize,
    FRecBufSize,
    FActualBufSize,
    FBlobFieldCount: Integer;
    {$IFDEF ADODIRECT}
    FRecordSet: Variant;
    {$ENDIF}
    procedure SetMemData(Value: TJvMemoryData); virtual;
    procedure CalcSizes; virtual;
    procedure InitBuffers; virtual;
    procedure CleanupBuffers; virtual;
    function GetModifier(ModName: String): TLoaderFieldModifier;
    procedure ParseRules(Rules: String);
    procedure ValidateModifiers;
    procedure CopyRuleData;
    procedure CopyDataToMemoryData;
  public
    class function GetFieldIndex(const DataSet: TDataSet; FieldName: String):
      Integer;
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Clear;
    procedure FastLoad(Source: TCustomADODataSet; Destination: TJvMemoryData;
      Rules: String; fClearTable: Boolean = True);
    function DateTimeToInternalDate(Value: TDateTime): Longint;
    function DateTimeToInternalTime(Value: TDateTime): Longint;
    function DateTimeToInternalDateTime(Value: TDateTime): TDateTime;
    property OnSetup: TLoaderSetupEvent read FOnSetup write FOnSetup;
    property OnRowCopy: TLoaderRowCopyEvent read FOnRowCopy write FOnRowCopy;
  end;

implementation
uses
  Math;

type
  { !! Depended of TJvMemoryData implementation !! }
  TCopyOfBookmarkData = Integer;
  TCopyOfMemBookmarkInfo = record
    BookmarkData: TCopyOfBookmarkData;
    BookmarkFlag: TBookmarkFlag;
  end;

const
  { !! Depended of TJvMemoryData implementation !! }
  BOOKMARK_INTERNAL_SIZE = SizeOf(TCopyOfMemBookmarkInfo);

  GUID_SIZE = 38;

  ftBlobTypes = [{ftBlob,} ftMemo
    {$IFDEF COMPILER10_UP}, ftWideMemo{$ENDIF COMPILER10_UP}];

  ftSupported = [ftString, ftSmallint, ftInteger, ftWord, ftBoolean,
    ftFloat, ftCurrency, ftDate, ftTime, ftDateTime, ftAutoInc, ftTimestamp,
    {$IFDEF COMPILER10_UP}
    ftFixedWideChar,
    {$ENDIF COMPILER10_UP}
    {$IFDEF COMPILER12_UP}
    ftLongWord, ftShortint, ftByte, ftExtended,
    {$ENDIF COMPILER12_UP}
    ftFixedChar, ftWideString, ftLargeint, ftVariant, ftGuid] + ftBlobTypes;

type
  THackMemoryData = class(TJvMemoryData)
  public
    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
    function GetActiveRecBuf(var RecBuf: PJvMemBuffer): Boolean; override;
    procedure CalculateFields(Buffer: PChar); override;
    property CalcFieldsSize;
  end;

{ TJvMemoryDataLoader }

constructor TJvMemoryDataLoader.Create;
begin
  FActualBufSize := 0;
  FBuffer := nil;
  Initialize(FCopyBuffer);
  Initialize(FCopyRules);
  Clear;
end;

destructor TJvMemoryDataLoader.Destroy;
begin
  Clear;

  Finalize(FCopyRules);
  Finalize(FCopyBuffer);
  inherited;
end;

function TJvMemoryDataLoader.CalcFieldLen(FieldType: TFieldType;
  Size: Word): Integer;
begin
  if not (FieldType in ftSupported) then
    Result := 0
  else
  if (FieldType in ftBlobTypes) then
    begin
      Result := 0;
    end                       else
    begin
      Result := Size;
      case FieldType of
        ftString:
          Inc(Result);
        ftSmallint:
          Result := SizeOf(Smallint);
        ftInteger:
          Result := SizeOf(Longint);
        ftWord:
          Result := SizeOf(Word);
        ftBoolean:
          Result := SizeOf(Wordbool);
        ftFloat:
          Result := SizeOf(Double);
        ftCurrency:
          Result := SizeOf(Double);
        ftDate, ftTime:
          Result := SizeOf(Longint);
        ftDateTime:
          Result := SizeOf(TDateTime);
        ftAutoInc:
          Result := SizeOf(Longint);
        ftFixedChar:
          Inc(Result);
        ftWideString:
          Result := (Result+1)*SizeOf(WideChar);
        ftLargeint:
          Result := SizeOf(Int64);
        ftVariant:
          Result := SizeOf(Variant);
        ftGuid:
          Result := GUID_SIZE+1;
        else
          raise Exception.Create('');
      end;
    end;
end;

function TJvMemoryDataLoader.CreateTemplate(FieldType: TFieldType): Pointer;
begin
  if not (FieldType in ftSupported) then
    begin
    Result := nil;
    end                             else
    begin
      case FieldType of
        ftString, ftFixedChar, ftMemo, ftGuid:
          begin
            New(PString(Result));
            Initialize(PString(Result)^);
          end;
        ftSmallint:
          New(PSmallInt(Result));
        ftInteger:
          New(PInteger(Result));
        ftWord:
          New(PWord(Result));
        ftBoolean:
          New(PWordbool(Result));
        ftFloat, ftCurrency:
          New(PDouble(Result));
        ftDate, ftTime:
          New(PLongint(Result));
        ftDateTime:
          New(PDateTime(Result));
        ftAutoInc:
          New(PLongint(Result));
        ftWideString, ftWideMemo:
          begin
            New(PWideString(Result));
            Initialize(PWideString(Result)^);
          end;
        ftLargeint:
          New(PInt64(Result));
        ftVariant:
          begin
            New(PVariant(Result));
            PVariant(Result)^ := Unassigned;
          end
        else
          raise Exception.Create('');
      end;
    end;
end;

procedure TJvMemoryDataLoader.CalcSizes;
var
  i: Integer;
begin
  FBlobFieldCount := 0;
  SetLength(FFieldModifiers, FMemData.FieldDefs.Count);
  SetLength(FFieldTypes, FMemData.FieldDefs.Count);
  SetLength(FOffsets, FMemData.FieldDefs.Count);
  SetLength(FFieldSizes, FMemData.FieldDefs.Count);
  SetLength(FCopyBuffer, FMemData.FieldDefs.Count);
  SetLength(FBlobIndexes, FMemData.FieldDefs.Count);
  SetLength(FNotNull, FMemData.FieldDefs.Count);
  for i := Low(FFieldModifiers) to High(FFieldModifiers) do FFieldModifiers[i] := [];
  FillChar(FOffsets[0], SizeOf(Integer)*Length(FOffsets), 0);
  FillChar(FFieldSizes[0], SizeOf(Integer)*Length(FFieldSizes), 0);
  FillChar(FCopyBuffer[0], SizeOf(Pointer)*Length(FCopyBuffer), 0);
  for i := Low(FBlobIndexes) to High(FBlobIndexes) do FBlobIndexes[i] := -1;
  FRecordSize := 1;
  for i:= 0 to (FMemData.FieldDefs.Count-1) do
    if (FMemData.FieldDefs[i].DataType in ftSupported) then
      begin
        FOffsets[i] := FRecordSize;
        try
          FFieldTypes[i] := FMemData.FieldDefs[i].DataType;
          FFieldSizes[i] := CalcFieldLen(FFieldTypes[i], FMemData.FieldDefs[i].Size);

          FCopyBuffer[i] := CreateTemplate(FFieldTypes[i]);
          if (FFieldTypes[i] in ftBlobTypes) then
            begin
              FBlobIndexes[i] := FBlobFieldCount;
              Inc(FBlobFieldCount);
            end;
        except
          raise Exception.Create('TJvMemoryDataLoader unable to load data, unsupported field type for field: '+FMemData.FieldDefs[i].Name+'.');
        end;
        if (FMemData.FieldDefs[i].ChildDefs.Count > 0) then
          raise Exception.Create('TJvMemoryDataLoader is not support child fields for field: '+FMemData.FieldDefs[i].Name+'.');

        if (FFieldSizes[i] > 0) then
          begin
            FRecordSize := FRecordSize+FFieldSizes[i]+1;
          end                   else
          begin
            FOffsets[i] := -1;
          end;
      end;
  Dec(FRecordSize);

  FBookmarkOfs := FRecordSize+THackMemoryData(FMemData).CalcFieldsSize;
  FBlobOfs := FBookmarkOfs+BOOKMARK_INTERNAL_SIZE;
  FRecBufSize := FBlobOfs+FBlobFieldCount*SizeOf(Pointer);
end;

procedure TJvMemoryDataLoader.AdjustBuffer(NewSize: Integer);
begin
  if (NewSize > FActualBufSize) then
    begin
      if Assigned(FBuffer) then
        ReallocMem(FBuffer, NewSize)
      else
        GetMem(FBuffer, NewSize);

      FActualBufSize := NewSize;
    end;
end;

procedure TJvMemoryDataLoader.InitBuffers;
begin
  AdjustBuffer(FRecBufSize);
  FillChar(FBuffer^, FActualBufSize, 0);
  if (FBlobFieldCount > 0) then
    Initialize(PMemBlobArray(NativeInt(FBuffer)+FBlobOfs)^[0], FBlobFieldCount);
end;

procedure TJvMemoryDataLoader.CleanupBuffers;
var
  i: Integer;
begin
  FillChar(FBuffer^, FBlobOfs, 0);

  for i := 0 to (FBlobFieldCount-1) do
    begin
      PMemBlobArray(NativeInt(FBuffer)+FBlobOfs)^[i] := '';
    end;
  FillChar(FNotNull[0], Length(FNotNull)*SizeOf(Boolean), 0);
end;

class function TJvMemoryDataLoader.GetFieldIndex(const DataSet: TDataSet;
  FieldName: String): Integer;
begin
  Result := DataSet.FieldByName(FieldName).Index;
end;

function TJvMemoryDataLoader.GetModifier(ModName: String): TLoaderFieldModifier;
begin
  ModName := AnsiLowerCase(ModName);
  if (ModName = 'trim') then
    begin
      Result := lfmStrTrim;
    end
  else if (ModName = 'upper') then
    begin
      Result := lfmStrUpper;
    end
  else if (ModName = 'lower') then
    begin
      Result := lfmStrLower;
    end
  else if (ModName = 'abs') then
    begin
      Result := lfmOrdAbs;
    end
  else if (ModName = 'round') then
    begin
      Result := lfmFloatRound;
    end
  else if (ModName = 'not') then
    begin
      Result := lfmBoolNot;
    end
  else
    begin
      raise Exception.Create('FastLoad: Unknown field modifier type: '+ModName);
    end;
end;

procedure TJvMemoryDataLoader.ParseRules(Rules: String);
var
  Modifiers: TLoaderModifiersSet;
  NewCopyRule: PFieldCopyRule;
  Rule, SrcFieldMods, SrcFieldName, DstFieldName: String;
  cIdx, eIdx, mIdx: Integer;
begin
  if (Rules = '') then
    Exit;

  repeat
    cIdx := Pos(';', Rules);
    if (cIdx > 0) then
      begin
        Rule := Copy(Rules, 1, cIdx-1);
        Delete(Rules, 1, cIdx);
      end         else
      begin
        Rule := Rules;
      end;

    eIdx := Pos('=', Rule);
    if (eIdx > 0) then
      begin
        Modifiers := [];
        SrcFieldName := '';
        DstFieldName := Trim(Copy(Rule, 1, eIdx-1));
        SrcFieldMods := Trim(Copy(Rule, eIdx+1, Length(Rule)-eIdx));
        repeat
          mIdx := Pos(':', SrcFieldMods);

          if (SrcFieldName = '') then
            begin
              SrcFieldName := Trim(Copy(SrcFieldMods, 1, mIdx-1));
            end                  else
            begin
              if (mIdx > 0) then
                Modifiers := Modifiers+[GetModifier(Trim(Copy(SrcFieldMods, 1, mIdx-1)))]
              else
                Modifiers := Modifiers+[GetModifier(Trim(SrcFieldMods))];
            end;
          SrcFieldMods := Trim(Copy(SrcFieldMods, mIdx+1, Length(SrcFieldMods)-mIdx));
        until (mIdx = 0);

        if (SrcFieldName = '') then
          SrcFieldName := SrcFieldMods;

        New(NewCopyRule);
        NewCopyRule^.SrcField := GetFieldIndex(FAdoData, SrcFieldName);
        NewCopyRule^.DstField := GetFieldIndex(FMemData, DstFieldName);
        FFieldModifiers[NewCopyRule^.DstField] := Modifiers;
        SetLength(FCopyRules, Length(FCopyRules)+1);
        FCopyRules[High(FCopyRules)] := NewCopyRule;
      end         else
      begin
        raise Exception.Create('FastLoad: Invalid rules format.');
      end;
  until (cIdx = 0);
end;

procedure TJvMemoryDataLoader.SetMemData(Value: TJvMemoryData);
begin
  if (Value.FieldDefs.Count = 0) then
    raise Exception.Create('TJvMemoryDataLoader required predefined fields for loading.');

  FMemData := Value;
  CalcSizes;
  InitBuffers;
end;

procedure TJvMemoryDataLoader.Clear;
var
  i: Integer;
begin
  if Assigned(FBuffer) then
    begin
      if (FBlobFieldCount > 0) then
        Finalize(PMemBlobArray(NativeInt(FBuffer)+FBlobOfs)^[0], FBlobFieldCount);

      FreeMem(FBuffer);
      FBuffer := nil;
      FActualBufSize := 0;
    end;

  if (Length(FCopyBuffer) > 0) then
    begin
      for i := Low(FCopyBuffer) to High(FCopyBuffer) do
        if Assigned(FCopyBuffer[i]) then
          begin
            case FFieldTypes[i] of
              ftString, ftFixedChar, ftMemo:
                begin
                  Finalize(PString(FCopyBuffer[i])^);
                end;
              ftWideString, ftWideMemo:
                begin
                  Finalize(PWideString(FCopyBuffer[i])^);
                end;
              ftVariant:
                begin
                  PVariant(FCopyBuffer[i])^ := Unassigned;
                end;
            end;
            Dispose(FCopyBuffer[i]);
          end;

      SetLength(FCopyBuffer, 0);
    end;

  if (Length(FCopyRules) > 0) then
    begin
      for i := Low(FCopyRules) to High(FCopyRules) do
        if Assigned(FCopyRules[i]) then
          Dispose(FCopyRules[i]);

      SetLength(FCopyRules, 0);
    end;

  SetLength(FFieldTypes, 0);
end;

procedure TJvMemoryDataLoader.ValidateModifiers;
var
  i: Integer;

  procedure InvalidModifier(DstField: Integer);
  begin
    raise Exception.Create('FastLoad: Unsupported modifier type for field: '+
      FMemData.Fields[DstField].FieldName);
  end;
begin
  for i := Low(FFieldModifiers) to High(FFieldModifiers) do
    case FFieldTypes[i] of
      ftSmallint, ftInteger, ftWord, ftAutoInc, ftLargeint:
        if ((FFieldModifiers[i]-[lfmOrdAbs]) <> []) then
          begin
            InvalidModifier(i);
          end;
      ftFloat, ftCurrency:
        if ((FFieldModifiers[i]-[lfmOrdAbs, lfmFloatRound]) <> []) then
          begin
            InvalidModifier(i);
          end;
      ftFixedChar, ftString, ftMemo, ftWideString, ftWideMemo:
        if ((FFieldModifiers[i]-[lfmStrTrim, lfmStrLower, lfmStrLower]) <> []) then
          begin
            InvalidModifier(i);
          end;
      ftBoolean:
        if ((FFieldModifiers[i]-[lfmBoolNot]) <> []) then
          begin
            InvalidModifier(i);
          end;
      ftDate, ftTime, ftDateTime, ftVariant, ftGuid:
        if (FFieldModifiers[i] <> []) then
          begin
            InvalidModifier(i);
          end;
      else
        begin
          raise Exception.Create('FastLoad: FIXME: Need to add type of field '+
            FMemData.Fields[i].FieldName+' for modifier checking.');
        end;
    end;
end;

procedure TJvMemoryDataLoader.CopyRuleData;
var
  i, SrcField, DstField: Integer;
  {$IFDEF ADODIRECT}
  Guid: String;
  {$ENDIF}

  function HandleStrMod(AStr: String; DstField: Integer): String;
  begin
    Result := AStr;

    if (lfmStrTrim in FFieldModifiers[DstField]) then
      Result := Trim(Result);

    if (lfmStrUpper in FFieldModifiers[DstField]) then
      Result := AnsiUpperCase(Result);

    if (lfmStrLower in FFieldModifiers[DstField]) then
      Result := AnsiLowerCase(Result);
  end;
  function HandleWideStrMod(AWideStr: WideString; DstField: Integer): WideString;
  begin
    Result := AWideStr;

    if (lfmStrTrim in FFieldModifiers[DstField]) then
      Result := Trim(Result);

    if (lfmStrUpper in FFieldModifiers[DstField]) then
      Result := WideUpperCase(Result);

    if (lfmStrLower in FFieldModifiers[DstField]) then
      Result := WideLowerCase(Result);
  end;
  function HandleIntMod(AInt: Integer; DstField: Integer): Integer;
  begin
    Result := AInt;

    if (lfmOrdAbs in FFieldModifiers[DstField]) then
      Result := Abs(Result);
  end;
  function HandleInt64Mod(AInt: Int64; DstField: Integer): Int64;
  begin
    Result := AInt;

    if (lfmOrdAbs in FFieldModifiers[DstField]) then
      Result := Abs(Result);
  end;
  function HandleFloatMod(AFloat: Double; DstField: Integer): Double;
  begin
    Result := AFloat;

    if (lfmOrdAbs in FFieldModifiers[DstField]) then
      Result := Abs(Result);

    if (lfmFloatRound in FFieldModifiers[DstField]) then
      Result := Round(Result);
  end;
  function HandleBoolMod(ABool: WordBool; DstField: Integer): WordBool;
  begin
    Result := ABool;

    if (lfmBoolNot in FFieldModifiers[DstField]) then
      Result := not(Result);
  end;
begin
  for i := Low(FCopyRules) to High(FCopyRules) do
    begin
      SrcField := PFieldCopyRule(FCopyRules[i])^.SrcField;
      DstField := PFieldCopyRule(FCopyRules[i])^.DstField;

      {$IFDEF ADODIRECT}
      FNotNull[DstField] := not(VarIsNull(FRecordSet.Fields[SrcField].Value));
      {$ELSE}
      FNotNull[DstField] := not(FAdoData.Fields[SrcField].IsNull);
      {$ENDIF}

      if FNotNull[DstField] then
        case FFieldTypes[DstField] of
          ftString, ftFixedChar, ftMemo:
            {$IFDEF ADODIRECT}
            PString(FCopyBuffer[DstField])^ := HandleStrMod(FRecordSet.Fields[SrcField].Value, DstField);
            {$ELSE}
            PString(FCopyBuffer[DstField])^ := HandleStrMod(FAdoData.Fields[SrcField].AsString, DstField);
            {$ENDIF}
          ftWideString, ftWideMemo:
            {$IFDEF ADODIRECT}
            PWideString(FCopyBuffer[DstField])^ := HandleWideStrMod(FRecordSet.Fields[SrcField].Value, DstField);
            {$ELSE}
            PWideString(FCopyBuffer[DstField])^ := HandleWideStrMod(FAdoData.Fields[SrcField].AsWideString, DstField);
            {$ENDIF}
          ftSmallint:
            {$IFDEF ADODIRECT}
            PSmallInt(FCopyBuffer[DstField])^ := HandleIntMod(FRecordSet.Fields[SrcField].Value, DstField);
            {$ELSE}
            PSmallInt(FCopyBuffer[DstField])^ := HandleIntMod(FAdoData.Fields[SrcField].AsInteger, DstField);
            {$ENDIF}
          ftInteger:
            {$IFDEF ADODIRECT}
            PInteger(FCopyBuffer[DstField])^ := HandleIntMod(FRecordSet.Fields[SrcField].Value, DstField);
            {$ELSE}
            PInteger(FCopyBuffer[DstField])^ := HandleIntMod(FAdoData.Fields[SrcField].AsInteger, DstField);
            {$ENDIF}
          ftWord:
            {$IFDEF ADODIRECT}
            PWord(FCopyBuffer[DstField])^ := HandleIntMod(FRecordSet.Fields[SrcField].Value, DstField);
            {$ELSE}
            PWord(FCopyBuffer[DstField])^ := HandleIntMod(FAdoData.Fields[SrcField].AsInteger, DstField);
            {$ENDIF}
          ftBoolean:
            {$IFDEF ADODIRECT}
            PWordbool(FCopyBuffer[DstField])^ := HandleBoolMod(FRecordSet.Fields[SrcField].Value, DstField);
            {$ELSE}
            if (FAdoData.Fields[SrcField].DataType = ftBoolean) then
              PWordbool(FCopyBuffer[DstField])^ := HandleBoolMod(FAdoData.Fields[SrcField].AsBoolean, DstField)
            else
              PWordbool(FCopyBuffer[DstField])^ := HandleBoolMod((FAdoData.Fields[SrcField].AsInteger <> 0), DstField);
            {$ENDIF}
          ftFloat, ftCurrency:
            {$IFDEF ADODIRECT}
            PDouble(FCopyBuffer[DstField])^ := HandleFloatMod(FRecordSet.Fields[SrcField].Value, DstField);
            {$ELSE}
            PDouble(FCopyBuffer[DstField])^ := HandleFloatMod(FAdoData.Fields[SrcField].AsFloat, DstField);
            {$ENDIF}
          ftDate:
            {$IFDEF ADODIRECT}
            PLongint(FCopyBuffer[DstField])^ := DateTimeToInternalDate(FRecordSet.Fields[SrcField].Value);
            {$ELSE}
            PLongint(FCopyBuffer[DstField])^ := DateTimeToInternalDate(FAdoData.Fields[SrcField].AsDateTime);
            {$ENDIF}
          ftTime:
            {$IFDEF ADODIRECT}
            PLongint(FCopyBuffer[DstField])^ := DateTimeToInternalTime(FRecordSet.Fields[SrcField].Value);
            {$ELSE}
            PLongint(FCopyBuffer[DstField])^ := DateTimeToInternalTime(FAdoData.Fields[SrcField].AsDateTime);
            {$ENDIF}
          ftDateTime:
            {$IFDEF ADODIRECT}
            PDateTime(FCopyBuffer[DstField])^ := DateTimeToInternalDateTime(FRecordSet.Fields[SrcField].Value);
            {$ELSE}
            PDateTime(FCopyBuffer[DstField])^ := DateTimeToInternalDateTime(FAdoData.Fields[SrcField].AsDateTime);
            {$ENDIF}
          ftAutoInc:
            {$IFDEF ADODIRECT}
            PLongint(FCopyBuffer[DstField])^ := HandleIntMod(FRecordSet.Fields[SrcField].Value, DstField);
            {$ELSE}
            PLongint(FCopyBuffer[DstField])^ := HandleIntMod(FAdoData.Fields[SrcField].AsInteger, DstField);
            {$ENDIF}
          ftLargeint:
            try
              {$IFDEF ADODIRECT}
              PInt64(FCopyBuffer[DstField])^ := HandleInt64Mod(VarAsType(FRecordSet.Fields[SrcField].Value, varInt64), DstField);
              {$ELSE}
              PInt64(FCopyBuffer[DstField])^ := HandleInt64Mod(VarAsType((FAdoData.Fields[SrcField] as TLargeintField).Value, varInt64), DstField);
              {$ENDIF}
            except
              PInt64(FCopyBuffer[DstField])^ := 0;
            end;
          ftGuid: //not tested
            begin
              SetLength(PString(FCopyBuffer[DstField])^, GUID_SIZE);
              FillChar(PString(FCopyBuffer[DstField])^, GUID_SIZE, #0);
              {$IFDEF ADODIRECT}
              Guid := VarToStr(FRecordSet.Fields[SrcField].Value);
              Move(Guid[1], PString(FCopyBuffer[DstField])^[1],  Max(Length(Guid), GUID_SIZE));
              {$ELSE}
              Move(FAdoData.Fields[SrcField].AsString[1], PString(FCopyBuffer[DstField])^[1],
                 Max(Length(FAdoData.Fields[SrcField].AsString), GUID_SIZE));
              {$ENDIF}
            end;
          ftVariant:
            {$IFDEF ADODIRECT}
            PVariant(FCopyBuffer[DstField])^ := FRecordSet.Fields[SrcField].Value;
            {$ELSE}
            PVariant(FCopyBuffer[DstField])^ := FAdoData.Fields[SrcField].Value;
            {$ENDIF}
        end;
    end;
end;

procedure TJvMemoryDataLoader.CopyDataToMemoryData;
var
  i: Integer;
begin
  for i := 0 to High(FCopyBuffer) do
    if FNotNull[i] then
      begin
        if not(FFieldTypes[i] in ftBlobTypes) then
          PByte(NativeInt(FBuffer)+FOffsets[i]-1)^ := 1; { not NULL }

        case FFieldTypes[i] of
          ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat, ftCurrency, ftDate,
          ftTime, ftDateTime, ftAutoInc, ftLargeint:
            begin
              Move(FCopyBuffer[i]^, Pointer(NativeInt(FBuffer)+FOffsets[i])^, FFieldSizes[i]);
            end;
          ftFixedChar, ftString:
            begin
             FillChar(Pointer(NativeInt(FBuffer)+FOffsets[i])^, FFieldSizes[i], 0);
               Move(PString(FCopyBuffer[i])^[1], Pointer(NativeInt(FBuffer)+FOffsets[i])^,
               Min(Length(PString(FCopyBuffer[i])^)*SizeOf(Char), FFieldSizes[i]-SizeOf(Char)));
            end;
          ftWideString:
            begin
              FillChar(Pointer(NativeInt(FBuffer)+FOffsets[i])^, FFieldSizes[i], 0);
              Move(PWideString(FCopyBuffer[i])^[1], Pointer(NativeInt(FBuffer)+FOffsets[i])^,
                Min(Length(PWideString(FCopyBuffer[i])^)*SizeOf(WideChar), FFieldSizes[i]-SizeOf(WideChar)));
            end;
          ftMemo:
            begin
              PMemBlobArray(NativeInt(FBuffer)+FBlobOfs)^[FBlobIndexes[i]] := PString(FCopyBuffer[i])^;
            end;
          ftWideMemo:
            begin
              if (Length(PWideString(FCopyBuffer[i])^) > 0) then
                begin
                  SetLength(PMemBlobArray(NativeInt(FBuffer)+FBlobOfs)[FBlobIndexes[i]],
                     Length(PWideString(FCopyBuffer[i])^)*SizeOf(WideChar));
                  Move(PWideString(FCopyBuffer[i])^[1],
                    PMemBlobArray(NativeInt(FBuffer)+FBlobOfs)^[FBlobIndexes[i]][1],
                    Length(PWideString(FCopyBuffer[i])^)*SizeOf(WideChar));
                end;
            end;
          ftVariant:
            begin
              PVariant(NativeInt(FBuffer)+FOffsets[i])^ := PVariant(FCopyBuffer[i])^;
            end;
          ftGuid: //not tested
            begin
              Move(PString(FCopyBuffer[i])^[1], Pointer(NativeInt(FBuffer)+FOffsets[i])^, GUID_SIZE);
            end;
          else
            begin
              raise Exception.Create('FastLoad: Unsupported field type (copy).');
            end;
        end;
      end          else
      begin
        case FFieldTypes[i] of
          ftVariant:
            begin
              PVariant(NativeInt(FBuffer)+FOffsets[i])^ := EmptyParam;
            end;
        end;
      end;

  THackMemoryData(FMemData).InternalAddRecord(FBuffer, True);
end;

procedure TJvMemoryDataLoader.FastLoad(Source: TCustomADODataSet; Destination:
  TJvMemoryData; Rules: String; fClearTable: Boolean = True);
var
  CalcBuffer: PJvMemBuffer;
begin
  Clear;
  SetMemData(Destination);
  FAdoData := Source;

  FMemData.DisableControls;
  FAdoData.DisableControls;
  try
    if fClearTable then
    begin
      FMemData.Close;
      FMemData.EmptyTable;
      FMemData.Open;
    end;
    ParseRules(Rules); { Parse it here, because field need to be created first. }
    ValidateModifiers;

    if Assigned(FOnSetup) then
      FOnSetup(Self, FAdoData, FMemData);

    {$IFDEF ADODIRECT}
    FRecordSet := FAdoData.Recordset;
    if not(FRecordSet.BOF and FRecordSet.EOF) then
      FRecordSet.MoveFirst;
    {$ELSE}
    FAdoData.First;
    {$ENDIF}

    FRow := 0;
    FRowsCount := {$IFDEF ADODIRECT}FRecordSet{$ELSE}FAdoData{$ENDIF}.RecordCount;
    while not({$IFDEF ADODIRECT}FRecordSet.EOF{$ELSE}FAdoData.Eof{$ENDIF}) do
      begin
        CleanupBuffers;
        CopyRuleData;

        if Assigned(FOnRowCopy) then
          FOnRowCopy(Self, FAdoData, FCopyBuffer, FNotNull, FRow, FRowsCount);

        CopyDataToMemoryData;

        {$IFNDEF ADODIRECT}
        FAdoData.Next;
        {$ELSE}
        FAdoData.Recordset.MoveNext;
        {$ENDIF}
        Inc(FRow);
      end;

    FMemData.Resync([]);
    FMemData.First;

    FAdoData.Resync([]);
    FAdoData.First;

    if FMemData.AutoCalcFields then
      begin
        while not(FMemData.Eof) do
          begin
            FMemData.Edit;
            THackMemoryData(FMemData).GetActiveRecBuf(CalcBuffer);
            THackMemoryData(FMemData).CalculateFields(CalcBuffer);
            FMemData.Post;
            FMemData.Next;
          end;
        FMemData.First;
      end;
  finally
    FAdoData.EnableControls;
    FMemData.EnableControls;
  end;
end;

function TJvMemoryDataLoader.DateTimeToInternalDate(Value: TDateTime): Longint;
var
  TimeStamp: TTimeStamp;
begin
  TimeStamp := DateTimeToTimeStamp(Value);
  Result := TimeStamp.Date;
end;

function TJvMemoryDataLoader.DateTimeToInternalTime(Value: TDateTime): Longint;
var
  TimeStamp: TTimeStamp;
begin
  TimeStamp := DateTimeToTimeStamp(Value);
  Result := TimeStamp.Time;
end;

function TJvMemoryDataLoader.DateTimeToInternalDateTime(Value: TDateTime): TDateTime;
var
  TimeStamp: TTimeStamp;
begin
  TimeStamp := DateTimeToTimeStamp(Value);
  Result := TimeStampToMSecs(TimeStamp);
end;

{ THackMemoryData }

procedure THackMemoryData.CalculateFields(Buffer: PChar);
begin
  inherited;
end;

procedure THackMemoryData.InternalAddRecord(Buffer: Pointer; Append: Boolean);
begin
  inherited;
end;

function THackMemoryData.GetActiveRecBuf(var RecBuf: PJvMemBuffer): Boolean;
begin
  Result := inherited GetActiveRecBuf(RecBuf);
end;

end.