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.
Comments
0 B
|👍
/👎
0 B
|👍
/👎