You've already forked lazarus-ccr
apply patch to RxMemData for load/save data - tnx Rich, issue 0020413
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2382 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
182
components/rx/Demos/TestRXMemDSLoad/rx_ext_test_case_1.pas
Normal file
182
components/rx/Demos/TestRXMemDSLoad/rx_ext_test_case_1.pas
Normal file
@ -0,0 +1,182 @@
|
|||||||
|
unit rx_ext_test_case_1;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, fpcunit, testutils, testregistry, rxmemds, Dialogs;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TTCRxMemDataLifecycle }
|
||||||
|
|
||||||
|
TTCRxMemDataLifecycle= class(TTestCase)
|
||||||
|
protected
|
||||||
|
procedure SetUp; override;
|
||||||
|
procedure TearDown; override;
|
||||||
|
published
|
||||||
|
procedure TestHookUp;
|
||||||
|
procedure TestSave;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
db, ex_rx_datapacket;
|
||||||
|
|
||||||
|
procedure TTCRxMemDataLifecycle.TestHookUp;
|
||||||
|
var
|
||||||
|
ads : TRxMemoryData;
|
||||||
|
aField : TField;
|
||||||
|
i : integer;
|
||||||
|
begin
|
||||||
|
ads := TRxMemoryData.Create(nil);
|
||||||
|
|
||||||
|
aField := TIntegerField.Create(nil);
|
||||||
|
aField.FieldName:= 'IntegerField1';
|
||||||
|
aField.Name := 'adsIntegerField1';
|
||||||
|
aField.DataSet := ads;
|
||||||
|
|
||||||
|
aField := TStringField.Create(nil);
|
||||||
|
aField.FieldName:= 'StringField1';
|
||||||
|
aField.Name := 'adsStringField1';
|
||||||
|
aField.Size := 20;
|
||||||
|
aField.DataSet := ads;
|
||||||
|
|
||||||
|
aField := TFloatField.Create(nil);
|
||||||
|
aField.FieldName:= 'FloatField1';
|
||||||
|
aField.Name := 'adsFloatField1';
|
||||||
|
aField.DataSet := ads;
|
||||||
|
|
||||||
|
ads.Open;
|
||||||
|
|
||||||
|
for i := 0 to 500 do
|
||||||
|
begin
|
||||||
|
ads.AppendRecord([i,'Name '+ IntToStr(i), 200 + (i*0.1)]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
ads.First;
|
||||||
|
|
||||||
|
i:= 0;
|
||||||
|
while not ads.EOF do
|
||||||
|
begin
|
||||||
|
AssertTrue('Integer is incorrect ' + IntToStr(i), ads.FieldByName('IntegerField1').AsInteger = i);
|
||||||
|
AssertTrue('Float is incorrect ' + IntToStr(i), ads.FieldByName('FloatField1').AsFloat - (200 + (i*0.1)) < 0.01);
|
||||||
|
AssertTrue('String is incorrect ' + IntToStr(i), ads.FieldByName('StringField1').AsString = 'Name '+ IntToStr(i));
|
||||||
|
inc(i);
|
||||||
|
ads.Next;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTCRxMemDataLifecycle.TestSave;
|
||||||
|
var
|
||||||
|
ads1,ads2 : TRxMemoryData;
|
||||||
|
aField : TField;
|
||||||
|
i : integer;
|
||||||
|
sMemoTest : String;
|
||||||
|
begin
|
||||||
|
ads1 := TRxMemoryData.Create(nil);
|
||||||
|
ads2 := TRxMemoryData.Create(nil);
|
||||||
|
|
||||||
|
aField := TIntegerField.Create(nil);
|
||||||
|
aField.FieldName:= 'IntegerField1';
|
||||||
|
aField.Name := 'adsIntegerField1';
|
||||||
|
aField.DataSet := ads1;
|
||||||
|
|
||||||
|
aField := TStringField.Create(nil);
|
||||||
|
aField.FieldName:= 'StringField1';
|
||||||
|
aField.Name := 'adsStringField1';
|
||||||
|
aField.Size := 20;
|
||||||
|
aField.DataSet := ads1;
|
||||||
|
|
||||||
|
aField := TFloatField.Create(nil);
|
||||||
|
aField.FieldName:= 'FloatField1';
|
||||||
|
aField.Name := 'adsFloatField1';
|
||||||
|
aField.DataSet := ads1;
|
||||||
|
|
||||||
|
// TBooleanField
|
||||||
|
|
||||||
|
aField := TBooleanField.Create(nil);
|
||||||
|
aField.FieldName:= 'BooleanField1';
|
||||||
|
aField.Name := 'adsBooleanField1';
|
||||||
|
aField.DataSet := ads1;
|
||||||
|
|
||||||
|
// TDateTimeField
|
||||||
|
|
||||||
|
aField := TDateTimeField.Create(nil);
|
||||||
|
aField.FieldName:= 'DateTimeField1';
|
||||||
|
aField.Name := 'adsDateTimeField1';
|
||||||
|
aField.DataSet := ads1;
|
||||||
|
|
||||||
|
|
||||||
|
// TMemoField
|
||||||
|
|
||||||
|
aField := TMemoField.Create(nil);
|
||||||
|
aField.FieldName:= 'MemoField1';
|
||||||
|
aField.Name := 'adsMemoField1';
|
||||||
|
aField.Size:= 600;
|
||||||
|
aField.DataSet := ads1;
|
||||||
|
|
||||||
|
// TCurrencyField
|
||||||
|
|
||||||
|
aField := TCurrencyField.Create(nil);
|
||||||
|
aField.FieldName:= 'CurrencyField1';
|
||||||
|
aField.Name := 'adsCurrencyField1';
|
||||||
|
aField.DataSet := ads1;
|
||||||
|
|
||||||
|
ads1.Open;
|
||||||
|
ads2.Open;
|
||||||
|
|
||||||
|
sMemoTest := 'memo1';
|
||||||
|
for i := 0 to 500 do
|
||||||
|
begin
|
||||||
|
ads1.AppendRecord([i,'Name '+ IntToStr(i), 200 + (i*0.1),(i div 2) = 1, EncodeDate(2011,10,03) + i, sMemoTest, 1000 + (i*0.1)]);
|
||||||
|
sMemoTest := sMemoTest + 'a';
|
||||||
|
end;
|
||||||
|
|
||||||
|
ads1.SaveToFile('/tmp/testfile.xml',dfXML);
|
||||||
|
ads2.LoadFromFile('/tmp/testfile.xml',dfXML);
|
||||||
|
|
||||||
|
ads2.First;
|
||||||
|
|
||||||
|
sMemoTest := 'memo1';
|
||||||
|
i:= 0;
|
||||||
|
while not ads2.EOF do
|
||||||
|
begin
|
||||||
|
AssertTrue('Integer is incorrect ' + IntToStr(i), ads2.FieldByName('IntegerField1').AsInteger = i);
|
||||||
|
AssertTrue('Float is incorrect ' + IntToStr(i), ads2.FieldByName('FloatField1').AsFloat - (200 + (i*0.1)) < 0.01);
|
||||||
|
AssertTrue('String is incorrect ' + IntToStr(i), ads2.FieldByName('StringField1').AsString = 'Name '+ IntToStr(i));
|
||||||
|
|
||||||
|
AssertTrue('Currency is incorrect ' + IntToStr(i), ads2.FieldByName('CurrencyField1').AsFloat - (1000 + (i*0.1)) < 0.01);
|
||||||
|
AssertTrue('DateTime is incorrect ' + IntToStr(i), ads2.FieldByName('DateTimeField1').AsDateTime = EncodeDate(2011,10,03) + i);
|
||||||
|
AssertTrue('Memo is incorrect ' + IntToStr(i) + ads2.FieldByName('MemoField1').AsString, StrComp(Pchar(ads2.FieldByName('MemoField1').asString),Pchar(sMemoTest)) = 0);
|
||||||
|
|
||||||
|
sMemoTest := sMemoTest + 'a';
|
||||||
|
inc(i);
|
||||||
|
ads2.Next;
|
||||||
|
end;
|
||||||
|
|
||||||
|
ads1.Free;
|
||||||
|
ads2.Free;
|
||||||
|
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTCRxMemDataLifecycle.SetUp;
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTCRxMemDataLifecycle.TearDown;
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
|
||||||
|
RegisterTest(TTCRxMemDataLifecycle);
|
||||||
|
end.
|
||||||
|
|
||||||
309
components/rx/Demos/TestRXMemDSLoad/rx_ext_test_harness.lpi
Normal file
309
components/rx/Demos/TestRXMemDSLoad/rx_ext_test_harness.lpi
Normal file
@ -0,0 +1,309 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="9"/>
|
||||||
|
<General>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
<ActiveWindowIndexAtStart Value="0"/>
|
||||||
|
</General>
|
||||||
|
<i18n>
|
||||||
|
<EnableI18N LFM="False"/>
|
||||||
|
</i18n>
|
||||||
|
<VersionInfo>
|
||||||
|
<StringTable ProductVersion=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<BuildModes Count="1" Active="Default">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||||
|
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="4">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="rxnew"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="FPCUnitTestRunner"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item3>
|
||||||
|
<Item4>
|
||||||
|
<PackageName Value="FCL"/>
|
||||||
|
</Item4>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="19">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="rx_ext_test_harness.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="rx_ext_test_harness"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<CursorPos X="35" Y="9"/>
|
||||||
|
<UsageCount Value="27"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="rx_ext_test_case_1"/>
|
||||||
|
<EditorIndex Value="0"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<CursorPos X="33" Y="120"/>
|
||||||
|
<UsageCount Value="27"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="/usr/local/src/fpc-2.4.2/packages/fcl-fpcunit/src/testregistry.pp"/>
|
||||||
|
<UnitName Value="testregistry"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<CursorPos X="1" Y="1"/>
|
||||||
|
<UsageCount Value="12"/>
|
||||||
|
</Unit2>
|
||||||
|
<Unit3>
|
||||||
|
<Filename Value="../../../lazarus/components/rxnew/rx/rxmemds.pas"/>
|
||||||
|
<UnitName Value="rxmemds"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="18"/>
|
||||||
|
<CursorPos X="14" Y="41"/>
|
||||||
|
<UsageCount Value="13"/>
|
||||||
|
</Unit3>
|
||||||
|
<Unit4>
|
||||||
|
<Filename Value="../../../lazarus/components/fpcunit/guitestrunner.pas"/>
|
||||||
|
<UnitName Value="GuiTestRunner"/>
|
||||||
|
<EditorIndex Value="2"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="207"/>
|
||||||
|
<CursorPos X="1" Y="247"/>
|
||||||
|
<UsageCount Value="13"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit4>
|
||||||
|
<Unit5>
|
||||||
|
<Filename Value="/usr/local/src/fpc-2.4.2/packages/fcl-fpcunit/src/fpcunit.pp"/>
|
||||||
|
<UnitName Value="fpcunit"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="1226"/>
|
||||||
|
<CursorPos X="10" Y="908"/>
|
||||||
|
<UsageCount Value="12"/>
|
||||||
|
</Unit5>
|
||||||
|
<Unit6>
|
||||||
|
<Filename Value="../../../lazarus/components/rxnew/rx/ex_rx_datapacket.pas"/>
|
||||||
|
<UnitName Value="ex_rx_datapacket"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<CursorPos X="1" Y="1"/>
|
||||||
|
<UsageCount Value="11"/>
|
||||||
|
</Unit6>
|
||||||
|
<Unit7>
|
||||||
|
<Filename Value="../../../lazarus/components/rxnew/rx/ex_rx_xml_datapacket.pas"/>
|
||||||
|
<UnitName Value="ex_rx_xml_datapacket"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="329"/>
|
||||||
|
<CursorPos X="30" Y="342"/>
|
||||||
|
<UsageCount Value="11"/>
|
||||||
|
</Unit7>
|
||||||
|
<Unit8>
|
||||||
|
<Filename Value="/usr/local/src/fpc-2.4.2/packages/fcl-db/src/base/db.pas"/>
|
||||||
|
<UnitName Value="db"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="238"/>
|
||||||
|
<CursorPos X="17" Y="255"/>
|
||||||
|
<UsageCount Value="11"/>
|
||||||
|
</Unit8>
|
||||||
|
<Unit9>
|
||||||
|
<Filename Value="/usr/local/src/fpc-2.4.2/rtl/objpas/sysutils/datih.inc"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="100"/>
|
||||||
|
<CursorPos X="10" Y="109"/>
|
||||||
|
<UsageCount Value="11"/>
|
||||||
|
</Unit9>
|
||||||
|
<Unit10>
|
||||||
|
<Filename Value="/usr/local/src/fpc-2.4.2/rtl/objpas/sysutils/dati.inc"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="1101"/>
|
||||||
|
<CursorPos X="3" Y="1108"/>
|
||||||
|
<UsageCount Value="11"/>
|
||||||
|
</Unit10>
|
||||||
|
<Unit11>
|
||||||
|
<Filename Value="/usr/local/src/fpc-2.4.2/rtl/objpas/sysutils/syspchh.inc"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="12"/>
|
||||||
|
<CursorPos X="10" Y="29"/>
|
||||||
|
<UsageCount Value="11"/>
|
||||||
|
</Unit11>
|
||||||
|
<Unit12>
|
||||||
|
<Filename Value="/usr/local/src/fpc-2.4.2/rtl/inc/genstr.inc"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="243"/>
|
||||||
|
<CursorPos X="9" Y="248"/>
|
||||||
|
<UsageCount Value="11"/>
|
||||||
|
</Unit12>
|
||||||
|
<Unit13>
|
||||||
|
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxmemds.pas"/>
|
||||||
|
<UnitName Value="rxmemds"/>
|
||||||
|
<IsVisibleTab Value="True"/>
|
||||||
|
<EditorIndex Value="1"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<CursorPos X="45" Y="40"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
<Loaded Value="True"/>
|
||||||
|
</Unit13>
|
||||||
|
<Unit14>
|
||||||
|
<Filename Value="/usr/local/share/lazarus/components/rxnew/ex_rx_bin_datapacket.pas"/>
|
||||||
|
<UnitName Value="ex_rx_bin_datapacket"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<CursorPos X="1" Y="1"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit14>
|
||||||
|
<Unit15>
|
||||||
|
<Filename Value="/usr/local/share/lazarus/components/rxnew/ex_rx_datapacket.pas"/>
|
||||||
|
<UnitName Value="ex_rx_datapacket"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="1"/>
|
||||||
|
<CursorPos X="1" Y="1"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit15>
|
||||||
|
<Unit16>
|
||||||
|
<Filename Value="/usr/local/share/lazarus/components/rxnew/ex_rx_xml_datapacket.pas"/>
|
||||||
|
<UnitName Value="ex_rx_xml_datapacket"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="323"/>
|
||||||
|
<CursorPos X="80" Y="343"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit16>
|
||||||
|
<Unit17>
|
||||||
|
<Filename Value="../rx/rxmemds.pas"/>
|
||||||
|
<UnitName Value="rxmemds"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="3"/>
|
||||||
|
<CursorPos X="3" Y="41"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit17>
|
||||||
|
<Unit18>
|
||||||
|
<Filename Value="../../../../install/fpcsrc/packages/fcl-db/src/base/db.pas"/>
|
||||||
|
<UnitName Value="db"/>
|
||||||
|
<WindowIndex Value="0"/>
|
||||||
|
<TopLine Value="1367"/>
|
||||||
|
<CursorPos X="3" Y="1339"/>
|
||||||
|
<UsageCount Value="10"/>
|
||||||
|
</Unit18>
|
||||||
|
</Units>
|
||||||
|
<JumpHistory Count="20" HistoryIndex="19">
|
||||||
|
<Position1>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="134" Column="1" TopLine="111"/>
|
||||||
|
</Position1>
|
||||||
|
<Position2>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="135" Column="1" TopLine="111"/>
|
||||||
|
</Position2>
|
||||||
|
<Position3>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="94" Column="18" TopLine="71"/>
|
||||||
|
</Position3>
|
||||||
|
<Position4>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="101" Column="1" TopLine="81"/>
|
||||||
|
</Position4>
|
||||||
|
<Position5>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="123" Column="1" TopLine="93"/>
|
||||||
|
</Position5>
|
||||||
|
<Position6>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="116" Column="1" TopLine="93"/>
|
||||||
|
</Position6>
|
||||||
|
<Position7>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="108" Column="2" TopLine="93"/>
|
||||||
|
</Position7>
|
||||||
|
<Position8>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="150" Column="119" TopLine="122"/>
|
||||||
|
</Position8>
|
||||||
|
<Position9>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="133" Column="81" TopLine="122"/>
|
||||||
|
</Position9>
|
||||||
|
<Position10>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="120" Column="39" TopLine="91"/>
|
||||||
|
</Position10>
|
||||||
|
<Position11>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="151" Column="164" TopLine="134"/>
|
||||||
|
</Position11>
|
||||||
|
<Position12>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="137" Column="15" TopLine="115"/>
|
||||||
|
</Position12>
|
||||||
|
<Position13>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="154" Column="164" TopLine="136"/>
|
||||||
|
</Position13>
|
||||||
|
<Position14>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="137" Column="41" TopLine="130"/>
|
||||||
|
</Position14>
|
||||||
|
<Position15>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="157" Column="7" TopLine="140"/>
|
||||||
|
</Position15>
|
||||||
|
<Position16>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="137" Column="16" TopLine="127"/>
|
||||||
|
</Position16>
|
||||||
|
<Position17>
|
||||||
|
<Filename Value="rx_ext_test_case_1.pas"/>
|
||||||
|
<Caret Line="120" Column="33" TopLine="1"/>
|
||||||
|
</Position17>
|
||||||
|
<Position18>
|
||||||
|
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxmemds.pas"/>
|
||||||
|
<Caret Line="207" Column="5" TopLine="268"/>
|
||||||
|
</Position18>
|
||||||
|
<Position19>
|
||||||
|
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxmemds.pas"/>
|
||||||
|
<Caret Line="1689" Column="1" TopLine="1690"/>
|
||||||
|
</Position19>
|
||||||
|
<Position20>
|
||||||
|
<Filename Value="/usr/local/share/lazarus/components/rxnew/rxmemds.pas"/>
|
||||||
|
<Caret Line="73" Column="42" TopLine="53"/>
|
||||||
|
</Position20>
|
||||||
|
</JumpHistory>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Other>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="3">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAbort"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="ECodetoolError"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Name Value="EFOpenError"/>
|
||||||
|
</Item3>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
15
components/rx/Demos/TestRXMemDSLoad/rx_ext_test_harness.lpr
Normal file
15
components/rx/Demos/TestRXMemDSLoad/rx_ext_test_harness.lpr
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
program rx_ext_test_harness;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Interfaces, Forms, GuiTestRunner, rxnew, rx_ext_test_case_1;
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TGuiTestRunner, TestRunner);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
||||||
BIN
components/rx/Demos/TestRXMemDSLoad/rx_ext_test_harness.res
Normal file
BIN
components/rx/Demos/TestRXMemDSLoad/rx_ext_test_harness.res
Normal file
Binary file not shown.
172
components/rx/ex_rx_bin_datapacket.pas
Normal file
172
components/rx/ex_rx_bin_datapacket.pas
Normal file
@ -0,0 +1,172 @@
|
|||||||
|
{
|
||||||
|
TBinaryRxDatapacketReader implementation
|
||||||
|
|
||||||
|
See the file COPYING.FPC, included in this distribution,
|
||||||
|
for details about the copyright.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
unit ex_rx_bin_datapacket;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, dom, db, ex_rx_datapacket;
|
||||||
|
|
||||||
|
type
|
||||||
|
TChangeLogEntry = record
|
||||||
|
UpdateKind : TUpdateKind;
|
||||||
|
OrigEntry : integer;
|
||||||
|
NewEntry : integer;
|
||||||
|
end;
|
||||||
|
TChangeLogEntryArr = array of TChangeLogEntry;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ TBinaryRxDatapacketReader }
|
||||||
|
|
||||||
|
TBinaryRxDatapacketReader = class(TRxDataPacketReader)
|
||||||
|
public
|
||||||
|
procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override;
|
||||||
|
procedure StoreFieldDefs(AFieldDefs : TFieldDefs); override;
|
||||||
|
function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override;
|
||||||
|
procedure FinalizeStoreRecords; override;
|
||||||
|
function GetCurrentRecord : boolean; override;
|
||||||
|
procedure GotoNextRecord; override;
|
||||||
|
procedure InitLoadRecords; override;
|
||||||
|
procedure RestoreRecord(ADataset : TDataset); override;
|
||||||
|
procedure StoreRecord(ADataset : TDataset; ARowState : TRowState; AUpdOrder : integer = 0); override;
|
||||||
|
class function RecognizeStream(AStream : TStream) : boolean; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses
|
||||||
|
dbconst;
|
||||||
|
|
||||||
|
{ TBinaryRxDatapacketReader }
|
||||||
|
|
||||||
|
const
|
||||||
|
RxBinaryIdent = 'BinRxDataset';
|
||||||
|
|
||||||
|
procedure TBinaryRxDatapacketReader.LoadFieldDefs(AFieldDefs: TFieldDefs);
|
||||||
|
var
|
||||||
|
FldCount : word;
|
||||||
|
i : integer;
|
||||||
|
begin
|
||||||
|
|
||||||
|
if not RecognizeStream(Stream) then
|
||||||
|
DatabaseError(SStreamNotRecognised);
|
||||||
|
|
||||||
|
FldCount:=Stream.ReadWord;
|
||||||
|
AFieldDefs.Clear;
|
||||||
|
for i := 0 to FldCount -1 do with TFieldDef.create(AFieldDefs) do
|
||||||
|
begin
|
||||||
|
Name := Stream.ReadAnsiString;
|
||||||
|
Displayname := Stream.ReadAnsiString;
|
||||||
|
Size := Stream.ReadWord;
|
||||||
|
DataType := TFieldType(Stream.ReadWord);
|
||||||
|
|
||||||
|
if Stream.ReadByte = 1 then
|
||||||
|
Attributes := Attributes + [faReadonly];
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBinaryRxDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs);
|
||||||
|
var i : integer;
|
||||||
|
begin
|
||||||
|
Stream.Write(RxBinaryIdent[1],length(RxBinaryIdent));
|
||||||
|
|
||||||
|
Stream.WriteWord(AFieldDefs.Count);
|
||||||
|
for i := 0 to AFieldDefs.Count -1 do with AFieldDefs[i] do
|
||||||
|
begin
|
||||||
|
Stream.WriteAnsiString(Name);
|
||||||
|
Stream.WriteAnsiString(DisplayName);
|
||||||
|
Stream.WriteWord(size);
|
||||||
|
Stream.WriteWord(ord(DataType));
|
||||||
|
|
||||||
|
if faReadonly in Attributes then
|
||||||
|
Stream.WriteByte(1)
|
||||||
|
else
|
||||||
|
Stream.WriteByte(0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBinaryRxDatapacketReader.GetRecordRowState(out AUpdOrder: Integer
|
||||||
|
): TRowState;
|
||||||
|
var Buf : byte;
|
||||||
|
begin
|
||||||
|
Buf := 0;
|
||||||
|
AUpdOrder := 0;
|
||||||
|
|
||||||
|
Stream.Read(Buf,1);
|
||||||
|
Result := ByteToRowState(Buf);
|
||||||
|
if Result<>[] then
|
||||||
|
Stream.ReadBuffer(AUpdOrder,sizeof(integer));
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBinaryRxDatapacketReader.FinalizeStoreRecords;
|
||||||
|
begin
|
||||||
|
// Do nothing
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TBinaryRxDatapacketReader.GetCurrentRecord: boolean;
|
||||||
|
var
|
||||||
|
Buf : byte;
|
||||||
|
begin
|
||||||
|
Buf := 0;
|
||||||
|
Result := (Stream.Read(Buf,1)=1) and (Buf=$fe);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBinaryRxDatapacketReader.GotoNextRecord;
|
||||||
|
begin
|
||||||
|
// Do Nothing
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBinaryRxDatapacketReader.InitLoadRecords;
|
||||||
|
begin
|
||||||
|
// Do Nothing
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBinaryRxDatapacketReader.RestoreRecord(ADataset: TDataset);
|
||||||
|
begin
|
||||||
|
Stream.ReadBuffer(ADataset.ActiveBuffer^,ADataset.RecordSize);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TBinaryRxDatapacketReader.StoreRecord(ADataset: TDataset;
|
||||||
|
ARowState: TRowState; AUpdOrder: integer);
|
||||||
|
begin
|
||||||
|
Stream.WriteByte($fe);
|
||||||
|
Stream.WriteByte(RowStateToByte(ARowState));
|
||||||
|
if ARowState<>[] then
|
||||||
|
Stream.WriteBuffer(AUpdOrder,sizeof(integer));
|
||||||
|
Stream.WriteBuffer(ADataset.ActiveBuffer^,ADataset.RecordSize);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TBinaryRxDatapacketReader.RecognizeStream(AStream: TStream
|
||||||
|
): boolean;
|
||||||
|
var s : string;
|
||||||
|
len : integer;
|
||||||
|
begin
|
||||||
|
Len := length(RxBinaryIdent);
|
||||||
|
setlength(s,len);
|
||||||
|
if (AStream.Read (s[1],len) = len)
|
||||||
|
and (s=RxBinaryIdent) then
|
||||||
|
Result := True
|
||||||
|
else
|
||||||
|
Result := False;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterDatapacketReader(TBinaryRxDatapacketReader,dfBinary);
|
||||||
|
end.
|
||||||
|
|
||||||
139
components/rx/ex_rx_datapacket.pas
Normal file
139
components/rx/ex_rx_datapacket.pas
Normal file
@ -0,0 +1,139 @@
|
|||||||
|
unit ex_rx_datapacket;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils,db;
|
||||||
|
|
||||||
|
type
|
||||||
|
TRowStateValue = (rsvOriginal, rsvDeleted, rsvInserted, rsvUpdated, rsvDetailUpdates);
|
||||||
|
TRowState = set of TRowStateValue;
|
||||||
|
|
||||||
|
type
|
||||||
|
TRxDataPacketFormat = (dfBinary,dfXML,dfXMLUTF8,dfAny);
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TRxDatapacketReader }
|
||||||
|
|
||||||
|
TRxDatapacketReaderClass = class of TRxDatapacketReader;
|
||||||
|
TRxDatapacketReader = class(TObject)
|
||||||
|
FStream : TStream;
|
||||||
|
protected
|
||||||
|
class function RowStateToByte(const ARowState : TRowState) : byte;
|
||||||
|
class function ByteToRowState(const AByte : Byte) : TRowState;
|
||||||
|
public
|
||||||
|
constructor create(AStream : TStream); virtual;
|
||||||
|
// Load a dataset from stream:
|
||||||
|
// Load the field-definitions from a stream.
|
||||||
|
procedure LoadFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
|
||||||
|
// Is called before the records are loaded
|
||||||
|
procedure InitLoadRecords; virtual; abstract;
|
||||||
|
// Return the RowState of the current record, and the order of the update
|
||||||
|
function GetRecordRowState(out AUpdOrder : Integer) : TRowState; virtual; abstract;
|
||||||
|
// Returns if there is at least one more record available in the stream
|
||||||
|
function GetCurrentRecord : boolean; virtual; abstract;
|
||||||
|
// Store a record from stream in the current record-buffer
|
||||||
|
procedure RestoreRecord(ADataset : TDataset); virtual; abstract;
|
||||||
|
// Move the stream to the next record
|
||||||
|
procedure GotoNextRecord; virtual; abstract;
|
||||||
|
|
||||||
|
// Store a dataset to stream:
|
||||||
|
// Save the field-definitions to a stream.
|
||||||
|
procedure StoreFieldDefs(AFieldDefs : TFieldDefs); virtual; abstract;
|
||||||
|
// Save a record from the current record-buffer to the stream
|
||||||
|
procedure StoreRecord(ADataset : TDataset; ARowState : TRowState; AUpdOrder : integer = 0); virtual; abstract;
|
||||||
|
// Is called after all records are stored
|
||||||
|
procedure FinalizeStoreRecords; virtual; abstract;
|
||||||
|
// Checks if the provided stream is of the right format for this class
|
||||||
|
class function RecognizeStream(AStream : TStream) : boolean; virtual; abstract;
|
||||||
|
property Stream: TStream read FStream;
|
||||||
|
end;
|
||||||
|
|
||||||
|
type
|
||||||
|
TRxDatapacketReaderRegistration = record
|
||||||
|
ReaderClass : TRxDatapacketReaderClass;
|
||||||
|
Format : TRxDatapacketFormat;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetRegisterDatapacketReader(AStream : TStream; AFormat : TRxDatapacketFormat; var ADataReaderClass : TRxDatapacketReaderRegistration) : boolean;
|
||||||
|
procedure RegisterDatapacketReader(ADatapacketReaderClass : TRxDatapacketReaderClass; AFormat : TRxDatapacketFormat);
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
var
|
||||||
|
RxRegisteredDatapacketReaders : Array of TRxDatapacketReaderRegistration;
|
||||||
|
|
||||||
|
|
||||||
|
function GetRegisterDatapacketReader(AStream: TStream;
|
||||||
|
AFormat: TRxDatapacketFormat;
|
||||||
|
var ADataReaderClass: TRxDatapacketReaderRegistration): boolean;
|
||||||
|
var i : integer;
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
for i := 0 to length(RxRegisteredDatapacketReaders)-1 do if ((AFormat=dfAny) or (AFormat=RxRegisteredDatapacketReaders[i].Format)) then
|
||||||
|
begin
|
||||||
|
|
||||||
|
if (AStream <> nil) then
|
||||||
|
AStream.Seek(0,soFromBeginning); // ensure at start of stream to check value
|
||||||
|
|
||||||
|
if (AStream=nil) or (RxRegisteredDatapacketReaders[i].ReaderClass.RecognizeStream(AStream)) then
|
||||||
|
begin
|
||||||
|
ADataReaderClass := RxRegisteredDatapacketReaders[i];
|
||||||
|
Result := True;
|
||||||
|
if (AStream <> nil) then
|
||||||
|
AStream.Seek(0,soFromBeginning);
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure RegisterDatapacketReader(
|
||||||
|
ADatapacketReaderClass: TRxDatapacketReaderClass; AFormat: TRxDatapacketFormat
|
||||||
|
);
|
||||||
|
begin
|
||||||
|
setlength(RxRegisteredDatapacketReaders,length(RxRegisteredDatapacketReaders)+1);
|
||||||
|
with RxRegisteredDatapacketReaders[length(RxRegisteredDatapacketReaders)-1] do
|
||||||
|
begin
|
||||||
|
Readerclass := ADatapacketReaderClass;
|
||||||
|
Format := AFormat;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TRxDatapacketReader }
|
||||||
|
|
||||||
|
class function TRxDatapacketReader.RowStateToByte(const ARowState: TRowState
|
||||||
|
): byte;
|
||||||
|
var RowStateInt : Byte;
|
||||||
|
begin
|
||||||
|
RowStateInt:=0;
|
||||||
|
if rsvOriginal in ARowState then RowStateInt := RowStateInt+1;
|
||||||
|
if rsvDeleted in ARowState then RowStateInt := RowStateInt+2;
|
||||||
|
if rsvInserted in ARowState then RowStateInt := RowStateInt+4;
|
||||||
|
if rsvUpdated in ARowState then RowStateInt := RowStateInt+8;
|
||||||
|
Result := RowStateInt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TRxDatapacketReader.ByteToRowState(const AByte: Byte
|
||||||
|
): TRowState;
|
||||||
|
begin
|
||||||
|
result := [];
|
||||||
|
if (AByte and 1)=1 then Result := Result+[rsvOriginal];
|
||||||
|
if (AByte and 2)=2 then Result := Result+[rsvDeleted];
|
||||||
|
if (AByte and 4)=4 then Result := Result+[rsvInserted];
|
||||||
|
if (AByte and 8)=8 then Result := Result+[rsvUpdated];
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TRxDatapacketReader.create(AStream: TStream);
|
||||||
|
begin
|
||||||
|
FStream := AStream;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
setlength(RxRegisteredDatapacketReaders,0);
|
||||||
|
finalization
|
||||||
|
setlength(RxRegisteredDatapacketReaders,0);
|
||||||
|
end.
|
||||||
|
|
||||||
405
components/rx/ex_rx_xml_datapacket.pas
Normal file
405
components/rx/ex_rx_xml_datapacket.pas
Normal file
@ -0,0 +1,405 @@
|
|||||||
|
{
|
||||||
|
TXMLRxDatapacketReader implementation
|
||||||
|
|
||||||
|
See the file COPYING.FPC, included in this distribution,
|
||||||
|
for details about the copyright.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||||
|
|
||||||
|
**********************************************************************}
|
||||||
|
|
||||||
|
unit ex_rx_xml_datapacket;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, dom, db, ex_rx_datapacket;
|
||||||
|
|
||||||
|
type
|
||||||
|
TChangeLogEntry = record
|
||||||
|
UpdateKind : TUpdateKind;
|
||||||
|
OrigEntry : integer;
|
||||||
|
NewEntry : integer;
|
||||||
|
end;
|
||||||
|
TChangeLogEntryArr = array of TChangeLogEntry;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ TXMLRxDatapacketReader }
|
||||||
|
|
||||||
|
TXMLRxDatapacketReader = class(TRxDataPacketReader)
|
||||||
|
XMLDocument : TXMLDocument;
|
||||||
|
DataPacketNode : TDOMElement;
|
||||||
|
MetaDataNode : TDOMNode;
|
||||||
|
FieldsNode : TDOMNode;
|
||||||
|
FChangeLogNode,
|
||||||
|
FParamsNode,
|
||||||
|
FRowDataNode,
|
||||||
|
FRecordNode : TDOMNode;
|
||||||
|
FChangeLog : TChangeLogEntryArr;
|
||||||
|
FEntryNr : integer;
|
||||||
|
FLastChange : integer;
|
||||||
|
public
|
||||||
|
destructor destroy; override;
|
||||||
|
procedure StoreFieldDefs(AFieldDefs : TFieldDefs); override;
|
||||||
|
procedure StoreRecord(ADataset : TDataset; ARowState : TRowState; AUpdOrder : integer = 0); override;
|
||||||
|
procedure FinalizeStoreRecords; override;
|
||||||
|
procedure LoadFieldDefs(AFieldDefs : TFieldDefs); override;
|
||||||
|
procedure InitLoadRecords; override;
|
||||||
|
function GetCurrentRecord : boolean; override;
|
||||||
|
function GetRecordRowState(out AUpdOrder : Integer) : TRowState; override;
|
||||||
|
procedure RestoreRecord(ADataset : TDataset); override;
|
||||||
|
procedure GotoNextRecord; override;
|
||||||
|
class function RecognizeStream(AStream : TStream) : boolean; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
uses xmlwrite, xmlread, rxdconst;
|
||||||
|
|
||||||
|
const
|
||||||
|
XMLFieldtypenames : Array [TFieldType] of String[15] =
|
||||||
|
(
|
||||||
|
'Unknown',
|
||||||
|
'string',
|
||||||
|
'i2',
|
||||||
|
'i4',
|
||||||
|
'i4',
|
||||||
|
'boolean',
|
||||||
|
'r8',
|
||||||
|
'r8',
|
||||||
|
'fixed',
|
||||||
|
'date',
|
||||||
|
'time',
|
||||||
|
'datetime',
|
||||||
|
'bin.hex',
|
||||||
|
'bin.hex',
|
||||||
|
'i4',
|
||||||
|
'bin.hex',
|
||||||
|
'bin.hex',
|
||||||
|
'bin.hex',
|
||||||
|
'bin.hex',
|
||||||
|
'bin.hex',
|
||||||
|
'bin.hex',
|
||||||
|
'bin.hex',
|
||||||
|
'',
|
||||||
|
'string',
|
||||||
|
'string',
|
||||||
|
'i8',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
'',
|
||||||
|
''
|
||||||
|
);
|
||||||
|
|
||||||
|
|
||||||
|
{ TXMLRxDatapacketReader }
|
||||||
|
|
||||||
|
destructor TXMLRxDatapacketReader.destroy;
|
||||||
|
begin
|
||||||
|
FieldsNode.Free;
|
||||||
|
MetaDataNode.Free;
|
||||||
|
DataPacketNode.Free;
|
||||||
|
XMLDocument.Free;
|
||||||
|
inherited destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
// Actually does a lot more than just loading the field defs...
|
||||||
|
procedure TXMLRxDatapacketReader.LoadFieldDefs(AFieldDefs : TFieldDefs);
|
||||||
|
|
||||||
|
function GetNodeAttribute(const aNode : TDOMNode; AttName : String) : string;
|
||||||
|
var AnAttr : TDomNode;
|
||||||
|
begin
|
||||||
|
AnAttr := ANode.Attributes.GetNamedItem(AttName);
|
||||||
|
if assigned(AnAttr) then result := AnAttr.NodeValue
|
||||||
|
else result := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
var i : integer;
|
||||||
|
AFieldDef : TFieldDef;
|
||||||
|
iFieldType : TFieldType;
|
||||||
|
FTString : string;
|
||||||
|
AFieldNode : TDOMNode;
|
||||||
|
bLoadFieldDefs : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
|
||||||
|
// if we already have field defs then don't reload from the file
|
||||||
|
bLoadFieldDefs := (AFieldDefs.Count = 0);
|
||||||
|
|
||||||
|
|
||||||
|
ReadXMLFile(XMLDocument,Stream);
|
||||||
|
DataPacketNode := XMLDocument.FindNode('DATAPACKET') as TDOMElement;
|
||||||
|
if not assigned(DataPacketNode) then DatabaseError(sUnknownXMLDatasetFormat);
|
||||||
|
|
||||||
|
MetaDataNode := DataPacketNode.FindNode('METADATA');
|
||||||
|
if not assigned(MetaDataNode) then DatabaseError(sUnknownXMLDatasetFormat);
|
||||||
|
|
||||||
|
FieldsNode := MetaDataNode.FindNode('FIELDS');
|
||||||
|
if not assigned(FieldsNode) then DatabaseError(sUnknownXMLDatasetFormat);
|
||||||
|
|
||||||
|
if bLoadFieldDefs then
|
||||||
|
begin
|
||||||
|
with FieldsNode.ChildNodes do for i := 0 to Count - 1 do
|
||||||
|
begin
|
||||||
|
AFieldNode := item[i];
|
||||||
|
if AFieldNode.CompareName('FIELD')=0 then
|
||||||
|
begin
|
||||||
|
AFieldDef := TFieldDef.create(AFieldDefs);
|
||||||
|
AFieldDef.DisplayName:=GetNodeAttribute(AFieldNode,'fieldname');
|
||||||
|
AFieldDef.Name:=GetNodeAttribute(AFieldNode,'attrname');
|
||||||
|
AFieldDef.Size:=StrToIntDef(GetNodeAttribute(AFieldNode,'width'),0);
|
||||||
|
FTString:=GetNodeAttribute(AFieldNode,'fieldtype');
|
||||||
|
|
||||||
|
AFieldDef.DataType:=ftUnknown;
|
||||||
|
for iFieldType:=low(TFieldType) to high(TFieldType) do
|
||||||
|
if SameText(XMLFieldtypenames[iFieldType],FTString) then
|
||||||
|
begin
|
||||||
|
AFieldDef.DataType:=iFieldType;
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FChangeLogNode := MetaDataNode.FindNode('PARAMS');
|
||||||
|
if assigned(FChangeLogNode) then
|
||||||
|
FChangeLogNode := FChangeLogNode.Attributes.GetNamedItem('CHANGE_LOG');
|
||||||
|
|
||||||
|
FRowDataNode := DataPacketNode.FindNode('ROWDATA');
|
||||||
|
FRecordNode := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TXMLRxDatapacketReader.StoreFieldDefs(AFieldDefs: TFieldDefs);
|
||||||
|
|
||||||
|
var i : integer;
|
||||||
|
AFieldNode : TDOMElement;
|
||||||
|
|
||||||
|
begin
|
||||||
|
XMLDocument := TXMLDocument.Create;
|
||||||
|
DataPacketNode := XMLDocument.CreateElement('DATAPACKET');
|
||||||
|
DataPacketNode.SetAttribute('Version','2.0');
|
||||||
|
|
||||||
|
MetaDataNode := XMLDocument.CreateElement('METADATA');
|
||||||
|
FieldsNode := XMLDocument.CreateElement('FIELDS');
|
||||||
|
|
||||||
|
for i := 0 to AFieldDefs.Count -1 do with AFieldDefs[i] do
|
||||||
|
begin
|
||||||
|
AFieldNode := XMLDocument.CreateElement('FIELD');
|
||||||
|
if Name <> '' then AFieldNode.SetAttribute('fieldname',Name);
|
||||||
|
AFieldNode.SetAttribute('attrname',DisplayName);
|
||||||
|
if size <> 0 then AFieldNode.SetAttribute('width',IntToStr(Size));
|
||||||
|
AFieldNode.SetAttribute('fieldtype',XMLFieldtypenames[DataType]);
|
||||||
|
case DataType of
|
||||||
|
ftAutoInc : begin
|
||||||
|
AFieldNode.SetAttribute('readonly','true');
|
||||||
|
AFieldNode.SetAttribute('subtype','Autoinc');
|
||||||
|
end;
|
||||||
|
ftCurrency: AFieldNode.SetAttribute('subtype','Money');
|
||||||
|
ftVarBytes,
|
||||||
|
ftBlob : AFieldNode.SetAttribute('subtype','Binary');
|
||||||
|
ftMemo : AFieldNode.SetAttribute('subtype','Text');
|
||||||
|
ftTypedBinary,
|
||||||
|
ftGraphic: AFieldNode.SetAttribute('subtype','Graphics');
|
||||||
|
ftFmtMemo : AFieldNode.SetAttribute('subtype','Formatted');
|
||||||
|
ftParadoxOle,
|
||||||
|
ftDBaseOle : AFieldNode.SetAttribute('subtype','Ole');
|
||||||
|
end; {case}
|
||||||
|
if faReadonly in Attributes then AFieldNode.SetAttribute('readonly','true');
|
||||||
|
|
||||||
|
FieldsNode.AppendChild(AFieldNode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
MetaDataNode.AppendChild(FieldsNode);
|
||||||
|
FParamsNode := XMLDocument.CreateElement('PARAMS');
|
||||||
|
MetaDataNode.AppendChild(FParamsNode);
|
||||||
|
DataPacketNode.AppendChild(MetaDataNode);
|
||||||
|
FRowDataNode := XMLDocument.CreateElement('ROWDATA');
|
||||||
|
setlength(FChangeLog,0);
|
||||||
|
FEntryNr:=0;
|
||||||
|
FLastChange:=-1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TXMLRxDatapacketReader.FinalizeStoreRecords;
|
||||||
|
var ChangeLogStr : String;
|
||||||
|
i : integer;
|
||||||
|
begin
|
||||||
|
ChangeLogStr:='';
|
||||||
|
for i := 0 to length(FChangeLog)-1 do with FChangeLog[i] do
|
||||||
|
begin
|
||||||
|
ChangeLogStr:=ChangeLogStr+' '+inttostr(NewEntry)+' '+inttostr(OrigEntry)+' ';
|
||||||
|
if UpdateKind=ukModify then ChangeLogStr := ChangeLogStr+'8';
|
||||||
|
if UpdateKind=ukInsert then ChangeLogStr := ChangeLogStr+'4';
|
||||||
|
if UpdateKind=ukDelete then ChangeLogStr := ChangeLogStr+'2';
|
||||||
|
end;
|
||||||
|
setlength(FChangeLog,0);
|
||||||
|
|
||||||
|
if ChangeLogStr<>'' then
|
||||||
|
(FParamsNode as TDomElement).SetAttribute('CHANGE_LOG',Trim(ChangeLogStr));
|
||||||
|
|
||||||
|
DataPacketNode.AppendChild(FRowDataNode);
|
||||||
|
XMLDocument.AppendChild(DataPacketNode);
|
||||||
|
|
||||||
|
WriteXML(XMLDocument,Stream);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLRxDatapacketReader.GetCurrentRecord: boolean;
|
||||||
|
begin
|
||||||
|
Result := assigned(FRecordNode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLRxDatapacketReader.GetRecordRowState(out AUpdOrder: Integer
|
||||||
|
): TRowState;
|
||||||
|
var ARowStateNode : TDOmNode;
|
||||||
|
ARowState : integer;
|
||||||
|
i : integer;
|
||||||
|
begin
|
||||||
|
ARowStateNode := FRecordNode.Attributes.GetNamedItem('RowState');
|
||||||
|
if ARowStateNode = nil then // This item is not edited
|
||||||
|
Result := []
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
Result := ByteToRowState(StrToIntDef(ARowStateNode.NodeValue,0));
|
||||||
|
if Result = [rsvOriginal] then
|
||||||
|
begin
|
||||||
|
for i := 0 to length(FChangeLog)-1 do
|
||||||
|
if FChangeLog[i].NewEntry=FEntryNr then break;
|
||||||
|
assert(FChangeLog[i].NewEntry=FEntryNr);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
for i := 0 to length(FChangeLog)-1 do
|
||||||
|
if FChangeLog[i].OrigEntry=FEntryNr then break;
|
||||||
|
assert(FChangeLog[i].OrigEntry=FEntryNr);
|
||||||
|
end;
|
||||||
|
AUpdOrder:=i;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TXMLRxDatapacketReader.InitLoadRecords;
|
||||||
|
|
||||||
|
var ChangeLogStr : String;
|
||||||
|
i,cp : integer;
|
||||||
|
ps : string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FRecordNode := FRowDataNode.FirstChild;
|
||||||
|
FEntryNr := 1;
|
||||||
|
setlength(FChangeLog,0);
|
||||||
|
if assigned(FChangeLogNode) then
|
||||||
|
ChangeLogStr:=FChangeLogNode.NodeValue
|
||||||
|
else
|
||||||
|
ChangeLogStr:='';
|
||||||
|
ps := '';
|
||||||
|
cp := 0;
|
||||||
|
if ChangeLogStr<>'' then for i := 1 to length(ChangeLogStr)+1 do
|
||||||
|
begin
|
||||||
|
if not (ChangeLogStr[i] in [' ',#0]) then
|
||||||
|
ps := ps + ChangeLogStr[i]
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
case (cp mod 3) of
|
||||||
|
0 : begin
|
||||||
|
SetLength(FChangeLog,length(FChangeLog)+1);
|
||||||
|
FChangeLog[cp div 3].OrigEntry:=StrToIntDef(ps,0);
|
||||||
|
end;
|
||||||
|
1 : FChangeLog[cp div 3].NewEntry:=StrToIntDef(ps,0);
|
||||||
|
2 : begin
|
||||||
|
if ps = '2' then
|
||||||
|
FChangeLog[cp div 3].UpdateKind:=ukDelete
|
||||||
|
else if ps = '4' then
|
||||||
|
FChangeLog[cp div 3].UpdateKind:=ukInsert
|
||||||
|
else if ps = '8' then
|
||||||
|
FChangeLog[cp div 3].UpdateKind:=ukModify;
|
||||||
|
end;
|
||||||
|
end; {case}
|
||||||
|
ps := '';
|
||||||
|
inc(cp);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TXMLRxDatapacketReader.RestoreRecord(ADataset : TDataset);
|
||||||
|
var FieldNr : integer;
|
||||||
|
AFieldNode : TDomNode;
|
||||||
|
begin
|
||||||
|
with ADataset do for FieldNr:=0 to FieldCount-1 do
|
||||||
|
begin
|
||||||
|
AFieldNode := FRecordNode.Attributes.GetNamedItem(Fields[FieldNr].FieldName);
|
||||||
|
if assigned(AFieldNode) then
|
||||||
|
begin
|
||||||
|
Fields[FieldNr].AsString := AFieldNode.NodeValue; // set it to the filterbuffer
|
||||||
|
end
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TXMLRxDatapacketReader.StoreRecord(ADataset : TDataset; ARowState : TRowState; AUpdOrder : integer = 0);
|
||||||
|
var FieldNr : Integer;
|
||||||
|
ARecordNode : TDOMElement;
|
||||||
|
begin
|
||||||
|
inc(FEntryNr);
|
||||||
|
ARecordNode := XMLDocument.CreateElement('ROW');
|
||||||
|
for FieldNr := 0 to ADataset.Fields.Count-1 do
|
||||||
|
begin
|
||||||
|
ARecordNode.SetAttribute(ADataset.fields[FieldNr].FieldName,ADataset.fields[FieldNr].AsString);
|
||||||
|
end;
|
||||||
|
if ARowState<>[] then
|
||||||
|
begin
|
||||||
|
ARecordNode.SetAttribute('RowState',inttostr(RowStateToByte(ARowState)));
|
||||||
|
if AUpdOrder>=length(FChangeLog) then
|
||||||
|
setlength(FChangeLog,AUpdOrder+1);
|
||||||
|
if (rsvOriginal in ARowState) or (rsvDeleted in ARowState) then
|
||||||
|
FChangeLog[AUpdOrder].OrigEntry:=FEntryNr;
|
||||||
|
if (rsvDeleted in ARowState) or (rsvUpdated in ARowState) or (rsvInserted in ARowState) then
|
||||||
|
FChangeLog[AUpdOrder].NewEntry:=FEntryNr;
|
||||||
|
if ARowState=[rsvUpdated] then
|
||||||
|
FChangeLog[AUpdOrder].UpdateKind := ukModify;
|
||||||
|
if ARowState=[rsvInserted] then
|
||||||
|
FChangeLog[AUpdOrder].UpdateKind := ukInsert;
|
||||||
|
if ARowState=[rsvDeleted] then
|
||||||
|
FChangeLog[AUpdOrder].UpdateKind := ukDelete;
|
||||||
|
end;
|
||||||
|
FRowDataNode.AppendChild(ARecordNode);
|
||||||
|
end;
|
||||||
|
|
||||||
|
class function TXMLRxDatapacketReader.RecognizeStream(AStream: TStream): boolean;
|
||||||
|
const XmlStart = '<?xml';
|
||||||
|
var s : string;
|
||||||
|
len : integer;
|
||||||
|
begin
|
||||||
|
Len := length(XmlStart);
|
||||||
|
setlength(s,len);
|
||||||
|
if (AStream.Read (s[1],len) = len)
|
||||||
|
and (s=XmlStart) then
|
||||||
|
Result := True
|
||||||
|
else
|
||||||
|
Result := False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TXMLRxDatapacketReader.GotoNextRecord;
|
||||||
|
begin
|
||||||
|
FRecordNode := FRecordNode.NextSibling;
|
||||||
|
inc(FEntryNr);
|
||||||
|
while assigned(FRecordNode) and (FRecordNode.CompareName('ROW')<>0) do
|
||||||
|
FRecordNode := FRecordNode.NextSibling;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
RegisterDatapacketReader(TXMLRxDatapacketReader,dfXML);
|
||||||
|
end.
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
@ -407,6 +407,10 @@ msgstr "buscar"
|
|||||||
msgid "SUnknownFieldType %s"
|
msgid "SUnknownFieldType %s"
|
||||||
msgstr "STipoCampoDesconocido %s"
|
msgstr "STipoCampoDesconocido %s"
|
||||||
|
|
||||||
|
#: rxdconst.sunknownxmldatasetformat
|
||||||
|
msgid "Unknown XML Dataset format"
|
||||||
|
msgstr ""
|
||||||
|
|
||||||
#: rxdconst.sunlockcaption
|
#: rxdconst.sunlockcaption
|
||||||
msgid "Unloock"
|
msgid "Unloock"
|
||||||
msgstr "Desbloquear"
|
msgstr "Desbloquear"
|
||||||
|
|||||||
@ -405,6 +405,10 @@ msgstr ""
|
|||||||
msgid "SUnknownFieldType %s"
|
msgid "SUnknownFieldType %s"
|
||||||
msgstr ""
|
msgstr ""
|
||||||
|
|
||||||
|
#: rxdconst.sunknownxmldatasetformat
|
||||||
|
msgid "Unknown XML Dataset format"
|
||||||
|
msgstr ""
|
||||||
|
|
||||||
#: rxdconst.sunlockcaption
|
#: rxdconst.sunlockcaption
|
||||||
msgid "Unloock"
|
msgid "Unloock"
|
||||||
msgstr ""
|
msgstr ""
|
||||||
|
|||||||
@ -23,7 +23,7 @@ msgstr "Изменить пароль"
|
|||||||
|
|
||||||
#: rxdconst.scirculardatalink
|
#: rxdconst.scirculardatalink
|
||||||
msgid "SCircularDataLink"
|
msgid "SCircularDataLink"
|
||||||
msgstr ""
|
msgstr "Перекрёстная ссылка данных"
|
||||||
|
|
||||||
#: rxdconst.sconfirmpasswordlabel
|
#: rxdconst.sconfirmpasswordlabel
|
||||||
msgid "&Confirm:"
|
msgid "&Confirm:"
|
||||||
@ -43,7 +43,7 @@ msgstr ""
|
|||||||
|
|
||||||
#: rxdconst.sdbcomboboxfieldnotassigned
|
#: rxdconst.sdbcomboboxfieldnotassigned
|
||||||
msgid "%s:TDBComboBox - DataField not assigned"
|
msgid "%s:TDBComboBox - DataField not assigned"
|
||||||
msgstr ""
|
msgstr "%s:TDBComboBox - Не присвоено свойство DataField"
|
||||||
|
|
||||||
#: rxdconst.sdbexceptcaption
|
#: rxdconst.sdbexceptcaption
|
||||||
msgid "Error in DB engine"
|
msgid "Error in DB engine"
|
||||||
@ -111,7 +111,7 @@ msgstr "Ошибка в окончании выражения фильтра"
|
|||||||
|
|
||||||
#: rxdconst.sfieldreadonly
|
#: rxdconst.sfieldreadonly
|
||||||
msgid "SFieldReadOnly %s"
|
msgid "SFieldReadOnly %s"
|
||||||
msgstr ""
|
msgstr "Поле %s только для чтения"
|
||||||
|
|
||||||
#: rxdconst.sfieldrequired
|
#: rxdconst.sfieldrequired
|
||||||
msgid "Field '%s' must have a value"
|
msgid "Field '%s' must have a value"
|
||||||
@ -386,8 +386,6 @@ msgid "&Selected fields:"
|
|||||||
msgstr "&Выбранные поля"
|
msgstr "&Выбранные поля"
|
||||||
|
|
||||||
#: rxdconst.srxsortbyformsortorder
|
#: rxdconst.srxsortbyformsortorder
|
||||||
#, fuzzy
|
|
||||||
#| msgid "Select field for sort data:"
|
|
||||||
msgid "Select f&ield for sort data:"
|
msgid "Select f&ield for sort data:"
|
||||||
msgstr "Укажите поля для сортировки данных :"
|
msgstr "Укажите поля для сортировки данных :"
|
||||||
|
|
||||||
@ -405,7 +403,11 @@ msgstr "поиск"
|
|||||||
|
|
||||||
#: rxdconst.sunknownfieldtype
|
#: rxdconst.sunknownfieldtype
|
||||||
msgid "SUnknownFieldType %s"
|
msgid "SUnknownFieldType %s"
|
||||||
msgstr ""
|
msgstr "Не определён тип данных для поля %s"
|
||||||
|
|
||||||
|
#: rxdconst.sunknownxmldatasetformat
|
||||||
|
msgid "Unknown XML Dataset format"
|
||||||
|
msgstr "Не известный формат XML данных"
|
||||||
|
|
||||||
#: rxdconst.sunlockcaption
|
#: rxdconst.sunlockcaption
|
||||||
msgid "Unloock"
|
msgid "Unloock"
|
||||||
|
|||||||
@ -160,6 +160,8 @@ resourcestring
|
|||||||
sRxCopyOnlyMetadata = 'Copy only metadata';
|
sRxCopyOnlyMetadata = 'Copy only metadata';
|
||||||
sRxSourseDataset = 'Sourse dataset';
|
sRxSourseDataset = 'Sourse dataset';
|
||||||
|
|
||||||
|
sUnknownXMLDatasetFormat = 'Unknown XML Dataset format';
|
||||||
|
|
||||||
const
|
const
|
||||||
{ The following strings should not be localized }
|
{ The following strings should not be localized }
|
||||||
sAction = '.Action';
|
sAction = '.Action';
|
||||||
|
|||||||
@ -37,7 +37,7 @@ unit rxmemds;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
|
|
||||||
uses SysUtils, Classes, DB;
|
uses SysUtils, Classes, DB, ex_rx_datapacket;
|
||||||
|
|
||||||
{ TRxMemoryData }
|
{ TRxMemoryData }
|
||||||
|
|
||||||
@ -67,6 +67,19 @@ type
|
|||||||
FIndexList: TList;
|
FIndexList: TList;
|
||||||
FCaseInsensitiveSort: Boolean;
|
FCaseInsensitiveSort: Boolean;
|
||||||
FDescendingSort: Boolean;
|
FDescendingSort: Boolean;
|
||||||
|
|
||||||
|
FFileName: string;
|
||||||
|
FFileStream : TFileStream;
|
||||||
|
FDatasetReader : TRxDataPacketReader;
|
||||||
|
FPacketRecords: Integer;
|
||||||
|
FFilterBuffer : pchar;
|
||||||
|
FNullmaskSize : byte;
|
||||||
|
FBRecordCount : integer;
|
||||||
|
function IntAllocRecordBuffer: PChar;
|
||||||
|
procedure IntLoadFielddefsFromFile;
|
||||||
|
procedure IntLoadRecordsFromFile;
|
||||||
|
procedure SetPacketRecords(const AValue: Integer);
|
||||||
|
|
||||||
function AddRecord: TMemoryRecord;
|
function AddRecord: TMemoryRecord;
|
||||||
procedure CopyRecord(RecordData, Buffer: PChar);
|
procedure CopyRecord(RecordData, Buffer: PChar);
|
||||||
function GetOnFilterRecordEx: TFilterRecordEvent;
|
function GetOnFilterRecordEx: TFilterRecordEvent;
|
||||||
@ -98,9 +111,9 @@ type
|
|||||||
procedure SetBlobData(Field: TField; Buffer: PChar; Value: TMemBlobData);
|
procedure SetBlobData(Field: TField; Buffer: PChar; Value: TMemBlobData);
|
||||||
function AllocRecordBuffer: PChar; override;
|
function AllocRecordBuffer: PChar; override;
|
||||||
procedure FreeRecordBuffer(var Buffer: PChar); override;
|
procedure FreeRecordBuffer(var Buffer: PChar); override;
|
||||||
function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean; //override;
|
function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean;
|
||||||
function CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
|
function CurrToBCD(const Curr: Currency; BCD: Pointer;
|
||||||
Decimals: Integer): Boolean; //override;
|
Precision, Decimals: Integer): Boolean;
|
||||||
procedure InternalInitRecord(Buffer: PChar); override;
|
procedure InternalInitRecord(Buffer: PChar); override;
|
||||||
procedure ClearCalcFields(Buffer: PChar); override;
|
procedure ClearCalcFields(Buffer: PChar); override;
|
||||||
function GetRecord(Buffer: PChar; GetMode: TGetMode;
|
function GetRecord(Buffer: PChar; GetMode: TGetMode;
|
||||||
@ -153,6 +166,13 @@ type
|
|||||||
Mode: TLoadMode): Integer;
|
Mode: TLoadMode): Integer;
|
||||||
function SaveToDataSet(Dest: TDataSet; ARecordCount: Integer): Integer;
|
function SaveToDataSet(Dest: TDataSet; ARecordCount: Integer): Integer;
|
||||||
procedure AppendRecord(const Values: array of const);
|
procedure AppendRecord(const Values: array of const);
|
||||||
|
|
||||||
|
procedure SetDatasetPacket(AReader : TRxDataPacketReader);
|
||||||
|
procedure GetDatasetPacket(AWriter : TRxDataPacketReader);
|
||||||
|
procedure LoadFromStream(AStream : TStream; Format: TRxDataPacketFormat = dfBinary);
|
||||||
|
procedure SaveToStream(AStream : TStream; Format: TRxDataPacketFormat = dfBinary);
|
||||||
|
procedure LoadFromFile(AFileName: string = ''; Format: TRxDataPacketFormat = dfAny);
|
||||||
|
procedure SaveToFile(AFileName: string = ''; Format: TRxDataPacketFormat = dfAny);
|
||||||
published
|
published
|
||||||
property Capacity: Integer read GetCapacity write SetCapacity default 0;
|
property Capacity: Integer read GetCapacity write SetCapacity default 0;
|
||||||
property Active;
|
property Active;
|
||||||
@ -183,6 +203,9 @@ type
|
|||||||
property OnFilterRecordEx: TFilterRecordEvent read GetOnFilterRecordEx write SetOnFilterRecordEx;
|
property OnFilterRecordEx: TFilterRecordEvent read GetOnFilterRecordEx write SetOnFilterRecordEx;
|
||||||
property OnNewRecord;
|
property OnNewRecord;
|
||||||
property OnPostError;
|
property OnPostError;
|
||||||
|
|
||||||
|
property FileName : string read FFileName write FFileName;
|
||||||
|
property PacketRecords : Integer read FPacketRecords write SetPacketRecords default 10;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TMemBlobStream }
|
{ TMemBlobStream }
|
||||||
@ -1221,13 +1244,6 @@ begin
|
|||||||
BindFields(True);
|
BindFields(True);
|
||||||
InitBufferPointers(True);
|
InitBufferPointers(True);
|
||||||
InternalFirst;
|
InternalFirst;
|
||||||
// OpenCursor(false);
|
|
||||||
// ������ ����� ����������� ���� � �������� ������ ���������� � ������ FieldDefs
|
|
||||||
{ Fields.Clear;
|
|
||||||
CreateFields;
|
|
||||||
if DefaultFields then CreateFields;
|
|
||||||
BindFields(True);}
|
|
||||||
//
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRxMemoryData.InternalClose;
|
procedure TRxMemoryData.InternalClose;
|
||||||
@ -1243,7 +1259,6 @@ end;
|
|||||||
procedure TRxMemoryData.InternalHandleException;
|
procedure TRxMemoryData.InternalHandleException;
|
||||||
begin
|
begin
|
||||||
CustomApplication.HandleException(Self);
|
CustomApplication.HandleException(Self);
|
||||||
//Application.HandleException(Self);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRxMemoryData.InternalInitFieldDefs;
|
procedure TRxMemoryData.InternalInitFieldDefs;
|
||||||
@ -1308,7 +1323,6 @@ var
|
|||||||
else
|
else
|
||||||
Result := AnsiCompareStr(S, S1) = 0;
|
Result := AnsiCompareStr(S, S1) = 0;
|
||||||
end
|
end
|
||||||
// else Result := false //(Field.Value = Value);
|
|
||||||
else Result := (Field.Value = Value);
|
else Result := (Field.Value = Value);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1700,6 +1714,199 @@ begin
|
|||||||
FIndexList := nil;
|
FIndexList := nil;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TRxMemoryData.IntAllocRecordBuffer: PChar;
|
||||||
|
begin
|
||||||
|
// do nothing
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxMemoryData.IntLoadFielddefsFromFile;
|
||||||
|
begin
|
||||||
|
FDatasetReader.LoadFielddefs(FieldDefs);
|
||||||
|
if DefaultFields then CreateFields;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxMemoryData.IntLoadRecordsFromFile;
|
||||||
|
var StoreState : TDataSetState;
|
||||||
|
AddRecordBuffer : boolean;
|
||||||
|
ARowState : TRowState;
|
||||||
|
AUpdOrder : integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FDatasetReader.InitLoadRecords;
|
||||||
|
StoreState:=SetTempState(dsFilter);
|
||||||
|
|
||||||
|
while FDatasetReader.GetCurrentRecord do
|
||||||
|
begin
|
||||||
|
ARowState := FDatasetReader.GetRecordRowState(AUpdOrder);
|
||||||
|
|
||||||
|
FDatasetReader.RestoreRecord(self);
|
||||||
|
inc(FBRecordCount);
|
||||||
|
|
||||||
|
FDatasetReader.GotoNextRecord;
|
||||||
|
end;
|
||||||
|
|
||||||
|
RestoreState(StoreState);
|
||||||
|
|
||||||
|
if assigned(FFileStream) then
|
||||||
|
begin
|
||||||
|
FreeAndNil(FFileStream);
|
||||||
|
FreeAndNil(FDatasetReader);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxMemoryData.SetPacketRecords(const AValue: Integer);
|
||||||
|
begin
|
||||||
|
if FPacketRecords=AValue then exit;
|
||||||
|
FPacketRecords:=AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxMemoryData.SetDatasetPacket(AReader: TRxDataPacketReader);
|
||||||
|
var
|
||||||
|
StoreDSState : TDataSetState;
|
||||||
|
ARowState : TRowState;
|
||||||
|
AUpdOrder : integer;
|
||||||
|
begin
|
||||||
|
FDatasetReader := AReader;
|
||||||
|
|
||||||
|
DisableControls;
|
||||||
|
try
|
||||||
|
Filtered := False;
|
||||||
|
|
||||||
|
Close; // must be inactive to do IntLoadFielddefsFromFile
|
||||||
|
// load fields defs
|
||||||
|
IntLoadFielddefsFromFile;
|
||||||
|
|
||||||
|
FreeIndexList;
|
||||||
|
|
||||||
|
if not Active then Open;
|
||||||
|
Resync([]); // clears buffers if empty dataset
|
||||||
|
CheckBrowseMode;
|
||||||
|
|
||||||
|
FDatasetReader.InitLoadRecords;
|
||||||
|
|
||||||
|
try
|
||||||
|
while FDatasetReader.GetCurrentRecord do
|
||||||
|
begin
|
||||||
|
Append;
|
||||||
|
|
||||||
|
ARowState := FDatasetReader.GetRecordRowState(AUpdOrder); // added for binary export
|
||||||
|
|
||||||
|
FDatasetReader.RestoreRecord(TRxMemoryData(Self));
|
||||||
|
|
||||||
|
Post;
|
||||||
|
|
||||||
|
FDatasetReader.GotoNextRecord;
|
||||||
|
inc(FBRecordCount);
|
||||||
|
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
First;
|
||||||
|
end;
|
||||||
|
|
||||||
|
finally
|
||||||
|
EnableControls;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if assigned(FFileStream) then
|
||||||
|
begin
|
||||||
|
FreeAndNil(FFileStream);
|
||||||
|
FreeAndNil(FDatasetReader);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxMemoryData.GetDatasetPacket(AWriter: TRxDataPacketReader);
|
||||||
|
var
|
||||||
|
StoreDSState : TDataSetState;
|
||||||
|
begin
|
||||||
|
|
||||||
|
CheckBrowseMode;
|
||||||
|
UpdateCursorPos;
|
||||||
|
|
||||||
|
FDatasetReader := AWriter;
|
||||||
|
try
|
||||||
|
DisableControls;
|
||||||
|
try
|
||||||
|
|
||||||
|
FDatasetReader.StoreFieldDefs(FieldDefs);
|
||||||
|
|
||||||
|
First;
|
||||||
|
while not EOF do
|
||||||
|
begin
|
||||||
|
// ** NOTE ** had to cast self to TRxMemoryData just save current values
|
||||||
|
// otherwise the as string value in ex_rx_datapacket would not write.
|
||||||
|
FDatasetReader.StoreRecord(TRxMemoryData(Self),[]);
|
||||||
|
Next;
|
||||||
|
end;
|
||||||
|
|
||||||
|
FDatasetReader.FinalizeStoreRecords;
|
||||||
|
finally
|
||||||
|
EnableControls;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FDatasetReader := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxMemoryData.LoadFromStream(AStream: TStream;
|
||||||
|
Format: TRxDataPacketFormat);
|
||||||
|
var APacketReaderReg : TRxDatapacketReaderRegistration;
|
||||||
|
APacketReader : TRxDataPacketReader;
|
||||||
|
begin
|
||||||
|
if GetRegisterDatapacketReader(AStream,format,APacketReaderReg) then
|
||||||
|
APacketReader := APacketReaderReg.ReaderClass.create(AStream)
|
||||||
|
else
|
||||||
|
DatabaseError(SStreamNotRecognised);
|
||||||
|
try
|
||||||
|
SetDatasetPacket(APacketReader);
|
||||||
|
finally
|
||||||
|
APacketReader.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxMemoryData.SaveToStream(AStream: TStream;
|
||||||
|
Format: TRxDataPacketFormat);
|
||||||
|
var APacketReaderReg : TRxDatapacketReaderRegistration;
|
||||||
|
APacketWriter : TRxDataPacketReader;
|
||||||
|
begin
|
||||||
|
if GetRegisterDatapacketReader(Nil,format,APacketReaderReg) then
|
||||||
|
APacketWriter := APacketReaderReg.ReaderClass.create(AStream)
|
||||||
|
else
|
||||||
|
DatabaseError(SNoReaderClassRegistered);
|
||||||
|
try
|
||||||
|
GetDatasetPacket(APacketWriter);
|
||||||
|
finally
|
||||||
|
APacketWriter.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxMemoryData.LoadFromFile(AFileName: string;
|
||||||
|
Format: TRxDataPacketFormat);
|
||||||
|
var AFileStream : TFileStream;
|
||||||
|
begin
|
||||||
|
if AFileName='' then AFileName := FFileName;
|
||||||
|
AFileStream := TFileStream.Create(AFileName,fmOpenRead);
|
||||||
|
try
|
||||||
|
LoadFromStream(AFileStream, Format);
|
||||||
|
finally
|
||||||
|
AFileStream.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TRxMemoryData.SaveToFile(AFileName: string;
|
||||||
|
Format: TRxDataPacketFormat);
|
||||||
|
var AFileStream : TFileStream;
|
||||||
|
begin
|
||||||
|
if AFileName='' then AFileName := FFileName;
|
||||||
|
AFileStream := TFileStream.Create(AFileName,fmCreate);
|
||||||
|
try
|
||||||
|
SaveToStream(AFileStream, Format);
|
||||||
|
finally
|
||||||
|
AFileStream.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
{ TMemBlobStream }
|
{ TMemBlobStream }
|
||||||
|
|
||||||
constructor TMemBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
|
constructor TMemBlobStream.Create(Field: TBlobField; Mode: TBlobStreamMode);
|
||||||
|
|||||||
@ -23,12 +23,11 @@
|
|||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
<Description Value="Delphi VCL Extensions (RX)
|
<Description Value="Delphi VCL Extensions (RX)
|
||||||
Copyright (c) 1998 Master-Bank
|
Copyright (c) 1998 Master-Bank
|
||||||
translate to Lazarus by alexs in 2005 - 2009
|
translate to Lazarus by alexs in 2005 - 2012
|
||||||
"/>
|
"/>
|
||||||
<License Value="free ware
|
<License Value="LGPL"/>
|
||||||
"/>
|
<Version Major="2" Minor="2" Release="1" Build="106"/>
|
||||||
<Version Build="105" Major="2" Minor="1" Release="2"/>
|
<Files Count="64">
|
||||||
<Files Count="61">
|
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="autopanel.pas"/>
|
<Filename Value="autopanel.pas"/>
|
||||||
<UnitName Value="AutoPanel"/>
|
<UnitName Value="AutoPanel"/>
|
||||||
@ -276,8 +275,20 @@ translate to Lazarus by alexs in 2005 - 2009
|
|||||||
<Filename Value="rxhistorynavigator.pas"/>
|
<Filename Value="rxhistorynavigator.pas"/>
|
||||||
<UnitName Value="RxHistoryNavigator"/>
|
<UnitName Value="RxHistoryNavigator"/>
|
||||||
</Item61>
|
</Item61>
|
||||||
|
<Item62>
|
||||||
|
<Filename Value="ex_rx_bin_datapacket.pas"/>
|
||||||
|
<UnitName Value="ex_rx_bin_datapacket"/>
|
||||||
|
</Item62>
|
||||||
|
<Item63>
|
||||||
|
<Filename Value="ex_rx_datapacket.pas"/>
|
||||||
|
<UnitName Value="ex_rx_datapacket"/>
|
||||||
|
</Item63>
|
||||||
|
<Item64>
|
||||||
|
<Filename Value="ex_rx_xml_datapacket.pas"/>
|
||||||
|
<UnitName Value="ex_rx_xml_datapacket"/>
|
||||||
|
</Item64>
|
||||||
</Files>
|
</Files>
|
||||||
<LazDoc Paths="docs\;\usr\local\share\lazarus\components\rxnew\docs\"/>
|
<LazDoc Paths="docs;\usr\local\share\lazarus\components\rxnew\docs"/>
|
||||||
<i18n>
|
<i18n>
|
||||||
<EnableI18N Value="True"/>
|
<EnableI18N Value="True"/>
|
||||||
<OutDir Value="languages"/>
|
<OutDir Value="languages"/>
|
||||||
@ -299,7 +310,7 @@ translate to Lazarus by alexs in 2005 - 2009
|
|||||||
</Item4>
|
</Item4>
|
||||||
</RequiredPkgs>
|
</RequiredPkgs>
|
||||||
<UsageOptions>
|
<UsageOptions>
|
||||||
<UnitPath Value="$(PkgOutDir)\"/>
|
<UnitPath Value="$(PkgOutDir)"/>
|
||||||
</UsageOptions>
|
</UsageOptions>
|
||||||
<PublishOptions>
|
<PublishOptions>
|
||||||
<Version Value="2"/>
|
<Version Value="2"/>
|
||||||
|
|||||||
@ -2,7 +2,7 @@
|
|||||||
This source is only used to compile and install the package.
|
This source is only used to compile and install the package.
|
||||||
}
|
}
|
||||||
|
|
||||||
unit rxnew;
|
unit rxnew;
|
||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
@ -17,17 +17,18 @@ uses
|
|||||||
rxmemds, rxpopupunit, rxsortmemds, rxspin, rxstrutils, rxswitch,
|
rxmemds, rxpopupunit, rxsortmemds, rxspin, rxstrutils, rxswitch,
|
||||||
RxSystemServices, rxtbrsetup, RxTimeEdit, rxtoolbar, RxVersInfo,
|
RxSystemServices, rxtbrsetup, RxTimeEdit, rxtoolbar, RxVersInfo,
|
||||||
RxViewsPanel, rxxpman, seldsfrm, tooledit, vclutils, RxCloseFormValidator,
|
RxViewsPanel, rxxpman, seldsfrm, tooledit, vclutils, RxCloseFormValidator,
|
||||||
RxHistoryNavigator, LazarusPackageIntf;
|
RxHistoryNavigator, ex_rx_bin_datapacket, ex_rx_datapacket,
|
||||||
|
ex_rx_xml_datapacket, LazarusPackageIntf;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
procedure Register;
|
procedure Register;
|
||||||
begin
|
begin
|
||||||
RegisterUnit('registerrx', @registerrx.Register);
|
RegisterUnit('registerrx', @registerrx.Register);
|
||||||
RegisterUnit('RegisterRxDB', @RegisterRxDB.Register);
|
RegisterUnit('RegisterRxDB', @RegisterRxDB.Register);
|
||||||
RegisterUnit('RegisterRxTools', @RegisterRxTools.Register);
|
RegisterUnit('RegisterRxTools', @RegisterRxTools.Register);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
initialization
|
initialization
|
||||||
RegisterPackage('rxnew', @Register);
|
RegisterPackage('rxnew', @Register);
|
||||||
end.
|
end.
|
||||||
|
|||||||
Reference in New Issue
Block a user