fix work with variant types on rxmemdataset

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1261 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2010-07-20 16:08:40 +00:00
parent 7f8f0aade3
commit a5c4deabef
2 changed files with 100 additions and 160 deletions

View File

@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="7"/>
<Version Value="8"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
@ -53,7 +53,7 @@
<MinVersion Major="1" Release="18" Build="56" Valid="True"/>
</Item4>
</RequiredPackages>
<Units Count="60">
<Units Count="62">
<Unit0>
<Filename Value="RxDBGridDemo.lpr"/>
<IsPartOfProject Value="True"/>
@ -72,10 +72,11 @@
<IsVisibleTab Value="True"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="148"/>
<CursorPos X="12" Y="157"/>
<TopLine Value="1"/>
<CursorPos X="73" Y="8"/>
<UsageCount Value="53"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../../../fpcsrc/fcl/db/db.pp"/>
@ -304,12 +305,10 @@
</Unit33>
<Unit34>
<Filename Value="../../../../../../install/fpcsrc/rtl/objpas/classes/classesh.inc"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="426"/>
<CursorPos X="17" Y="448"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit34>
<Unit35>
<Filename Value="../../../../../smsprog/sms_send_deamon/smsSendGui/smssendaboutunit.pas"/>
@ -379,12 +378,10 @@
<Unit43>
<Filename Value="/usr/local/share/lazarus/lcl/dbgrids.pas"/>
<UnitName Value="DBGrids"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="3153"/>
<CursorPos X="18" Y="3171"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit43>
<Unit44>
<Filename Value="/usr/local/share/lazarus/components/rxnew/registerrxdb.pas"/>
@ -396,7 +393,6 @@
<Unit45>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<UnitName Value="rxdbgrid"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="1895"/>
<CursorPos X="32" Y="1920"/>
@ -406,7 +402,6 @@
<Item1 X="13" Y="1203" ID="1"/>
<Item2 X="11" Y="1606" ID="2"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit45>
<Unit46>
<Filename Value="/usr/local/share/lazarus/ideintf/dbpropedits.pas"/>
@ -453,12 +448,10 @@
<Unit51>
<Filename Value="/usr/local/share/lazarus/components/synedit/synedit.pp"/>
<UnitName Value="SynEdit"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="5699"/>
<CursorPos X="1" Y="5702"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit51>
<Unit52>
<Filename Value="/usr/local/share/lazarus/components/synedit/syneditkeycmds.pp"/>
@ -518,145 +511,45 @@
</Unit57>
<Unit58>
<Filename Value="../../../../../../install/fpcsrc/rtl/objpas/classes/collect.inc"/>
<EditorIndex Value="6"/>
<WindowIndex Value="0"/>
<TopLine Value="286"/>
<CursorPos X="1" Y="288"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit58>
<Unit59>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<UnitName Value="Grids"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="3153"/>
<CursorPos X="27" Y="3167"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit59>
<Unit60>
<Filename Value="../../../../../../wine/1/1/rx.diff"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="9"/>
<UsageCount Value="10"/>
<DefaultSyntaxHighlighter Value="Diff"/>
</Unit60>
<Unit61>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxmemds.pas"/>
<UnitName Value="rxmemds"/>
<WindowIndex Value="0"/>
<TopLine Value="1088"/>
<CursorPos X="1" Y="1113"/>
<UsageCount Value="10"/>
</Unit61>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<JumpHistory Count="2" HistoryIndex="1">
<Position1>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1220" Column="1" TopLine="1194"/>
<Filename Value="rxdbgridmainunit.pas"/>
<Caret Line="161" Column="14" TopLine="148"/>
</Position1>
<Position2>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1222" Column="1" TopLine="1194"/>
<Filename Value="rxdbgridmainunit.pas"/>
<Caret Line="8" Column="73" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1223" Column="1" TopLine="1206"/>
</Position3>
<Position4>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1224" Column="1" TopLine="1206"/>
</Position4>
<Position5>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1226" Column="1" TopLine="1206"/>
</Position5>
<Position6>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1227" Column="1" TopLine="1206"/>
</Position6>
<Position7>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1228" Column="1" TopLine="1206"/>
</Position7>
<Position8>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1230" Column="1" TopLine="1206"/>
</Position8>
<Position9>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1231" Column="1" TopLine="1206"/>
</Position9>
<Position10>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1230" Column="1" TopLine="1206"/>
</Position10>
<Position11>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1231" Column="1" TopLine="1206"/>
</Position11>
<Position12>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1233" Column="1" TopLine="1206"/>
</Position12>
<Position13>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1234" Column="1" TopLine="1206"/>
</Position13>
<Position14>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1235" Column="1" TopLine="1206"/>
</Position14>
<Position15>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1239" Column="1" TopLine="1207"/>
</Position15>
<Position16>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="391" Column="35" TopLine="364"/>
</Position16>
<Position17>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1366" Column="41" TopLine="1347"/>
</Position17>
<Position18>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1596" Column="30" TopLine="1566"/>
</Position18>
<Position19>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1597" Column="24" TopLine="1576"/>
</Position19>
<Position20>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1588" Column="53" TopLine="1549"/>
</Position20>
<Position21>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="3052" Column="24" TopLine="3033"/>
</Position21>
<Position22>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="3017" Column="18" TopLine="3015"/>
</Position22>
<Position23>
<Filename Value="/usr/local/share/lazarus/lcl/dbgrids.pas"/>
<Caret Line="3460" Column="18" TopLine="3456"/>
</Position23>
<Position24>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="10083" Column="16" TopLine="10081"/>
</Position24>
<Position25>
<Filename Value="/usr/local/share/lazarus/lcl/grids.pas"/>
<Caret Line="504" Column="29" TopLine="488"/>
</Position25>
<Position26>
<Filename Value="/usr/local/share/lazarus/lcl/dbgrids.pas"/>
<Caret Line="3366" Column="21" TopLine="3360"/>
</Position26>
<Position27>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="276" Column="15" TopLine="257"/>
</Position27>
<Position28>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1282" Column="17" TopLine="1272"/>
</Position28>
<Position29>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1220" Column="13" TopLine="1205"/>
</Position29>
<Position30>
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxdbgrid.pas"/>
<Caret Line="1254" Column="7" TopLine="1218"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>

