You've already forked lazarus-ccr
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:
@ -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>
|
||||
|
@ -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;
|
||||
|
Reference in New Issue
Block a user