View File

@ -68,6 +68,7 @@ type
FCaseInsensitiveSort: Boolean;
FDescendingSort: Boolean;
function AddRecord: TMemoryRecord;
procedure CopyRecord(RecordData, Buffer: PChar);
function GetOnFilterRecordEx: TFilterRecordEvent;
function InsertRecord(Index: Integer): TMemoryRecord;
function FindRecordID(ID: Integer): TMemoryRecord;
@ -77,7 +78,8 @@ type
procedure SetOnFilterRecordEx(const AValue: TFilterRecordEvent);
procedure Sort;
function CalcRecordSize: Integer;
function FindFieldData(Buffer: Pointer; Field: TField): Pointer;
function FindFieldData(Buffer: Pointer; Field: TField): Pointer;overload;
function FindFieldData(Buffer: Pointer; FieldNo:Integer): Pointer;overload;
function GetMemoryRecord(Index: Integer): TMemoryRecord;
function GetCapacity: Integer;
function RecordFilter: Boolean;
@ -438,6 +440,7 @@ begin
for I := 0 to Value.FieldDefs.Count - 1 do
CalcDataSize(Value.FieldDefs[I], DataSize);
ReallocMem(FData, DataSize);
FillChar(FData^, DataSize, 0);
end;
end;
end;
@ -583,19 +586,15 @@ function TRxMemoryData.FindFieldData(Buffer: Pointer; Field: TField): Pointer;
var
Index: Integer;
begin
{.$IFDEF RX_D4}
// Index := FieldDefList.IndexOf(Field.FullName);
{.$ELSE}
Index := FieldDefs.IndexOf(Field.FieldName);
{.$ENDIF}
if (Index >= 0) and (Buffer <> nil) and
{.$IFDEF RX_D4}
// (FieldDefList[Index].DataType in ftSupported - ftBlobTypes) then
{.$ELSE}
(FieldDefs[Index].DataType in ftSupported - ftBlobTypes) then
{.$ENDIF}
Result := Pointer(PtrInt(PChar(Buffer)) + FOffsets^[Index])
else Result := nil;
Result:=FindFieldData(Buffer, Index);
end;
function TRxMemoryData.FindFieldData(Buffer: Pointer; FieldNo: Integer): Pointer;
begin
Result := nil;
if (FieldNo >= 0) and (Buffer <> nil) and (FieldDefs[FieldNo].DataType in ftSupported - ftBlobTypes) then
Result := Pointer(PtrInt(PChar(Buffer)) + FOffsets^[FieldNo]);
end;
{ Buffer Manipulation }
@ -639,10 +638,26 @@ begin
end;
procedure TRxMemoryData.FreeRecordBuffer(var Buffer: PChar);
var
n:integer;
FieldPtr:PChar;
begin
if BlobFieldCount > 0 then
//correctly release field memory for complex types
for n:=0 to FieldDefs.Count-1 do
if FieldDefs.Items[n].DataType = ftVariant then
begin
FieldPtr:=FindFieldData(Buffer, n);
if FieldPtr <> nil then
begin
PBoolean(FieldPtr)^:=False;
Inc(FieldPtr);
Finalize( PVariant(FieldPtr)^ );
end;
end;
if BlobFieldCount > 0 then
FinalizeBlobFields(PMemBlobArray(Buffer + FBlobOfs), BlobFieldCount);
// Finalize(PMemBlobArray(Buffer + FBlobOfs)^[0]);//, BlobFieldCount)
StrDispose(Buffer);
Buffer := nil;
end;
@ -674,6 +689,35 @@ begin
end;
end;
procedure TRxMemoryData.CopyRecord(RecordData, Buffer:PChar);
var
n, FieldSize:Integer;
FieldPtr, BufPtr:PChar;
DataType:TFieldType;
begin
for n:=0 to FieldDefs.Count-1 do
begin
FieldPtr:=FindFieldData(RecordData, n);
BufPtr:=FindFieldData(Buffer, n);
if FieldPtr = nil then Continue;
PBoolean(BufPtr)^:=PBoolean(FieldPtr)^;
Inc(FieldPtr);
Inc(BufPtr);
DataType:=FieldDefs.Items[n].DataType;
if DataType = ftVariant then
begin
PVariant(BufPtr)^:=PVariant(FieldPtr)^;
end
else
begin
FieldSize:=FieldDefs.Items[n].Size;
Move( FieldPtr^, BufPtr^, CalcFieldLen(DataType, FieldSize) );
end;
end;
end;
function TRxMemoryData.GetCurrentRecord(Buffer: PChar): Boolean;
begin
Result := False;
@ -682,7 +726,9 @@ begin
UpdateCursorPos;
if (FRecordPos >= 0) and (FRecordPos < RecordCount) then
begin
Move(Records[FRecordPos].Data^, Buffer^, FRecordSize);
//Move(Records[FRecordPos].Data^, Buffer^, FRecordSize);
CopyRecord(Records[FRecordPos].Data, Buffer);
Result := True;
end;
end;
@ -692,7 +738,8 @@ procedure TRxMemoryData.RecordToBuffer(Rec: TMemoryRecord; Buffer: PChar);
var
I: Integer;
begin
Move(Rec.Data^, Buffer^, FRecordSize);
//Move(Rec.Data^, Buffer^, FRecordSize);
CopyRecord(Rec.Data, Buffer);
with PMemBookmarkInfo(Buffer + FBookmarkOfs)^ do
begin
BookmarkData := Rec.ID;
@ -851,17 +898,15 @@ begin
begin
if DataType = ftVariant then
begin
if Buffer <> nil then
VarData := PVariant(Buffer)^
if (Buffer = nil) or VarIsNull(PVariant(Buffer)^) or VarIsEmpty(PVariant(Buffer)^) or
VarIsEmptyParam(PVariant(Buffer)^) then
FillChar(Data^, CalcFieldLen(DataType, Size), 0)
else
VarData := EmptyParam;
Boolean(Data[0]) := LongBool(Buffer) and not
(VarIsNull(VarData) or VarIsEmpty(VarData));
if Boolean(Data[0]) then begin
begin
Boolean(Data[0]):=True;
Inc(Data);
PVariant(Data)^ := VarData;
end
else FillChar(Data^, CalcFieldLen(DataType, Size), 0);
PVariant(Data)^ := PVariant(Buffer)^;
end;
end
else
begin
@ -1063,7 +1108,9 @@ procedure TRxMemoryData.AssignMemoryRecord(Rec: TMemoryRecord; Buffer: PChar);
var
I: Integer;
begin
Move(Buffer^, Rec.Data^, FRecordSize);
//Move(Buffer^, Rec.Data^, FRecordSize);
CopyRecord(Buffer, PChar(Rec.Data));
for I := 0 to BlobFieldCount - 1 do
PMemBlobArray(Rec.FBlobs)^[I] := PMemBlobArray(Buffer + FBlobOfs)^[I];
end;