From 4bd27ec6dbf0b6cb835253cb6da267eeea10994f Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 11 Jul 2016 21:13:57 +0000 Subject: [PATCH] tvplanit: Add XML datastore. Add sample project using it. Redesign datastore icons. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4939 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/xmldatastore/project1.lpi | 81 + .../examples/xmldatastore/project1.lpr | 20 + .../tvplanit/examples/xmldatastore/unit1.lfm | 331 ++++ .../tvplanit/examples/xmldatastore/unit1.pas | 91 + .../examples/zeosdatastore/project1.lpi | 1 + .../examples/zeosdatastore/project1.lpr | 2 +- .../tvplanit/source/addons/zeos/vpregzeos.res | Bin 330 -> 1899 bytes .../tvplanit/source/laz_visualplanit.lpk | 6 +- components/tvplanit/source/vpbase.pas | 5 +- components/tvplanit/source/vpconst.pas | 2 + components/tvplanit/source/vpinids.pas | 6 +- components/tvplanit/source/vpreg.pas | 2 + components/tvplanit/source/vpreg.res | Bin 14745 -> 23521 bytes components/tvplanit/source/vpxmlds.pas | 1562 +++++++++++++++++ 14 files changed, 2099 insertions(+), 10 deletions(-) create mode 100644 components/tvplanit/examples/xmldatastore/project1.lpi create mode 100644 components/tvplanit/examples/xmldatastore/project1.lpr create mode 100644 components/tvplanit/examples/xmldatastore/unit1.lfm create mode 100644 components/tvplanit/examples/xmldatastore/unit1.pas create mode 100644 components/tvplanit/source/vpxmlds.pas diff --git a/components/tvplanit/examples/xmldatastore/project1.lpi b/components/tvplanit/examples/xmldatastore/project1.lpi new file mode 100644 index 000000000..f0cafdceb --- /dev/null +++ b/components/tvplanit/examples/xmldatastore/project1.lpi @@ -0,0 +1,81 @@ + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + </General> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="laz_visualplanit"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="project1.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="project1"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/tvplanit/examples/xmldatastore/project1.lpr b/components/tvplanit/examples/xmldatastore/project1.lpr new file mode 100644 index 000000000..cbaf9b146 --- /dev/null +++ b/components/tvplanit/examples/xmldatastore/project1.lpr @@ -0,0 +1,20 @@ +program project1; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Unit1, laz_visualplanit; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/tvplanit/examples/xmldatastore/unit1.lfm b/components/tvplanit/examples/xmldatastore/unit1.lfm new file mode 100644 index 000000000..b392a2218 --- /dev/null +++ b/components/tvplanit/examples/xmldatastore/unit1.lfm @@ -0,0 +1,331 @@ +object Form1: TForm1 + Left = 225 + Height = 686 + Top = 155 + Width = 980 + Caption = 'Form1' + ClientHeight = 686 + ClientWidth = 980 + OnCreate = FormCreate + LCLVersion = '1.7' + object Panel1: TPanel + Left = 0 + Height = 34 + Top = 0 + Width = 980 + Align = alTop + BevelOuter = bvNone + ClientHeight = 34 + ClientWidth = 980 + TabOrder = 0 + object VpResourceCombo1: TVpResourceCombo + Left = 8 + Height = 23 + Top = 5 + Width = 208 + DataStore = VpXmlDatastore1 + Style = csDropDownList + end + object BtnNewRes: TButton + Left = 222 + Height = 25 + Top = 4 + Width = 99 + Caption = 'New resource' + OnClick = BtnNewResClick + TabOrder = 1 + end + object BtnEditRes: TButton + Left = 328 + Height = 25 + Top = 4 + Width = 96 + Caption = 'Edit resource' + OnClick = BtnEditResClick + TabOrder = 2 + end + end + object PageControl1: TPageControl + Left = 0 + Height = 652 + Top = 34 + Width = 980 + ActivePage = TabSheet1 + Align = alClient + TabIndex = 0 + TabOrder = 1 + object TabSheet1: TTabSheet + Caption = 'Events and tasks' + ClientHeight = 624 + ClientWidth = 972 + object VpDayView1: TVpDayView + Left = 0 + Height = 624 + Top = 0 + Width = 301 + DataStore = VpXmlDatastore1 + ControlLink = VpControlLink1 + Color = clWindow + Font.Height = -12 + ParentFont = False + Align = alLeft + ReadOnly = False + TabStop = True + TabOrder = 0 + AllDayEventAttributes.BackgroundColor = clBtnShadow + AllDayEventAttributes.EventBorderColor = cl3DDkShadow + AllDayEventAttributes.EventBackgroundColor = clBtnFace + AllDayEventAttributes.Font.Height = -12 + ShowEventTimes = False + DrawingStyle = dsFlat + TimeSlotColors.Active = clWhite + TimeSlotColors.Inactive = 8454143 + TimeSlotColors.Holiday = 16744703 + TimeSlotColors.Weekday = clWhite + TimeSlotColors.Weekend = 16777088 + TimeSlotColors.ActiveRange.RangeBegin = h_00 + TimeSlotColors.ActiveRange.RangeEnd = h_00 + HeadAttributes.Font.Height = -13 + HeadAttributes.Color = clBtnFace + RowHeadAttributes.HourFont.Height = -24 + RowHeadAttributes.MinuteFont.Height = -12 + RowHeadAttributes.Color = clBtnFace + ShowResourceName = True + LineColor = clGray + GutterWidth = 7 + DateLabelFormat = 'dddd, mmmm dd, yyyy' + Granularity = gr30Min + DefaultTopHour = h_07 + TimeFormat = tf12Hour + end + object Panel2: TPanel + Left = 306 + Height = 624 + Top = 0 + Width = 386 + Align = alLeft + BevelOuter = bvNone + Caption = 'Panel2' + ClientHeight = 624 + ClientWidth = 386 + TabOrder = 1 + object VpWeekView1: TVpWeekView + Left = 0 + Height = 378 + Top = 0 + Width = 386 + DataStore = VpXmlDatastore1 + ControlLink = VpControlLink1 + Color = clWindow + Font.Height = -12 + ParentFont = False + AllDayEventAttributes.BackgroundColor = clWindow + AllDayEventAttributes.EventBorderColor = clGray + AllDayEventAttributes.EventBackgroundColor = clBtnFace + AllDayEventAttributes.Font.Height = -12 + DateLabelFormat = 'dddd, mmmm dd, yyyy' + DayHeadAttributes.Color = clBtnFace + DayHeadAttributes.DateFormat = 'dddd mmmm, dd' + DayHeadAttributes.Font.Height = -13 + DayHeadAttributes.Font.Name = 'Tahoma' + DayHeadAttributes.Bordered = True + DrawingStyle = dsFlat + EventFont.Height = -12 + HeadAttributes.Font.Height = -12 + HeadAttributes.Color = clBtnFace + LineColor = clGray + TimeFormat = tf12Hour + ShowEventTime = True + WeekStartsOn = dtMonday + Align = alClient + TabStop = True + TabOrder = 0 + end + object VpMonthView1: TVpMonthView + Left = 0 + Height = 241 + Top = 383 + Width = 386 + DataStore = VpXmlDatastore1 + ControlLink = VpControlLink1 + Color = clWindow + Font.Height = -12 + ParentFont = False + Align = alBottom + TabStop = True + TabOrder = 1 + KBNavigation = True + DateLabelFormat = 'mmmm yyyy' + DayHeadAttributes.Color = clBtnFace + DayHeadAttributes.Font.Height = -13 + DayHeadAttributes.Font.Name = 'Tahoma' + DayNameStyle = dsShort + DayNumberFont.Height = -12 + DrawingStyle = dsFlat + EventDayStyle = [] + EventFont.Height = -12 + LineColor = clGray + TimeFormat = tf12Hour + OffDayColor = clSilver + SelectedDayColor = clRed + ShowEvents = True + ShowEventTime = False + WeekStartsOn = dtSunday + end + object Splitter2: TSplitter + Cursor = crVSplit + Left = 0 + Height = 5 + Top = 378 + Width = 386 + Align = alBottom + ResizeAnchor = akBottom + end + end + object VpTaskList1: TVpTaskList + Left = 697 + Height = 624 + Top = 0 + Width = 275 + DataStore = VpXmlDatastore1 + ControlLink = VpControlLink1 + Color = clWindow + Font.Height = -12 + ParentFont = False + Align = alClient + TabStop = True + TabOrder = 2 + ReadOnly = False + DisplayOptions.CheckBGColor = clWindow + DisplayOptions.CheckColor = cl3DDkShadow + DisplayOptions.CheckStyle = csCheck + DisplayOptions.DueDateFormat = 'dd.MM.yyyy' + DisplayOptions.ShowCompletedTasks = False + DisplayOptions.ShowAll = False + DisplayOptions.ShowDueDate = True + DisplayOptions.OverdueColor = clRed + DisplayOptions.NormalColor = clBlack + DisplayOptions.CompletedColor = clGray + LineColor = clGray + MaxVisibleTasks = 250 + TaskHeadAttributes.Color = clSilver + TaskHeadAttributes.Font.Height = -12 + DrawingStyle = dsFlat + ShowResourceName = True + end + object Splitter1: TSplitter + Left = 692 + Height = 624 + Top = 0 + Width = 5 + end + object Splitter3: TSplitter + Left = 301 + Height = 624 + Top = 0 + Width = 5 + end + end + object TabSheet2: TTabSheet + Caption = 'Contacts' + ClientHeight = 624 + ClientWidth = 972 + object VpContactButtonBar1: TVpContactButtonBar + Left = 0 + Height = 624 + Top = 0 + Width = 40 + DrawingStyle = dsFlat + RadioStyle = False + Align = alLeft + end + object VpContactGrid1: TVpContactGrid + Left = 40 + Height = 624 + Top = 0 + Width = 932 + DataStore = VpXmlDatastore1 + ControlLink = VpControlLink1 + Color = clWindow + Font.Height = -12 + ParentFont = False + Align = alClient + TabStop = True + TabOrder = 1 + AllowInPlaceEditing = True + BarWidth = 3 + BarColor = clSilver + ColumnWidth = 200 + ContactHeadAttributes.Color = clSilver + ContactHeadAttributes.Font.Height = -12 + ContactHeadAttributes.Bordered = True + DrawingStyle = dsFlat + end + end + end + object VpControlLink1: TVpControlLink + DataStore = VpXmlDatastore1 + Printer.BottomMargin = 0 + Printer.DayStart = h_08 + Printer.DayEnd = h_05 + Printer.Granularity = gr30Min + Printer.LeftMargin = 0 + Printer.MarginUnits = imAbsolutePixel + Printer.PrintFormats = <> + Printer.RightMargin = 0 + Printer.TopMargin = 0 + left = 136 + top = 264 + end + object VpResourceEditDialog1: TVpResourceEditDialog + Version = 'v1.04' + DataStore = VpXmlDatastore1 + Options = [] + Placement.Position = mpCenter + Placement.Top = 10 + Placement.Left = 10 + Placement.Height = 250 + Placement.Width = 400 + left = 136 + top = 335 + end + object PopupMenu1: TPopupMenu + left = 129 + top = 527 + end + object VpXmlDatastore1: TVpXmlDatastore + CategoryColorMap.Category0.Color = clNavy + CategoryColorMap.Category0.Description = 'Category 0' + CategoryColorMap.Category1.Color = clRed + CategoryColorMap.Category1.Description = 'Category 1' + CategoryColorMap.Category2.Color = clYellow + CategoryColorMap.Category2.Description = 'Category 2' + CategoryColorMap.Category3.Color = clLime + CategoryColorMap.Category3.Description = 'Category 3' + CategoryColorMap.Category4.Color = clPurple + CategoryColorMap.Category4.Description = 'Category 4' + CategoryColorMap.Category5.Color = clTeal + CategoryColorMap.Category5.Description = 'Category 5' + CategoryColorMap.Category6.Color = clFuchsia + CategoryColorMap.Category6.Description = 'Category 6' + CategoryColorMap.Category7.Color = clOlive + CategoryColorMap.Category7.Description = 'Category 7' + CategoryColorMap.Category8.Color = clAqua + CategoryColorMap.Category8.Description = 'Category 8' + CategoryColorMap.Category9.Color = clMaroon + CategoryColorMap.Category9.Description = 'Category 9' + EnableEventTimer = True + PlayEventSounds = True + AutoConnect = True + Connected = False + FileName = 'data.xml' + ParentNode = 'test' + left = 136 + top = 202 + end + object XMLPropStorage1: TXMLPropStorage + StoredValues = <> + left = 222 + top = 118 + end +end diff --git a/components/tvplanit/examples/xmldatastore/unit1.pas b/components/tvplanit/examples/xmldatastore/unit1.pas new file mode 100644 index 000000000..f5973536c --- /dev/null +++ b/components/tvplanit/examples/xmldatastore/unit1.pas @@ -0,0 +1,91 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, + StdCtrls, ComCtrls, Menus, XMLPropStorage, VpBaseDS, VpDayView, VpWeekView, + VpTaskList, VpContactGrid, VpMonthView, VpResEditDlg, VpContactButtons, + VpXmlDs; + +type + + { TForm1 } + + TForm1 = class(TForm) + BtnNewRes: TButton; + BtnEditRes: TButton; + PageControl1: TPageControl; + Panel1: TPanel; + Panel2: TPanel; + PopupMenu1: TPopupMenu; + Splitter1: TSplitter; + Splitter2: TSplitter; + Splitter3: TSplitter; + TabSheet1: TTabSheet; + TabSheet2: TTabSheet; + VpContactButtonBar1: TVpContactButtonBar; + VpContactGrid1: TVpContactGrid; + VpControlLink1: TVpControlLink; + VpDayView1: TVpDayView; + VpMonthView1: TVpMonthView; + VpResourceCombo1: TVpResourceCombo; + VpResourceEditDialog1: TVpResourceEditDialog; + VpTaskList1: TVpTaskList; + VpWeekView1: TVpWeekView; + VpXmlDatastore1: TVpXmlDatastore; + XMLPropStorage1: TXMLPropStorage; + procedure BtnNewResClick(Sender: TObject); + procedure BtnEditResClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + { private declarations } + public + { public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +uses + LazFileUtils, + VpData; + + +{ TForm1 } + +// Adds a new resource +procedure TForm1.BtnNewResClick(Sender: TObject); +begin + VpResourceEditDialog1.AddNewResource; +end; + +// Edits the currently selected resource +procedure TForm1.BtnEditResClick(Sender: TObject); +begin + // Open the resource editor dialog, everything is done here. + VpResourceEditDialog1.Execute; +end; + +// Load the last resource. +procedure TForm1.FormCreate(Sender: TObject); +var + lastRes: TVpResource; + datastore: TVpCustomDatastore; +begin + datastore := VpControlLink1.Datastore; + if datastore.Resources.Count > 0 then + begin + lastRes := datastore.Resources.Items[datastore.Resources.Count-1]; + datastore.ResourceID := lastRes.ResourceID; + end; +end; + +end. + diff --git a/components/tvplanit/examples/zeosdatastore/project1.lpi b/components/tvplanit/examples/zeosdatastore/project1.lpi index b89b8c3a3..9552ee851 100644 --- a/components/tvplanit/examples/zeosdatastore/project1.lpi +++ b/components/tvplanit/examples/zeosdatastore/project1.lpi @@ -61,6 +61,7 @@ </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="..\.."/> <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> </SearchPaths> <Linking> diff --git a/components/tvplanit/examples/zeosdatastore/project1.lpr b/components/tvplanit/examples/zeosdatastore/project1.lpr index ac5b2c34d..cf77d2fe8 100644 --- a/components/tvplanit/examples/zeosdatastore/project1.lpr +++ b/components/tvplanit/examples/zeosdatastore/project1.lpr @@ -7,7 +7,7 @@ uses cthreads, {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset - Forms, Unit1, laz_visualplanit, zcomponent + Forms, Unit1, laz_visualplanit, laz_visualplanit_zeos, zcomponent { you can add units after this }; {$R *.res} diff --git a/components/tvplanit/source/addons/zeos/vpregzeos.res b/components/tvplanit/source/addons/zeos/vpregzeos.res index 1396a602e0642cedf5896a277f031ddd8bb433a9..9934dcadc2f4752b877970216835047ef024e790 100644 GIT binary patch delta 1786 zcmV<W1_k-b0_zTtAOZ^qks@h-3hMv>3hM!aiw#-;00zBDL_t(Y4Q*BnP*mp?{_cMt zyS(;+f=h5U0cRo*1;wDmVA?Tl($PqaacWGHChgSLnv8WO2<d1ijmEJ;HAAK|sVy;y zHSM%MqM3=)iP{KKMkq80f*4mIAPPa2UG{PJ?%n(M+{>(qY0k{q|8?$v`ObS*0KkdA zm2z@&5+frctLU-nn*s*s;j!D1+Rwk3Y^hkBoA~B?@+_H~XFC8vm}X9JCZetb-J2ZT zFbup}-<;WUY2;o_ONgl{vgY+<1Q*PkdE>if-WQiH@GLmlIB=+P#l31$>DO0g9ufv1 zi2$RMO_|<HhKyT7<2<f^8=<~|+jB)(aXYg-j_kamnPPTfUbBx?{CrQ-PqyqiyY+#5 z_qv*zw@AbP6WI;^Ogo^+02vELH=@80igFx#h#84QLity7e~vv}S>5&d_>&)g>MQoE zHc#op6_6DLU2Ux>%F)|@wccCy_S>hickj!j<ts8hh?`*%X=k#38J+|o+3g&p+<dps z_PV5H3-7t-XX_TWpL(<M(4&i7tyeB}(z}8Ci%ZbdF|v^4$V8Y1-$iB)WHUT!Y}x~Z z5KM34abVG+MMg(QM-j=i5(f*`zF#X#Ld-BY%b1ach)RhfQsZ2%tonD5F?ZtR+V@j> zPdtAI$h44~%2f@22t`P-#=vzMvv@h8bG9;4dXZ#aA+Dnjx9bURD}Lm0Ie)<t#I(4@ z#Vfv#!iOJIw78MdbNspOBzqSHAtDBbC~=sHEK*%lt<Hb)UA}hj5MT4gb#CsdnyRX+ z>zTQl=cj8&_|tVaEq>~EL%d+^dv|0w#XQNT2hOou<K-}a;DF(BP6b1|PF^Xr%`2^d zp3o^L0`f{8Lg7<~_r1RRrK+li!MdK~Ki=Nm{0USwig0KOJuT<ZeRSiizV>(O7v}b| z&;GiEwY@vv3X@<WkyYPgjD132uaG6R-ogj1zWBPIW<Lz~cA)F%bJaD62KVpYVB1yp z;@KKemhks~UtA8~?AR}fic8QUqai_H{Yq-)1;yd5w*dS>HPex9d+&jDhgVP6kpMX* z74B@Wg)u&S4OFkR=TycFXAk7dSC4<Euc-1!UTWq%D5)-bpQJuAD1R!{z%VBI&tu@? zp9ZZ?c0247^z{>${_&$7(U^XJa4J^#*h?oDtKp!31z>vl+s#W)Ji2UdpTwB&>b2`j zIoI=KMWbGz)KM@5tIZfhTN>=nT)5_xLumc;TnoU`LO-&^cK_${xVyA)*4CL0C2wLX z;1VSXqHM$K2V2*iYaPD2qBQsV^5R*GLm8#8=@CT6TC7|dS{RAYDB_cYRF)AqypNMc z0al2Ak^srI?eeWTOc1tgt2@8xOTX$8m}#CsxuP&}vr#$Uw)~v1{s+ZK&2n1ziO4u9 zA41&U4`@0JM;Urs_Tw%Ok^m1DdA|7L(M!L6`I(X<oma=7_;MmrF*G_gZ!#EjshZBz zSbW5$_7<gNuE$hxfB;nZLPN+51t3Q>2sFokW@HsYmK8GVQ#dGc0a=u+F)`hOcN#H? zX|3ihRfy>f5?m)X6F*IYA)x5O41BzDBkYMN#8fZZ|M?mu{s<2W=LN*NNjRDm|CW`e ztVo%(+wBPJVVdV8Gd(GgCZ<8<D)qxCA|;(>+$oZ7Ff!U~G$^71r|5)#vmbmLN9V?W zP88S*(DiJWwcl5^4+7Phwpl~}28!{73>FZuqhu$dzl`Ec<r$>=)2BT%BpCL&aC!<X zAS(wpW=FsXBD2<w?6g@pxcVUaZui0K@S^;ka!7)N)}OXP+9gvMIT~L$k5wP6!f%%E zM1Flf(rxL8P(_(B&h{<?OK@o6G3fDsSjh4qZqVq|1*#3;*!p8Q&~gA7whXJOPH#Mo zp}-IdW)_fzR6!(^@6Lxi)s614ZuD&FLBpB`=pyMLVkxsRH5Ei}<L`0iGojA%z_dyr z<)=1$gd^R5fzR(lPz%7X`f*?Veek4t&^FR$Rj5qi493g`<XCxlC6?qa!KojAo<f?G z4%G;u`EQ#-*M{-m#$NWph0E+?Yw9UYHZJ@@<OBWz9#8|kX|Rb}7rgUUCm#+B^PT5* z^0YV7ctnfvpc>>EdosB2n!tS%KI^Wbqk)UNMJ}xZpS=TOa*~>>aFm}&d!hOHQ21gP zbC?%{fkDevvlPug0vU<}q|~}?bJ<<c4IQC)$V#YFcET>%F%}sECt3L-N7j5uH|oBs zUrE<^4!@Rw+-P7_9E6>+VwQRmKo^3bkz<`h`lPj5V~4K72q4M>pbECWNf5}*EAY_q c2C+r|1Kvs~0?g+3;s5{u07*qoM6N<$g6LCyaR2}S delta 205 zcmV;;05bpU4$1<MAOh+Dks@h-3labT3lag+-G2N4005jxL_t(|+P#zu4uBvGLwj^? zj>f2w-+mpMECdxET{i%rN^w450@p@m5q|=JQdhAZAVKI9X^<2TwgV&x*fP~T0b7PM zNb}8_%W#S;r=ZkX@~AYD=pB_J2o^pNS51#0RbK)iq`=btlmgGi7FJ+D?b5J<)GF#v z=9@bd+>74v`+hdMJZKm7Mvj11k<!V-?YEd~{|P=Z9_WAra=t~(uZjhf00000NkvXX Hu0mjf_c2uh diff --git a/components/tvplanit/source/laz_visualplanit.lpk b/components/tvplanit/source/laz_visualplanit.lpk index 96b6d8dc4..4c345994f 100644 --- a/components/tvplanit/source/laz_visualplanit.lpk +++ b/components/tvplanit/source/laz_visualplanit.lpk @@ -32,7 +32,7 @@ Portions created by TurboPower Software Inc. are Copyright (C) 2002 TurboPower S Contributor(s): "/> <Version Major="1" Release="4"/> - <Files Count="73"> + <Files Count="74"> <Item1> <Filename Value="vpalarmdlg.lfm"/> <Type Value="LFM"/> @@ -326,6 +326,10 @@ Contributor(s): "/> <Filename Value="vpsqlite3ds.pas"/> <UnitName Value="VpSQLite3DS"/> </Item73> + <Item74> + <Filename Value="vpxmlds.pas"/> + <UnitName Value="VpXmlDs"/> + </Item74> </Files> <i18n> <EnableI18N Value="True"/> diff --git a/components/tvplanit/source/vpbase.pas b/components/tvplanit/source/vpbase.pas index 11673e147..7c8e0852a 100644 --- a/components/tvplanit/source/vpbase.pas +++ b/components/tvplanit/source/vpbase.pas @@ -38,9 +38,8 @@ uses {$ELSE} Windows, Messages. {$ENDIF} - Classes, Graphics, Controls, Dialogs, Forms, StdCtrls, - ExtCtrls, SysUtils, VpConst, - VpSR; + Classes, Graphics, Controls, Dialogs, Forms, StdCtrls, ExtCtrls, SysUtils, + VpConst, VpSR; const {Message base} diff --git a/components/tvplanit/source/vpconst.pas b/components/tvplanit/source/vpconst.pas index b4bb45675..0960c9292 100644 --- a/components/tvplanit/source/vpconst.pas +++ b/components/tvplanit/source/vpconst.pas @@ -91,6 +91,8 @@ const RecordIDTableName = 'RecordIDS'; TallShortChars = 'Wy'; + strTRUE = 'true'; + strFALSE = 'false'; {virtual key constants not already defined} diff --git a/components/tvplanit/source/vpinids.pas b/components/tvplanit/source/vpinids.pas index b54ebb629..3da536ac8 100644 --- a/components/tvplanit/source/vpinids.pas +++ b/components/tvplanit/source/vpinids.pas @@ -61,11 +61,7 @@ implementation uses typinfo, StrUtils, Strings, IniFiles, - VpMisc, VpSR; - -const - StrTRUE = 'true'; - StrFALSE = 'false'; + VpConst, VpMisc, VpSR; procedure IniError(const AMsg: String); begin diff --git a/components/tvplanit/source/vpreg.pas b/components/tvplanit/source/vpreg.pas index 17cc7a659..ea9f01a2b 100644 --- a/components/tvplanit/source/vpreg.pas +++ b/components/tvplanit/source/vpreg.pas @@ -161,6 +161,7 @@ uses {$ENDIF} {$IFDEF LCL} VpIniDS, { IniFile datastore } + VpXmlDS, { XML file datastore } VpBufDS, { Datastore for TBufDataset } VpSqlite3DS, { Datastore for sqlite3 } // VpSdfDS { Datastore for TSdfDataset } @@ -621,6 +622,7 @@ begin {$ENDIF} {$IFDEF LCL} TVpIniDatastore, + TVpXmlDatastore, TVpBufDSDatastore, TVpSqlite3Datastore, //TVpSdfDatastore, // to do (maybe)... diff --git a/components/tvplanit/source/vpreg.res b/components/tvplanit/source/vpreg.res index 4690588bd25b45dac0b54cca9d4614ab5aa376f9..ae0498ed87eca0596b268bb52f7f457c3267e413 100644 GIT binary patch delta 10412 zcmZA7RaBipm#FK7I|PRS3l9+7-QAtw9$bT4KHS~iEm&~(;J&cn8X&m4?exD#pVPam zE~;+p>K)G<mEp480#&;O4gCU2+JQDq>Se_RYGfruH9S`qG@{V`$q@g{y}Ec4LKr_x ztl4z%VhUg&np)@z-_<@6e-F{)@uQYPj0~WHN-RdyeP9kqt1v;X;!{vi%~$jhaSSZO z^c)lSvNLcXIhROKy4YTbHSH2m5LJ%sM=qVucQpNkYku%uw~yw%@2QYzrZl;Y%RWp; zO2bvxX|rCmYJyuWi?4&(QfHfZ^hmD49lp=SxX)$i_fAP`C{iIZL!c-p*$I;_h~`)6 z-IILy7tp^YE2$(=BW4^J1)o$1YYiYDgFwi~P=Qfsx*!m|;D0?#1}#O?M@2)E;C<bN zbUcx%gBJd%B8cmAcsP}HNG!V`2WfB|9ldRRnqmfL#Fj>>b*ahxk}#)@4VR5%rbVim z5L*PM87GdctSI>hih-}B9_MFWE$3@+zIW1_6U#nRxh~&(&YyG6`K3X|fLcchH8u4i z8X8)X72Ej`T&VR^);ki8mXRI(BzRf6$GO{u;c{vhEb^gnl8SGNAOcjD>yaL6VhqVl ze3*?4g~}|As&m(Ip>e-2MLT-@{lIWP=TSmkdMcpbL2h{hYQnx*VcvyV2T@@fbJWv8 zy3I#gHGZ3hQih%@oC?1Jk~+?V)Kq-l)Ma-#J|$FX*=EbkRS#dM<mvCGNx5b?yYjcp z#9Eg}9Mc=dpd{f(bXcCGaR_`xu{YNyQ4M~l1W|L!vaTnO(p2h!-|lAGZpJGZS+6(j zMj``~hGQu>WtjoDQvTy4<?p>?Dc6X56_<$p`gjT6oz7marjZc<tLT=mQ0dQAx)|_A z$Gyv3Slam$t>rI2!l`=U&)>_uV1nk@FQUp!c&aJ!`$)Q{9tcPD!JIfTy=3rUMIKah zb8`Z498Jn%vg$SZ<ZGu&YH++sdX-NcEUX3}EgPrZ7_V24H=)ZRzl(6oms8LBsBj;v zZ%&#pzEIGM1QX#v^y(xl;$7A>;tg%Jj)*;{y*>d%QSYf0>8iJpA9J=}OP=%@q;}?~ z0_hKZy}4UPu|9R%4+;N35IFy$U>@)i=<7D}i)eB!#chAyV>+u-c{w>PuP5}9nRJ@g zj>WRdp>d^A(`|odP0_$sVYaj35^*P!xhXmT3IWwpzvDO1Vs}7F*DRW`9R3%R4;yNf z@=R*1aq_&U;bpJ0^A=w#Z{uygU!D3nze4oE@07>D8&noas^?ns(!lxaS)&eH@7#Qt z3%$-9iwE1wP1wwiG=Y&!8F`(qsH(k{OUV%9Rui1fkeg#vyDbK}lC~eO&)qO08^h|( z)H`&%!I1?DcW@d-l9WGa$6yfw63(r^wPDk`Y&wgw?B{9^vuLERW&G{pLMqc%cdUNA zV<-Qd=cbDxyaRYtggX3QGLnB}C7JCa^toq6?XQ-{qVfsj9;J9UF1|#s6xlLsr<{Bn zXq-Kx!!;7Vv|zy@^c}1$RY-5KEk3%}g%ud1b~y)DoZr*mEUAX3@_q<$uW<Ytt;Z_W z%`Yml6{#JI7HwP)O>Y%)x+8)qurmOndc_Jzbxg;BN;~JTsHdDgW#Y09_B}f|)JO_y zwRZN)^FhN$)3K8$E^oOv1JT#(Yy}c87u;zH10PW*G1h+vJFUXWjf05Kkb-3f);fqz zwfBIM@5MvoKk-Sv*R*l|HK({2CnHN7{S#u7`E%VxB%PO)qz=h>@!dN=r1$tkw?2#& zCP6HNMhf0`J0f3%RLLj9m&R68NT&{E_rt5*cyf;(%(9!}Y0ye1d0B;I`bT8$rTGdC zpBIHjAKM6#5by=LSO^Zf)rY^}<Aiu<9j!tD^F{mn<30=D^4swJ;BWk2>NxUPs@8+; zs@)!=3y50w+Zm=RpIG=f3~5#W*k-h43$(#~Z%GREou{i)Odw-H(mh5ZC}5#GgidRg zr$C>wKYz~9(z=K_zMnT+?UV9tp}<zhgQUo}c5IFhtQE>t>BUQZ;ZFf%hN&{u#Wj)v zDOgd(VB$HVseuCh+)7y0JlZ4)C|*Zz7Bf4FeSvv=Bd|?ijz7WrF5h}^vbB}X9GRM~ zl3!7F&29K?E-hOFh12b1;qNj3eMc!O;;YNbem1GzHP46DO~MG-BJB9*MQ3RInf=`_ zQa9BqoG_6C?8pyCr<htezNCT*TCfwqnUqflzGj$kuQE;Wf&rEeVxvk?NF0M;Koz-? zuktqmb<bJ8I82xh^#?u!2;T|}pCp-feMtC)E`R;4j***SENP9YUaUsFpaE=7*ylu? zL3#EqjH4xkmFUbNGWS#tljUrF2CrrktHz55K28Z)(SYl}eD})wcJ6sHyI=T>wX4N; zt#w;VR>lw`1a{+MV>r;T{8LyOTeA!rWgdB*SkT90J((_7c8_i1fPhSKQt75MvUpgN zA1ucD^1~NB!V2{s#WW=D>4u-6Q_ZrIS9FIT7Jc5~uC-66rHH@hHFUr^V?cutl9+HU z{<Ra~e+8%h{|3ii%g0G$f$(2&&ezxN68-*2QZSi7tCO)}gkPxy*_+YlP+$b8Hfqmh zi0MI+3B^sz=IZ1~KGWG>V*K#S=b2fNVwsqa6)y-ZCKOA$LX;H|3zWsXQsV01_Bh}0 zQSNc^2sC}Q=oUO!1FqN4@4L?BKs=XeYKDfnxaeU$ifNoiIJLZSXfZZELXWP6ZKk7k z$5Hp}mXdb4HZW9lquE=qh1SrgdVXuo_MNRi>53jrJ!?#~>$xR4#o7)Nb{=(LjPyQM z=xSx_t$DWJ_pYS4+!B`L8D;QjbLEeKijr1S*65of_53IW0FxC6eOJ+A{Soq0gNq+8 zoTSb-B@<C~?#iXRqv1`Ty9Mlp`w0|>@=Bi^ju+vC^{p&Ds5IpGI^!FORD!}e;`8-s zyYYJccblWp>*6*oqbGCo^=DGIwAkabwJQYr{C53T*BUrUFN@<i?vT{8&3BBGjaOpp z$LL@LBuu;vz&%jXlR@mtlSihl^?r>6nRZ<Mto`_zNKQBI)#5ZD3?D(aoyjoYhX_S( z{K8qUHTchn1Y*!RSptk^uyh=aU@elUXOavk3ZJ=ob!8<|rZj}7-s-hau!3UHKC9to z!p@41I#Nd2$<2PUhcX(jdgvBGoi9$vk4Q#)B;?yV04n@Q$3@Wk!xYab;E;DAIysj* z13&!ua4@HIaJ>YhTI~RLGpaSgsnvClTlHa!l8Mr!%$0b#KFRz%AJKfEk42H#jBU>5 z*yc9mcw^_-<NlJfr*&#Dx8g@>vpXqvC6D78_CC?EBj3vs^YcUDt>b3uHqJF69{3^5 zA*RY7KqEcz2R>u@mDE+v2=;VBmwr`KqQXgDkLw@a@H*WyShclz^DOG#9r5sJ<|YZN zQKrPp5tF`_ZR8esH1#;nyGxlkGe3CuW#+$M6r)i{6rrf>?jzt=GG>ma_7MxY=k>ev z5|$Lc@o3&w`<1%V4#RzS=H34~Hd}%1R$s9N{1k2_?pSXAl3)NeIs;#nIN+_n5zWqI zWR(ZQ0*0{rTA#I?FJDX@nUlz>sCOdn2NOppyxHb^mk5@zS@2vQdmSxM8g;2P-l+s| zn+fS}fYy~&NSBj^NuJDwhrE>v?oZAgd2)zvyoUasN;AKm@(bt0W}#51U-nBkb2C8z zGfV^#&&O+0CjO_3s~37?v-K}O4UC4`bn@F#kKp7;;KaYJM2otY_3!4z^k(D6>%PUG zgLriRN^36Fyz7IJQt_uMrmotMhe|)e)EA0qt$RLBrgGBgJ^id<$n$#*nAMRlJlu22 z`q)@tLGz^<GYFSN!gL2dr3Bu{3fDRr*b26SH?|P;cw8j@Bs+apF5KkisgEI}kWQmo zL#v?A@%exs%tL4Yq(#@c{QaP<Bqsh!h-%0O^egyOFLG+XtMyk9q5pH_H{n-<UxRr9 zEo~<=A(fPI=yBG#enINjG!&Qq4(SSUH2n@;4Ybr|*rgO*u=z#&D`C-psWc}20SOld z_Kpt~M-&Z0fpHYvKgJ^2KP57Hc3@hv<Y)?%AY)GT?tH3~@lB-C6N6+Z_^Lco2`qA$ zJ0ez-cEg4U4^Yn1Aziv-<>q3(C#IBEiJR^qVyRQ`(j|sSw~|Z-&5SXHx2jVG8Jjm+ zakQF$8%*r=m?10d*V!@z?Rvo+0Ni=fHUhYhYC_(*M*$piLvdp>6&xDy-RQDOb$phb zPnA#GSr^oT4Y*6Wz7H<=ydvoSSzhs}iJ=6VVwwDC2Es@E+jqapc@2XUls~mMdlYyA ztWq{obu;(4!}<5zT&C-toSq)PI!2TxOGQOSX`a7{jVIut_JyPMDGU^$10wxOy-^zN z2Qye7BR6S>QWF`&^_)>95b{~z4s%@})`U=pLrF4@Fe)Lnbx<h?^durNbH!AqbRK3l zp981ndisT@<!_a6kp|74(&tLPJMs<PI@>)za}oRO5J3NgGuDRB%(IrF0*j_{qZlqk zC3Vrv%s~88vlv<IvAwLl0D?w@nVYm~i0$jc`Js~g!^GFSK6_9Fk~Ab3JUIQ?NK8`) zSBpd!E@DN4Hv4(Cjo>HAaK6wVPZk!;q1|&qbiihYH>?Tj2@84^3-P9FwEBPqpk+jR zu{vT`RF*cgG`k=?OpjJ)WXBCi21%7kk8)=+7q-Ag@KIlNyry%QemX=+5#XObGz#)g zrSu_B4tSbA`ofBqJN#2eMR_%RJn2G3iz-z_<722aEfv?H8I@LKaDx=9Y~BY;6sZWe z0W0y4@GOIol1eDkur~y&3OM2NdfC4JDXRuV{9YL7M);($k2b*n!z+vbk5^8(|7v%- z+~IQ`v%SB8$O^^8g2bLqB(4B0+AEUt15b*IjD?bMzF;slc4kXPCjVAd6hYymJ+Y;6 zz9bmNOkVXQdhv4{MKU?Zm*8MTRty=`58}}GDP0{N_YXN;p9C6#n+e~JgA;)F`L+A} zUN9EcKj~#_WNeJBqoaegY%;O~LpxjAr)Ic9k7<)fN0(!)(+6-m{g9Lg2PG?qOv4k9 zE(40`xpEq>udO+gcp7b3-*sJ2R$q%en<mB^BNcu*mX>=NFa2Y=Pb#ojS7bNDW3O^} z>i7w-6pqK-A2Rmi(*e4C-vTgY=s;C95)ylC_Eqw>BxdBs-24D7jU9TKMpx(Xr_u8X z{&cr{`AY!tW?)4{i_EWkgk`kuRwxx*|7f@(=K6sTgj)~K92Oa+Kft_@+&wwXgKXQw zoclM(V&M1544oGzIvmZxwz;zSw69!MhJTos>-Q+_RvIH4*FN^ch|d5Na|+@4!&Fph zQ9;R3e!s1HeqYWEBv9t*u+(h_agV#dw9e?g?=3T1ZT1HTiuvN5<jNfUCwK%D@R9k_ zQU8L6DC%iOAYx)tfQt%${Z~Oyme%8~#%7RwkTI&k<UUqJp-2QWgIbfU`9d?0J}tll zq;))Y<zYY}p|q(0HHRWpQju=(xhhVid65CEd;fx0$ZjiR^LMxjDTyD&VoL4X6%Ba} zQ8UhjCu%?#P<Rx&Cj=ND>hk#vBZ^89qry<BernMEs#)Ux-s$o1qL|}*R%x$4L6`OU zGyQS8XVh)~kwbUwek7x^!`Yv<YY+6C?SaR9M2uPQnmZ*R1P+72QI`j2+38~3-^JIN z4$C6Yl!E-Z&l*vn?fLc#S4~y<!*xmKHA1f8s^<>2)e5LEfn_RBAbRLk*x>idMOu4A zQRZ@nU((W{$61SYA}p59Ev?xJHng62s>U-+(rJ6^y0R*U!K7&RYENUm&2Y&|j505G zG6TN`H9b1;;wGtnBUigfUTG*BXAmWWW&1^aHm(v3<e<%v&dv({n99LmSQ4bkkjBFC zK=vj4PE^!#Os~>Co2~wlo!FaFy3KPd0VSZVqd|Rk_?K5)+?}Hei4Kl1+R7x;P18FO zNm;W&J^k{5^DSgkIs0`raT8+z8`~kYvA0T-6vrBX#G{dQ`g#o}--C1b?gE4Ano$_5 zF`OOD=_^E=L<)+y$d<njk@24g(A(p5nw5%GYzi&H*EY?FJJ-g%+aKNH?pq{d+?Ox= zZD$!SZ-ZRQmujoOpC!y0;9KIv*<=~U>nx?}qH<zNHkRemE}9&wrYG34IOrEPM)&RJ zNqz*7w6#6%dDdOsQ0wZh9#_n!Z*I^$GZ;?dWiTNFk_F%1)^2{y7B0id5GGgv+-6<H zo!C+Ue?E<|m)wkRJ)Var3nB+E^Yzu@tL5)%-IuLgW~Mu#OGTrq#%o>Aml&0`%0r~m z!5D|K#q0wmqhP1<AP`4-9U_*7jFdu{gdcFSfeA$$nR&C7hxWSZVfNwl-Sd6_5g)Tk zkvy`zQSHU*;bBh?Y_~zrHdv@&jKiTyD?8ajiNYuOO}?-NJIs_*rcT{W#1#FnpQZ62 zn&~WpXf-W|58~dtXA=Qwk74vZH;(GB-3KRiRyaeJsmn7IxQ9jyw$i;vr`BfJuj+tW zLc-b5EGgPAOkG>&&vNtuPzIrUAEO#4^hKu`F*J0<jI@UryK;E0HJ9Msey~ML%#OLn zMTRiL{jk)b-JFdSt{xG0J>Y$*XYl7-<u4ayTZP&Di`8Du@D~E6iuN=gfpNy<Ih;99 z{S%KnnhFM!Rnpo@5S2wCI0|H;B=G<pzSMT~2Jf!juiZ-!$8!{n^wl^gp5T2mV4%#h zIJ1BOi(>#ScJP=;reG_bp^#<){?@O~(&X#9*HeGO?tP)fBahw2TsS_Sa_<uf5=WC^ zOP5f$qgQbWN*<}Lg-;xJ9Yz?aT+BI7xhY7VaaoJXAKihW{|xX$OB-|AN&zV5J6B_` z;EGf`eqy4X5{D@_ZJ(xKv$(in8Q(?uF4;Xjw{Q_t2iNKsTi<Tr@u!P5(fT<HSDFjj zuP&Cg(}DklTu799A~}XYu{9wE?Nik832g@56*(dehlPqKzLCXbE%V=O1B&UtUJbnE zSkT%t!aoo0mCP^p=)GU$Z6ZN8MnYX*QNtKF{3RNIf=+->sv-FXz>EKPiEQmOByrx( zPP#l=Y?sec!>YdqB!B8pRg)_SSBaLwq5K(1m7m`iZVC%Aww6sMBMYn!*&_7~6!WLe zH};h@yoy&jxhfT*V{FtaFDY5|TkBGuUaRlq_>^mYHnEn$yZLWhN`Z`3pTEc|D|2UN zX66<T?f@O!>8ZHZ-FS?ZZN9H6+gqr+XSW0Te}XK7{K;IoqPBPnYhcO@ue3|8P5X|5 zeuOD;+^TB++Ez-`0Cdw-l(bre!Auv^1gS}>4Sq(iD@a98v`8f__tDCz*dIthMH%X6 z#8IWe^k|H!rCHl9x4*slsg~1b1t;ey**mg|qye&PV@7&kujMy<LxX19Gym>x*^&~{ z#83cv8O_!PmrNc+h$00LLyPlRm>dU9aG;8BxYRPOr!d3`>ddiSu68xG*+;T70_NmY zIzywBVF@`78eKxmMzt1`aoXL!=+<r2YcMf$JNcN7+2EjfeI}IR?4KRpPhC4OFy|eP zz<zOnCcl=V_On%P%hgH5ZllA_+nT@$1{YefpE*Tqp9f-Gz`&vEP7XLdxVH<!LB`BH zjS3&M+*p>VTMj_dz9!NRD9)K0w7W}d6o@3yW>PECzA^r*&ywNISG8O2>2=s0JYD^^ zLg;N;IxRv5gZ{2XrvdNDuf;bkr(Q{bE-y*;Poh-z`vO+A&1~}U%FOj|(t@GABg0=c z*^{R1vV`*PHpt0&J|Kuk>jv{`Hx@Ta9CAD7Xf}5CeSANYjEbYnij<erV&AxaocpS{ zIJXC^oc_Q?(|Rvtb~vjGzn0hq7jqa{6QW~-(>Ic1RXj)U8lWt-zLUF(m!%^DBg8jk z(8|>Sa5=j?IGAVfS-9c!@v#j34O%jS9P6w%L%hS;W}F?xrc%gAkfkV-WR)YBMCbQ( zsqB`F`GVEZ5;N@GCmpqY4AiFM9d}_bK@Keh=WpXTiL*^<pHr2bnds8%D(A@~9&8p5 zNAmiRA>=-AoZg%ah*e7NW#D)~@NI!hL{CQcmWscJfW`WCX-WW#jJj?6c)NvF_an3a zRmu=v3G1(#6u*+|Rj?2~L66W}PA1%eppb5llAF2O3l8mRj8*kB?roTGoB5ae>0O(W zxm_h+!P9DO{hl7dV%VXHWmfHoU^~#+UZKvfZbHG%d)|b)r~?}t(pm<9Q9Y5f0uGtP z04C7D0u}v0(5b|{ch#0Bcud)671WIPBtxP1^n8eCWcUtt>G1k9u^8+AQyiyHf>2)Q z2XW7V%<iM=BO$)@pVB=8g{iPA=?~U5RFRtLHn36;pBs<UXc>zx9){zkp!XNo8Ksqs z4khg-a=+9$TDaIwj1#W`=m9vGig?T#<KAWi4klOFZB8D_b?-zFJhcr_bv3$*TY4_E z25Chv37E=1)S}Gb&1yUX&ZQK6#p%U&ytPNSC<N^be|=5Zj-lj22G;M)Y&kb~wIg%a z;3FiF08BLTGO^jh&#>*o?d}*NiGP$ZzE{{hmk}W~zC(K09LWO#T!+GNx$#r!h3O~< zuUb>eX`Cds0P<yOvO?Dlofb+LKCf>mFAg;5j|`%9>UiWVm^R0(>CQ3fHv#J7D3f?K z+2gS#UQ6wsEL_YJA@ZgVZ(Y6uY_uupu3~-yjv!T2$UFIxju6gfSC%r_3sX@chueS# zg2ETa;^Nzbn>A=aW=%=b5#dK5qk@hvs_H@`W3DhYw)j&?@2M+UQ5H(!2#dAq442hP z{jNK666+d_(KIyG^NR}Q<V=(2Ln*=p1gQ_rKJM=w<$yAmL6q6xzAi&{Zivu*yNEJ1 z4ZQ0#IUe_jsiD8C?2(4~A1L{&q9V%RBR^8(1J;5UExdJrEQ|gF(!?&_VXbu>edTJM z`72zNFQ-Uvv3?6#6m+&Zr^z}w0#_G7jr9P;Z^3RiVD2O=3+x1LJ2Bv$(CV(C3M;3m z{0m4=i0m!9SFPwOZzLR2ZK_q3v(&}x3{pG4MTBUj{T6DLvR`(rYMZSvXhw-CvtAzh z$WO_Gevk>ctbiA{-64YDgJsEq_}d>~q)GeFUF*??9NxDw>^}u_wQr@l^BvB^BAixw z3&}buZ@kI}b6<XkMaa5)FRH_$#u$Fuk^1IE*R()%4G6z-TbDiEDStDc`JWE@cNc;J zfjIu1@9)SU4UiT{1*8Cy1W7c|lQLpK_rNFVvfBTzfuQq$hsoYaV-NTHnUC;YQ0;O| z@TY#PPa@<<AD{_DQ2#14m19PaC{(YcHsk1-)KZcc@R7id<@e15kT!|yX%N`qn(fA! z4pY#H(UC`pAhH(!2`WY!m_*20pIrC3-)K4LvVBMt_OqPsIv)nw4tNi|rg`b1wx~Qv zGBPr>l$ED<UA4W-0w=v1e+p|syubd{fUF@c<{T8+N-E^qgQ)1}{!Ii;DWLQpGU8U7 zV<vr+N^|%&*_T-umXB3qjE9yks($RgJ*${F-3ICqHdMrUoEX)a*9+O)EOKL`jKkv) z8aIBk9&IzNY+V6xcP#p28(nWKM=S7T6sIp@rl*K#;-)8syfSdB*DoLAjMki8e@)N@ zr0nhajP`RQJfgiR2<HC)@uEoa{}+(9A1=OI=%tpB@Gs{cDnTNN^u(3ln)biF<)4kE z--}>sD2nf9%#DmU9vSK4GWZ@>Q!cf+2<o))O2C%pO9G`CA4KCMWgNH>2=NcjB1C)Y zo$k8sYjk)!-gY-@mfmxqfzz~uX-Hel;UnBbXMrWxVM5dg^i8e-lJY>XU~Y8pCs@oF zYiKw)ICpVzaq!`MVz7(cMzsnqox^H&OcxCaYYtOnsKYlm$-|!hXt=7QL=VA9($_8c z_=|XyU7#IG!qj}pcnb-4b0><0%^HTXs7%(9a+K-GNxgrk=A~qOo~~h^(jh(e53?6+ z8;0)}c7;`!x}!(MVxLt+@qa?1{Ev`yyfTD#M_ar`r<l55xc?(0x$&_(mP@?jGJ5Za zxejj<ucKS0T=lCdG!mukxX5s_rgIxB0MqWl_*p&dSAzY5(SCdB6unr#+)R$lNUn?U zw>-X!p~cf<Ir;acwqw%;3~mFSM><zOSjY$qQ|=QgJ~{wg?>z~hW(XE!<oG!X@n7Ge zhJBJHOZbApJ|sk48}mn2lI32gjL9KJeO}zd1?D4$u#r}GPs6w8d;L}9FQklVfF|5| z&kW9~eYuADBr{>1EvBsLX(sn+@IK0!GYI~dcP8`T?bJjHLS&K`mFTS}CIP7{i`e=* z)E@mL@4rSt*45|bH8Gn0FbT(>DrO=7P6y>+sFEzZ0(>{e>jYNsG<-_u$F84ww_Gr0 zek*6cZ?%1q-ibK;{mc8T{+4taSST_<5Rqux3xOjQ?4+%fG^wgCxxEsbnzYko|AF`S zs2oj3DT8&ShSjM|$sd@dkZA%&zJZA8Z&YxbyK3lgXh#TpOtO{7!35oBX}E9-kXn1A z(<?K}c4o#5?gD$~?^2?AV**wYw1s|65_M3k;r)^NLA>*_)`UUKt<eksR_(>vlym9f z5tXUg`gqFl?;Et}hYW_7_>m9)S4iW7d9sz@$uMrgh2<7ga<&aPms%1QtXjViD<RE@ zRSE*Qc4p??v2%>P&Ca(BUW91_WWmb?k*f0Jm5ccTr?sC%NTtJ*;IxhG16jS0Z6^e% zzqO{ARORs#=}-|*z>?r$n~EkQVIR$H&?c%G&VLE%WzVRnU{)SS)!Hkl{QWsK3$ydP zjCmy5PrZPQ+L6lQJ-r0D9Evt-$ZCXm-N%xp61w<wXtOPblU7*;c(QWbkbP7W-{T|e z2d8o3&Z{+?m0eoH^w=YNm&?(qNA2q+3F+x-HezqiP3ucwK1rp)2g>jn!VyhGp9F!G zLM3eGNBKd>8<?8~>Mwho^Lvn$q`cE|Q?pFDFqOqyJag!8;Gf!Ng?6z;1-C@cvm&br zjNZLl>5$+}-$d1BBSK@NBw!)-hu@K#3{i4Z$Xt%`=x)XZ^^6T??vM#EU4;vLz*Qib zXFa0^>9_-Ypqz+zbR<nZl#BgmlE0_Fa}d*M!ne0sGUIw8fb10a^%088zPz~G9cIoh zPqR~0RcwNYRrF1lvd0faZDKxR$`WD*n&wPn_f5w4%-@`f@94w&vCm&QW>;dEW4Rl| zX)>2KiJ9Z((JqF^k3DZADt&n@uEsD{9)p-)v(AC)qYpsF{1jvNrN`vUO8!(7_iyK` zMTp*|T+Ve3@9H!uUG-j4T1`>Dqq`cb2eM+Z^<aTkag3(O-G|u7Zptyb!)jS1vb8-| zi-d5$C*J#;(|r5_a+p^WY!V}437^Rgs<3_#nq;D3(kEs#-YBjEuX_Y_0i&`q*zscE zQy{s@`geV6j&8%v*N%560%;;`i8;f@|JkvIJT^%<{4977NZ|iTnKnofq>!}zkuWKq zmHU5XO!2=nX6=OY&sU`fOE60(Qdr!fXauHE5g(vg{Xa4=#N`u1tA$76r6QzK=we}2 z;9$&%VHd#(3#ee$s^GLW4xm6piV;7NeNmvGB4>>!z*;(Su&{Ku@D-GAohR+C$UVzF z`@ZS3>GM+$1pJ3sva+nYdV1%@gZ<<GB`gPF61pG4&KAmV<r=$Jw;OE(2=|&Wfgc?4 z`kV)}QF&g<huIXdqrPZRo$)U5$;_cbP7|B_dyJesrQU^U{=n_W5}uKEH+4GS&R+)2 z8<ybzM_BO^{*Z}+f#F2DT@9D8lHmyz``tqzps?xzEAb`w&rQ{v={F1SLDtmwrOFPl z_s#+dN)5?Lma2YdBFBsRh=X=RCFtKz3T>7rN@UamFp81>w8Afz<Q!Zyx~cB5V)0uN z5BtYMZTGaJi@0u9()z-!neMI;Io68YT*48bgPhZU!V<D>BU^*XnWLBu=T?dnl~Dr9 z;MAsm=fFT4TAzeh)_9u_g;&@+DjN97$F^ME2lYVOBgmI|mo(S;0`C$cw&0B@1mM}q zq+^BzS&#yJijGB;lwx%Z400rWKL3CVQ`FO=kQbZhU|c+pq>|7;#)+uVyPEGe3XFb? zuAW<Lx8V|Y0*C8aIqy}#2U8Slo7DoQY&DHT1vK_hlqEja(_%Iyu1=~GwZzNZxFbPf z2NV^D?&Dy9h|RIn0OC65<~o-x*?5nIBqo7_DmdS-V4hI8L*e$<fK+ELm0M5Ukk{do z^{cvxDg=4RN2sTxc%i-Hrg*)yXVDHVt9kzg9K~~PzZMjHr%tkK+z&ICH3N{KGOj=Q zlv0|x3Ykhpn^KVZ{ka{<?moLsOB2-5eh^hZgeYP#@#$X*YBV8it8mAjJz|D&Z*)9p zFND!c6))Dp<o&7lBSmYn#^S-!aicdo@qyNpNlk`j``K{3WBSinjq@72Gef+RgOyoh zsq4GincN=Ib+qyib{h#7qrefHtVU-bo;3;*w5`foL<g?2aR}NBt_HTCABk;EPMw3A zKpgA{6Swau6j4#p9>%{B-%=rm#nR=zaht<j@X7?;@$7m8q0`MJ<cY9?GHItwOmH=D zDl`w$>Y<rrFe((+kffw6^zisPeJf!mJ_Wxp5%{<&^<z69t+&h98Q4glY>6e(re}5U zY<^qP9-p22Dp{tRKLg<;TlzQQ<9q7Oh(~r@;XzC}$7qDIW4uYAZa(=<Nz$EdGK%u# zlYBFE)?lcb*h>W`|3y=2x$S3(!^_|KU2gMdm)Ls}G-^Dl)~-a_MPnNif mYKAS zloznbGL%p*$4qH{(tuJ4CXup`p4OX;k7Zn1#M=K)to=~ZkPPgGZ6&$dccKJzwGGs+ zN~jrA7D2D_W%W>bfxmF=Oyj`LdJF>obe`bV?&cBSr}qWIQAda4DIV--Z%xLb`SOh; z72A6K2zCgG9Tf;yiYk}@HxUdWn-O%ERQqJE69M>KC~E!|UjHlkO!~Sz%_QoUkwsfL z`wc<m_B0A#z|&svKgLp>@hlkNG>V=${4>gU(UHURr@=6iBoa12c7_k5H~MIx7$aNP z(5l&KZ?ii$D$B)J!x+y(@xtu+O23r^)u@{-5`CaR%3!z8gSzbw_x%xt5;9D;GE}Y# ze3oMm1uF(05{JXSvnWl&VYDjheO|eI$wsBRNw`@0!%?-i7A!L_W|S68^3{uWea63V z`EZ~u<huhVc%^K_+$_%Iehp^RU%<Os!D`!m;Ku52CxQab#oZz{t@ls7>(b(an+AAa z)eWh|!JqeN{K}@=Rh5@?x6xp<g!1BX0L@_C^)zwjm$^@`K9s8mf~xu({C6I*WWx~( z)2&!m*>t^l8yG=W&KL&#I=^$HyX~B3WwZFruRj$(W|<H7FZwQ9-qT=&9qHBfbcR-M z`UU&>f&CFuI(m*OE$mhnEINc+j6uzq_Nw)bHPnHFl}C1N<b@Jt>CVfw=2U~Sz(7?R z#?p0!eARbs>zic3qTnr^-nm9|zpflif#lAcHm4aE@hm*BRnW)x>H7!?&HA{Fv$^DF z*J9`QVXFu0uP?RL0UI8op0Wh4>cee^fQQ1j9C>A^P$gz;(GewPC4!Z<$DX`bq8XfX ViPmSih5uP7PykfJK6eAu{{jB03&;Qf delta 1420 zcmV;71#|l0w*i@Ru;2m$g8`G`0$!1TZ-3iKL_t(YiLF#o7Q-M2BYoa`>&deZXSG%$ zKAW!%kt7I(nb8DDLY>c$%*^cToO<zPf&hTibxM9*m&dB2Rr0U{Ph}|%oE+tBJ5cR; zg`g!FwF<U5re6OqQc~6rp(knEcJzsAB0RJO`!~59C>1*Z$!Q;D0l>M-=NlBFsDFCE ze?lOWJTlfuKsZ^sED_#hU!^`9dTifBJ9)vuXaMTw&K(R1)av&twS&z~j!aQ1iIw?3 zzkyi9L255lRr$AyRh7y?Lr~Pszn*up*(OT|>Z13*hjb8)Df|FN!_N^$z>hWn0000< zMNUMnLSTXb=KufzKmY&$|NjaARFfqHUX$Aa4u6?RL_t(|+Pzd;4!|G`;^^MIdn8-b z)Y^gW1N|^5LQ4U_B9sCsz+I>e@F&4}+6dbTdJ;2xAzL(4vZM#w2_h1xV>;^z)G_o( znzyW%v_+X;Na`{^PJ$HnPO=DXrW!mXpJuwpQ^>>hCKFH!GVzxbd|7O?f^14@1<R+X z|0A7u`+GmBASztnvVz)sPXV1|Rspq(qMk4~0PNM&(&kyx1GCo(aSsBQ0h3A^W|4qz zfA2{|K~zYIwN>pBgD?mqJKx*+<k^po$rx#^I_|tHEhU7H3X%qZ))A60GXu7+U9(*g z_2sjAiW_QQ2(U4NEIs2aIl9Vu-h0ddoRKL8N^<0`lPhjvP^HfIZc9-FiEGTX=@|hz zZ0$>OQ<3Woki-u_?0}=rRT2R3>om99e=!gc!io$vQ18rmdV36tBG0C1#Ncv~f#yh^ zNr2JQ><r1~sJ1C4`FLvfD9QROYj8$-bMW^`wl@IVl2V^N^YtSDAyUn{nfE-g|D&7U zdo1O1?UxhV611}MyAnV}RxwpR%)%Vxh${x}c;qymzX0aH=if!p8C3uP002ov2Tnw; zLSTXbvy36Y0|M*-lTIaSfA0VQ3hx1Zc8W*<005pzL_t(|+P#zu3cw%?LvwU*?#7rf ze=!=JP?#utP1*_ok;T2>1fCy-PW%Y~LhQwH0E5^TjUZcUa2&uOaNBfL6S!^If@Ei^ zm&+C@Sy<{69|wa(YiC&mQo;n8>ghUI_iX?yDNx4WQZVzdEh|u`HFR0Q)-EctL(1^| zX6I2-kbBw&q<wv7LIDGOvd`{Flk6xE>r?|u&l`Igasel>9r~DhU8}P+EW`l;E0aMi z6O#-sV1EGJNkl<ZNXM;J(Gr6&2ur;B-Ma7gZrOv!?503B<jpH>2nk34LJ*ROLNoxt z>YT19M;lEfAM#l)ECXcV9>_3&_kc0;K*|iHg;D!%X_0|kv0&AvUiAh<Nw<jX>Gc6% ziIMFxkW-5cAgZFoPEy*(xN<7euGAvZmyp~+PJbD{fl#F9J^&C~%{}&ze|E{S*Cb|g z1A{9AyoYFjK?|oa*fCaR%%C{QLoVufktFVyj{Rfbz2A@X0S%l-H%asN;GFaR)<84K zr=%&{wAm!L;POOr%l`$*I<IMv#|xxd+zvGVx?lhR002ovPDHLkV1fWX0RR9r00030 z|FhCGIuZf_0h10#ZIjyp4u7*rL_t(|+SOG74uBvC<mvvL%2Ln)f|*-wOee^BhZrCt zoF7_t#oTcTM^<9%o(hl@3j*{YA%Kzn7r>Hg83U~j8zpjF(;0&|o3{a2%w0N;l56e^ z<hcp9S+xV-U0%juMj|(ZEj5^XF@p@E?|zuU=Y6oelZkeo1I>ZS)l1Ghxs)6=Pn)0} zWxoVW@dc#rWj_ZtS`1n?q6*}fPi`~d>m^xPf8zKd2))<2Z#<igT!RB7i`O)pLZ&MK a0000<MNUMnLSTXb0J9HHMFq1gTD1YKNPS-b diff --git a/components/tvplanit/source/vpxmlds.pas b/components/tvplanit/source/vpxmlds.pas new file mode 100644 index 000000000..67f74723d --- /dev/null +++ b/components/tvplanit/source/vpxmlds.pas @@ -0,0 +1,1562 @@ +{ Visual PlanIt datastore using an xml file } + +{$I vp.inc} + +unit VpXmlDs; + +interface + +uses + SysUtils, Classes, laz2_xmlread, laz2_xmlwrite, laz2_DOM, + VpData, VpBaseDS; + +type + TVpXmlDatastore = class(TVpCustomDatastore) + private + FDoc: TXmlDocument; + FFilename: String; + FParentNode: String; + FXmlSettings: TFormatSettings; + procedure SetFilename(const AValue: String); + procedure SetParentNode(const AValue: String); + + protected + procedure Loaded; override; + procedure SetConnected(const AValue: Boolean); override; + function UniqueID(AValue: Integer): Boolean; + + procedure CleanNode(AParentNode: TDOMNode); + function CreateStoreNode(ADoc: TDOMDocument): TDOMNode; + function FindStoreNode(ADoc: TDOMDocument): TDOMNode; + + procedure ReadContact(ANode: TDOMNode; AContacts: TVpContacts); + procedure ReadContacts(ADoc: TDOMDocument; ANode: TDOMNode; AContacts: TVpContacts); + procedure ReadEvent(ANode: TDOMNode; ASchedule: TVpSchedule); + procedure ReadEvents(ADoc: TDOMDocument; ANode: TDOMNode; ASchedule: TVpSchedule); + procedure ReadResource(ADoc: TDOMDocument; ANode: TDOMNode); + procedure ReadResources(ADoc: TDOMDocument; ANode: TDOMNode); + procedure ReadTask(ANode: TDOMNode; ATasks: TVpTasks); + procedure ReadTasks(ADoc: TDOMDocument; ANode: TDOMNode; ATasks: TVpTasks); + + procedure WriteContact(ADoc: TDOMDocument; AContactNode: TDOMNode; AContact: TVpContact); + procedure WriteContacts(ADoc: TDOMDocument; AParentNode: TDOMNode; AResource: TVpResource); + procedure WriteEvent(ADoc: TDOMDocument; AEventNode: TDOMNode; AEvent: TVpEvent); + procedure WriteEvents(ADoc: TDOMDocument; AParentNode: TDOMNode; AResource: TVpResource); + procedure WriteResources(ADoc: TDOMDocument; AParentNode: TDOMNode); + procedure WriteTask(ADoc: TDOMDocument; ATaskNode: TDOMNode; ATask: TVpTask); + procedure WriteTasks(ADoc: TDOMDocument; AParentNode: TDOMNode; AResource: TVpResource); + + procedure ReadFromXML; + procedure WriteToXML; + + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetNextID(TableName: string): Integer; override; + procedure LoadEvents; override; + procedure LoadContacts; override; + procedure LoadTasks; override; + procedure PostContacts; override; + procedure PostEvents; override; + procedure PostResources; override; + procedure PostTasks; override; + procedure SetResourceByName(Value: String); override; + + published + property AutoConnect default false; + property Connected; + property FileName: String read FFileName write SetFileName; + property ParentNode: String read FParentNode write SetParentNode; + + end; + +implementation + +uses + typinfo, StrUtils, Strings, + VpConst, VpMisc, VpSR; + +const + STORE_NODE_NAME = 'DataStore'; + +procedure XmlError(const AMsg: String); +begin + raise Exception.Create(AMsg); +end; + +function GetNodeValue(ANode: TDOMNode): String; +var + child: TDOMNode; +begin + child := ANode.FirstChild; + if child <> nil then + Result := child.NodeValue else + Result := ''; +end; + +function GetAttrValue(ANode: TDOMNode; AAttrName: string) : string; +var + i: LongWord; + Found: Boolean; +begin + Result := ''; + if (ANode = nil) or (ANode.Attributes = nil) then + exit; + + Found := false; + i := 0; + while not Found and (i < ANode.Attributes.Length) do begin + if ANode.Attributes.Item[i].NodeName = AAttrName then begin + Found := true; + Result := ANode.Attributes.Item[i].NodeValue; + end; + inc(i); + end; +end; + +function GetBoolAttrValue(ANode: TDOMNode; AAttrName: String): boolean; +var + s: String; +begin + s := GetAttrValue(ANode, AAttrName); + if s <> '' then begin + if (Lowercase(s) = 'true') or ((Length(s) = 1) and (s[1] in ['t', 'T', '1'])) then + Result := true + else + if (Lowercase(s) = 'false') or ((Length(s) = 1) and (s[1] in ['f', 'F', '0'])) then + Result := false + else + XMLError(Format('Illegal boolean value "%s" for "%s"', [s, AAttrName])); + end else + Result := false; +end; + +function GetIntAttrValue(ANode: TDOMNode; AAttrName: String): Integer; +var + s: String; +begin + s := GetAttrValue(ANode, AAttrName); + if s <> '' then begin + if not TryStrToInt(s, Result) then + XMLError(Format('Illegal integer value "%s" for "%s"', [s, AAttrName])); + end else + Result := 0; +end; + +function GetDateTimeAttrValue(ANode: TDOMNode; AAttrName: String; + const AFormatSettings: TFormatSettings): TDateTime; +var + s: String; +begin + s := GetAttrValue(ANode, AAttrName); + if s <> '' then begin + if not TryStrToDateTime(s, Result, AFormatSettings) then + XMLError(Format('Illegal date/time value "%s" for "%s"', [s, AAttrName])); + end else + Result := 0; +end; + +function GetDateAttrValue(ANode: TDOMNode; AAttrName: String; + const AFormatSettings: TFormatSettings): TDateTime; +var + s: String; +begin + s := GetAttrValue(ANode, AAttrName); + if s <> '' then begin + if not TryStrToDate(s, Result, AFormatSettings) then + XMLError(Format('Illegal date value "%s" for "%s"', [s, AAttrName])); + end else + Result := 0; +end; + +function GetTimeAttrValue(ANode: TDOMNode; AAttrName: String; + const AFormatSettings: TFormatSettings): TDateTime; +var + s: String; +begin + s := GetAttrValue(ANode, AAttrName); + if s <> '' then begin + if not TryStrToTime(s, Result, AFormatSettings) then + XMLError(Format('Illegal time value "%s" for "%s"', [s, AAttrName])); + end else + Result := 0; +end; + +function GetPhoneTypeAttrValue(ANode: TDOMNode; AAttrName: String; + ANr: Integer): TVpPhoneType; +var + s: String; + n: Integer; +begin + s := GetAttrValue(ANode, AAttrName); + n := GetEnumValue(TypeInfo(TVpPhoneType), s); + if (n >= ord(Low(TVpPhoneType))) and (n <= ord(High(TVpPhoneType))) then + Result := TVpPhoneType(n) + else + XMLError(Format('Illegal PhoneType%d value: "%s"', [ANr, s])); +end; + + +{ TVpXmlDatastore } + +constructor TVpXmlDatastore.Create(AOwner: TComponent); +begin + inherited; + FXmlSettings := DefaultFormatSettings; + FXmlSettings.DecimalSeparator := '.'; + FXmlSettings.ThousandSeparator := #0; + FXmlSettings.ShortDateFormat := 'yyyy/mm/dd'; + FXmlSettings.LongTimeFormat := 'hh:nn:ss'; + FXmlSettings.DateSeparator := '/'; + FXmlSettings.TimeSeparator := ':'; +end; + +destructor TVpXmlDatastore.Destroy; +begin + SetConnected(false); + inherited; +end; + +procedure TVpXmlDatastore.CleanNode(AParentNode: TDOMNode); +var + node: TDOMNode; +begin + node := AParentNode.FirstChild; + while node <> nil do begin + AParentNode.RemoveChild(node); + node := AParentNode.FirstChild; + end; +end; + +function TVpXmlDatastore.CreateStoreNode(ADoc: TDOMDocument): TDOMNode; +var + L: TStrings; + i, j: Integer; + node, prevnode: TDOMNode; + rootnode: TDOMNode; + nodename: String; +begin + L := TStringList.Create; + try + if FParentNode <> '' then begin + L.Delimiter := '/'; + L.StrictDelimiter := true; + L.DelimitedText := FParentNode; + if L.Count = 0 then begin + L.Delimiter := '\'; + L.DelimitedText := FParentNode; + end; + end; + + // Get current root node + rootnode := ADoc.FirstChild; + nodeName := rootnode.NodeName; + + if (L.Count = 0) then begin + // no parent node specified --> is it a child of root? + Result := rootnode.FindNode(STORE_NODE_NAME); + // no: attach as child to root + if Result = nil then begin + Result := ADoc.CreateElement(STORE_NODE_NAME); + rootnode.AppendChild(Result); + end; + exit; + end; + + // Parent node path is absolute + if (L[0] = '') then begin + if (L.Count > 1) and (rootnode.NodeName <> L[1]) then begin + // ... but root is different from current root --> Error + Result := nil; + XmlError('Root nodes of xml file and datastore do not match.'); + end; + end; + + node := rootnode; + for i:=0 to L.Count-1 do begin + if (L[i] = '') then + Continue; + if node = rootnode then + prevnode := rootnode + else + prevnode := node.ParentNode; + // Look for the path segment among the nodes of the current level + Result := node.FindNode(L[i]); + if Result = nil then begin + // Not found -> Build sub-tree starting at prev level + for j:= i to L.Count-1 do begin + if L[j] = '' then + Continue; + prevnode := node; + node := ADoc.CreateElement(L[i]); + prevnode.AppendChild(node); + end; + end else + // Found -> Proceed to next level + if i < L.Count-1 then + node := prevnode.FirstChild; + end; + Result := ADoc.CreateElement(STORE_NODE_NAME); + node.AppendChild(Result); + + finally + L.Free; + end; +end; + +function TVpXmlDatastore.FindStoreNode(ADoc: TDOMDocument): TDOMNode; + + function NodeFound(ANode: TDOMNode; ANodeName: String): Boolean; + var + nodename: String; + begin + if ANode = nil then begin + Result := false; + exit; + end; + nodename := ANode.NodeName; + Result := nodename = ANodeName; + if not Result then + Result := NodeFound(ANode.NextSibling, ANodeName); + end; + +var + L: TStringList; + nodename: String; + i: Integer; +begin + L := TStringList.Create; + try + if FParentNode <> '' then begin + L.Delimiter := '/'; + L.StrictDelimiter := true; + L.DelimitedText := FParentNode; + if L.Count = 0 then begin + L.Delimiter := '\'; + L.DelimitedText := FParentNode; + end; + end; + + // DataStore node is root node + if L.Count = 0 then begin + Result := ADoc.FirstChild; + if Result <> nil then begin + nodeName := Result.NodeName; + if nodeName <> STORE_NODE_NAME then + Result := nil; + end; + end else begin + Result := ADoc.FirstChild; + i := 0; + while (i < L.Count) do begin + if L[i] = '' then + Continue; + if NodeFound(Result, L[i]) then begin + Result := Result.FirstChild; + inc(i); + end else begin + Result := nil; + exit; + end; + end; + end; + finally + L.Free; + end; +end; + +function TVpXmlDatastore.GetNextID(TableName: string): Integer; +begin + repeat + Result := Random(High(Integer)); + until UniqueID(Result) and (Result <> -1); +end; + +procedure TVpXmlDatastore.Loaded; +begin + inherited; + if not (csDesigning in ComponentState) then + Connected := AutoConnect; +end; + +function TVpXmlDatastore.UniqueID(AValue: Integer): Boolean; +var + i, j: Integer; + res: TVpResource; +begin + Result := false; + for i:=0 to Resources.Count-1 do begin + res := Resources.Items[i]; + if res.ResourceID = AValue then + exit; + for j:=0 to res.Contacts.Count-1 do + if res.Contacts.GetContact(j).RecordID = AValue then + exit; + for j:=0 to res.Tasks.Count-1 do + if res.Tasks.GetTask(j).RecordID = AValue then + exit; + for j:=0 to res.Schedule.EventCount-1 do + if res.Schedule.GetEvent(j).RecordID = AValue then + exit; + end; + Result := true; +end; + +procedure TVpXmlDatastore.SetConnected(const AValue: Boolean); +begin + if AValue = Connected then + exit; + + if AValue then + ReadFromXml + else + WriteToXml; + + inherited SetConnected(AValue); +end; + +procedure TVpXmlDatastore.SetResourceByName(Value: string); +var + I: integer; + res : TVpResource; +begin + for I := 0 to pred(Resources.Count) do begin + res := Resources.Items[I]; + if Res = nil then + Continue; + + if res.Description = Value then begin + if ResourceID <> Res.ResourceID then begin + ResourceID := Res.ResourceID; + RefreshResource; + end; + Exit; + end; + end; +end; + +procedure TVpXmlDatastore.SetFileName(const AValue: String); +begin + FFileName := AValue; + if AutoConnect then ReadFromXml; +end; + +procedure TVpXmlDatastore.SetParentNode(const AValue: String); +begin + FParentNode := AValue; + if (FFileName <> '') and AutoConnect then + ReadFromXml; +end; + +procedure TVpXmlDatastore.LoadContacts; +begin + // Nothing to do here... +end; + +procedure TVpXmlDatastore.LoadEvents; +begin + // Nothing to do here... +end; + +procedure TVpXmlDatastore.LoadTasks; +begin + // Nothing to do here... +end; + +procedure TVpXmlDatastore.PostContacts; +var + i: Integer; + contact: TVpContact; +begin + if Resource = nil then + exit; + for i := Resource.Contacts.Count-1 downto 0 do begin + contact := Resource.Contacts.GetContact(i); + if contact.Deleted then + contact.Free; + end; + RefreshContacts; +end; + +procedure TVpXmlDatastore.PostEvents; +var + i: Integer; + event: TVpEvent; +begin + if Resource = nil then + exit; + for i := Resource.Schedule.EventCount-1 downto 0 do begin + event := Resource.Schedule.GetEvent(i); + if event.Deleted then + event.Free; + end; + RefreshEvents; +end; + +procedure TVpXmlDatastore.PostResources; +begin + // Nothing to do... +end; + +procedure TVpXmlDatastore.PostTasks; +var + i: Integer; + task: TVpTask; +begin + if Resource = nil then + exit; + for i := Resource.Tasks.Count-1 downto 0 do begin + task := Resource.Tasks.GetTask(i); + if task.Deleted then + task.Free; + end; + RefreshTasks; +end; + +procedure TVpXmlDatastore.ReadFromXml; +var + doc: TXMLDocument; + node, child, storeNode: TDOMNode; + nodename: String; +begin + if FFileName = '' then + exit; + + if not FileExists(FFileName) then + exit; + + doc := nil; + try + ReadXMLFile(doc, FFileName); + storeNode := FindStoreNode(doc); + if storeNode = nil then + exit; + + Resources.ClearResources; + node := storeNode.FirstChild; + while node <> nil do begin + nodeName := node.NodeName; + if nodeName = 'Resources' then + ReadResources(doc, node); + node := node.NextSibling; + end; + finally + doc.Free; + end; +end; + +procedure TVpXmlDatastore.ReadContact(ANode: TDOMNode; AContacts: TVpContacts); +var + node: TDOMNode; + nodeName: String; + cont: TVpContact; + id: Integer; + s: String; +begin + s := GetAttrValue(ANode, 'RecordID'); + if s = '' then + XMLError('RecordID missing'); + if not TryStrToInt(s, id) then + XMLError('RecordID must be a number.'); + + cont := AContacts.AddContact(id); + cont.BirthDate := GetDateAttrValue(ANode, 'BirthDate', FXmlSettings); + cont.Anniversary := GetDateAttrValue(ANode, 'Anniversary', FXmlSettings); + cont.Category := GetIntAttrValue(ANode, 'Category'); + + node := ANode.FirstChild; + while node <> nil do begin + nodeName := node.NodeName; + if nodeName = 'FirstName' then + cont.FirstName := GetNodeValue(node) + else if nodeName = 'LastName' then + cont.LastName := GetNodeValue(node) + else if nodeName = 'Job_Position' then + cont.Job_Position := GetNodeValue(node) + else if nodeName = 'Title' then + cont.Title := GetNodeValue(node) + else if nodeName = 'Company' then + cont.Company := GetNodeValue(node) + else if nodeName = 'Address' then + cont.Address := GetNodeValue(node) + else if nodeName = 'City' then + cont.City := GetNodeValue(node) + else if nodeName = 'Zip' then + cont.Zip := GetNodeValue(node) + else if nodeName = 'State' then + cont.State := GetNodeValue(node) + else if nodeName = 'Country' then + cont.Country := GetNodeValue(node) + else if nodeName = 'EMail' then + cont.EMail := GetNodeValue(node) + else if nodeName = 'Phone1' then begin + cont.Phone1 := GetNodeValue(node); + cont.PhoneType1 := ord(GetPhoneTypeAttrValue(node, 'Type', 1)); + end else if nodeName = 'Phone2' then begin + cont.Phone2 := GetNodeValue(node); + cont.PhoneType2 := ord(GetPhoneTypeAttrValue(node, 'Type', 2)); + end else if nodeName = 'Phone3' then begin + cont.Phone3 := GetNodeValue(node); + cont.PhoneType3 := ord(GetPhoneTypeAttrValue(node, 'Type', 3)); + end else if nodeName = 'Phone4' then begin + cont.Phone4 := GetNodeValue(node); + cont.PhoneType4 := ord(GetPhoneTypeAttrValue(node, 'Type', 4)); + end else if nodeName = 'Phone5' then begin + cont.Phone5 := GetNodeValue(node); + cont.PhoneType5 := ord(GetPhoneTypeAttrValue(node, 'Type', 5)); + end else if nodeName = 'Notes' then + cont.Notes := GetNodeValue(node) + else if nodeName = 'Custom1' then + cont.Custom1 := GetNodeValue(node) + else if nodeName = 'Custom2' then + cont.Custom2 := GetNodeValue(node) + else if nodeName = 'Custom3' then + cont.Custom3 := GetNodeValue(node) + else if nodeName = 'Custom4' then + cont.Custom3 := GetNodeValue(node) + else if nodeName = 'UserField0' then + cont.UserField0 := GetNodeValue(node) + else if nodeName = 'UserField1' then + cont.UserField1 := GetNodeValue(node) + else if nodeName = 'UserField2' then + cont.UserField2 := GetNodeValue(node) + else if nodeName = 'UserField3' then + cont.UserField3 := GetNodeValue(node) + else if nodeName = 'UserField4' then + cont.UserField4 := GetNodeValue(node) + else if nodeName = 'UserField5' then + cont.UserField5 := GetNodeValue(node) + else if nodeName = 'UserField6' then + cont.UserField6 := GetNodeValue(node) + else if nodeName = 'UserField7' then + cont.UserField7 := GetNodeValue(node) + else if nodeName = 'UserField8' then + cont.UserField8 := GetNodeValue(node) + else if nodeName = 'UserField9' then + cont.UserField9 := GetNodeValue(node); + node := node.NextSibling; + end; +end; + +procedure TVpXmlDatastore.ReadContacts(ADoc: TDOMDocument; ANode: TDOMNode; + AContacts: TVpContacts); +var + node: TDOMNode; + nodeName: String; +begin + node := ANode.FirstChild; + while node <> nil do begin + nodeName := node.NodeName; + if nodeName = 'Contact' then + ReadContact(node, AContacts); + node := node.NextSibling; + end; +end; + +procedure TVpXmlDatastore.ReadEvent(ANode: TDOMNode; ASchedule: TVpSchedule); +var + node: TDOMNode; + nodeName: String; + ev: TVpEvent; + id: Integer; + s: String; + n: Integer; + t1, t2: TDateTime; +begin + s := GetAttrValue(ANode, 'RecordID'); + if s = '' then + XMLError('RecordID missing'); + if not TryStrToInt(s, id) then + XMLError('RecordID must be a number.'); + t1 := GetDateTimeAttrValue(ANode, 'StartTime', FXmlSettings); + t2 := GetDateTimeAttrValue(ANode, 'EndTime', FXmlSettings); + + ev := ASchedule.AddEvent(id, t1, t2); + ev.AlarmAdvance := GetIntAttrValue(ANode, 'AlarmAdvance'); + ev.AlarmSet := GetBoolAttrValue(ANode, 'AlarmSet'); + ev.AlertDisplayed := GetBoolAttrValue(ANode, 'AlertDisplayed'); + ev.AllDayEvent := GetBoolAttrValue(ANode, 'AllDayEvent'); + ev.Category := GetIntAttrValue(ANode, 'Category'); + ev.StartTime := t1; + ev.EndTime := t2; + ev.SnoozeTime := GetDateTimeAttrValue(ANode, 'SnoozeTime', FXmlSettings); + ev.RepeatRangeEnd := GetDateTimeAttrValue(ANode, 'RepeatRangeEng', FXmlSettings); + ev.CustomInterval := GetIntAttrValue(ANode, 'CustomInterval'); + + s := GetAttrValue(ANode, 'AlarmAdvanceType'); + if s <> '' then begin + n := GetEnumValue(TypeInfo(TVpAlarmAdvType), s); + if (n >= ord(Low(TVpAlarmAdvType))) and (n <= ord(High(TVpAlarmAdvType))) then + ev.AlarmAdvanceType := TVpAlarmAdvType(n) + else + XMLError(Format('Incorrect AdvanceType value: "%s"', [s])); + end; + + s := GetAttrValue(ANode, 'RepeatCode'); + if s <> '' then begin + n := GetEnumValue(TypeInfo(TVpRepeatType), s); + if (n >= ord(Low(TVpRepeatType))) and (n <= ord(High(TVpRepeatType))) then + ev.RepeatCode := TVpRepeatType(n) + else + XMLError(Format('Incorrect RepeatCode value: "%s"', [s])); + end; + + node := ANode.FirstChild; + while node <> nil do begin + nodeName := node.NodeName; + if nodeName = 'Description' then + ev.Description := GetNodeValue(node) + else if nodeName = 'Notes' then + ev.Notes := GetNodeValue(node) + else if nodeName = 'Location' then + ev.Location := GetNodeValue(node) + else if nodeName = 'DingPath' then + ev.DingPath := GetNodeValue(node) + else if nodeName = 'UserField0' then + ev.UserField0 := GetNodeValue(node) + else if nodeName = 'UserField1' then + ev.UserField1 := GetNodeValue(node) + else if nodeName = 'UserField2' then + ev.UserField2 := GetNodeValue(node) + else if nodeName = 'UserField3' then + ev.UserField3 := GetNodeValue(node) + else if nodeName = 'UserField4' then + ev.UserField4 := GetNodeValue(node) + else if nodeName = 'UserField5' then + ev.UserField5 := GetNodeValue(node) + else if nodeName = 'UserField6' then + ev.UserField6 := GetNodeValue(node) + else if nodeName = 'UserField7' then + ev.UserField7 := GetNodeValue(node) + else if nodeName = 'UserField8' then + ev.UserField8 := GetNodeValue(node) + else if nodeName = 'UserField9' then + ev.UserField9 := GetNodeValue(node); + node := node.NextSibling; + end; +end; + +procedure TVpXmlDatastore.ReadEvents(ADoc: TDOMDocument; ANode: TDOMNode; + ASchedule: TVpSchedule); +var + node: TDOMNode; + nodeName: String; +begin + node := ANode.FirstChild; + while node <> nil do begin + nodeName := node.NodeName; + if nodeName = 'Event' then + ReadEvent(node, ASchedule); + node := node.NextSibling; + end; +end; + +// <Resource ResourceID="1178568021" ResourceActive="true"> +// <Description>some test</Description> +// </Resource> +procedure TVpXmlDatastore.ReadResource(ADoc: TDOMDocument; ANode: TDOMNode); +var + node: TDOMNode; + nodeName: String; + res: TVpResource; + id: Integer; + s: String; +begin + s := GetAttrValue(ANode, 'ResourceID'); + if s = '' then + XMLError('ResourceID missing'); + if not TryStrToInt(s, id) then + XMLError('ResourceID must be a number.'); + + res := Resources.AddResource(id); + res.ResourceActive := GetBoolAttrValue(ANode, 'ResourceActive'); + + node := ANode.FirstChild; + while node <> nil do begin + nodeName := node.NodeName; + if nodeName = 'Description' then + res.Description := GetNodeValue(node) + else if nodeName = 'Notes' then + res.Notes := GetNodeValue(node) + else if nodeName = 'Contacts' then + ReadContacts(ADoc, node, res.Contacts) + else if nodeName = 'Events' then + ReadEvents(ADoc, node, res.Schedule) + else if nodeName = 'Tasks' then + ReadTasks(ADoc, node, res.Tasks) + else if nodeName = 'UserField0' then + res.UserField0 := GetNodeValue(node) + else if nodeName = 'UserField1' then + res.UserField1 := GetNodeValue(node) + else if nodeName = 'UserField2' then + res.UserField2 := GetNodeValue(node) + else if nodeName = 'UserField3' then + res.UserField3 := GetNodeValue(node) + else if nodeName = 'UserField4' then + res.UserField4 := GetNodeValue(node) + else if nodeName = 'UserField5' then + res.UserField5 := GetNodeValue(node) + else if nodeName = 'UserField6' then + res.UserField6 := GetNodeValue(node) + else if nodeName = 'UserField7' then + res.UserField7 := GetNodeValue(node) + else if nodeName = 'UserField8' then + res.UserField8 := GetNodeValue(node) + else if nodeName = 'UserField9' then + res.UserField9 := GetNodeValue(node); + node := node.NextSibling; + end; +end; + +procedure TVpXmlDatastore.ReadResources(ADoc: TDOMDocument; ANode: TDOMNode); +var + node: TDOMNode; + nodeName: String; +begin + node := ANode.FirstChild; + while node <> nil do begin + nodeName := node.NodeName; + if nodeName = 'Resource' then + ReadResource(ADoc, node); + node := node.NextSibling; + end; +end; + +procedure TVpXmlDatastore.ReadTask(ANode: TDOMNode; ATasks: TVpTasks); +var + node: TDOMNode; + nodeName: String; + t: TVpTask; + id: Integer; + s: String; +begin + s := GetAttrValue(ANode, 'RecordID'); + if s = '' then + XMLError('RecordID missing'); + if not TryStrToInt(s, id) then + XMLError('RecordID must be a number.'); + + t := ATasks.AddTask(id); + t.DueDate := GetDateAttrValue(ANode, 'DueDate', FXmlSettings); + t.CompletedOn := GetDateAttrValue(ANode, 'CompletedOn', FXmlSettings); + t.CreatedOn := GetDateAttrValue(ANode, 'CreatedOn', FXmlSettings); + t.Complete := GetBoolAttrValue(ANode, 'Complete'); + t.Priority := GetIntAttrValue(ANode, 'Priority'); + t.Category := GetIntAttrValue(ANode, 'Categoriy'); + + node := ANode.FirstChild; + while node <> nil do begin + nodeName := node.NodeName; + if nodeName = 'Description' then + t.Description := GetNodeValue(node) + else if nodeName = 'Details' then + t.Details := GetNodeValue(node) + else if nodeName = 'UserField0' then + t.UserField0 := GetNodeValue(node) + else if nodeName = 'UserField1' then + t.UserField1 := GetNodeValue(node) + else if nodeName = 'UserField2' then + t.UserField2 := GetNodeValue(node) + else if nodeName = 'UserField3' then + t.UserField3 := GetNodeValue(node) + else if nodeName = 'UserField4' then + t.UserField4 := GetNodeValue(node) + else if nodeName = 'UserField5' then + t.UserField5 := GetNodeValue(node) + else if nodeName = 'UserField6' then + t.UserField6 := GetNodeValue(node) + else if nodeName = 'UserField7' then + t.UserField7 := GetNodeValue(node) + else if nodeName = 'UserField8' then + t.UserField8 := GetNodeValue(node) + else if nodeName = 'UserField9' then + t.UserField9 := GetNodeValue(node); + node := node.NextSibling; + end; +end; + +procedure TVpXmlDatastore.ReadTasks(ADoc: TDOMDocument; ANode: TDOMNode; + ATasks: TVpTasks); +var + node: TDOMNode; + nodeName: String; +begin + node := ANode.FirstChild; + while node <> nil do begin + nodeName := node.NodeName; + if nodeName = 'Task' then + ReadTask(node, ATasks); + node := node.NextSibling; + end; +end; + +procedure TVpXmlDatastore.WriteContact(ADoc: TDOMDocument; AContactNode: TDOMNode; + AContact: TVpContact); +var + child, txt: TDOMNode; +begin + with TDOMElement(AContactNode) do begin + SetAttribute('RecordID', IntToStr(AContact.RecordID)); + SetAttribute('Category', IntToStr(AContact.Category)); + if AContact.BirthDate <> 0 then + SetAttribute('BirthDate', DateToStr(AContact.BirthDate, FXmlSettings)); + if AContact.Anniversary <> 0 then + SetAttribute('Anniversary', DateToStr(AContact.Anniversary, FXmlSettings)); + end; + + if AContact.FirstName <> '' then begin + child := ADoc.CreateElement('FirstName'); + txt := ADoc.CreateTextNode(AContact.FirstName); + child.AppendChild(txt); + AContactNode.Appendchild(child); + end; + + if AContact.LastName <> '' then begin + child := ADoc.CreateElement('LastName'); + txt := ADoc.CreateTextNode(AContact.LastName); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Title <> '' then begin + child := ADoc.CreateElement('Title'); + txt := ADoc.CreateTextNode(AContact.Title); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Company <> '' then begin + child := ADoc.CreateElement('Company'); + txt := ADoc.CreateTextNode(AContact.Company); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Job_Position <> '' then begin + child := ADoc.CreateElement('Job_Position'); + txt := ADoc.CreateTextNode(AContact.Job_Position); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.EMail <> '' then begin + child := ADoc.CreateElement('EMail'); + txt := ADoc.CreateTextNode(AContact.EMail); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Phone1 <> '' then begin + child := ADoc.CreateElement('Phone1'); + TDOMElement(child).SetAttribute('Type', + GetEnumName(TypeInfo(TVpPhoneType), ord(AContact.PhoneType1))); + txt := ADoc.CreateTextNode(AContact.Phone1); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Phone2 <> '' then begin + child := ADoc.CreateElement('Phone2'); + TDOMElement(child).SetAttribute('Type', + GetEnumName(TypeInfo(TVpPhoneType), ord(AContact.PhoneType2))); + txt := ADoc.CreateTextNode(IntToStr(AContact.PhoneType2)); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Phone3 <> '' then begin + child := ADoc.CreateElement('Phone3'); + TDOMElement(child).SetAttribute('Type', + GetEnumName(TypeInfo(TVpPhoneType), ord(AContact.PhoneType3))); + txt := ADoc.CreateTextNode(AContact.Phone3); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Phone4 <> '' then begin + child := ADoc.CreateElement('Phone4'); + TDOMElement(child).SetAttribute('Type', + GetEnumName(TypeInfo(TVpPhoneType), ord(AContact.PhoneType4))); + txt := ADoc.CreateTextNode(AContact.Phone4); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Phone5 <> '' then begin + child := ADoc.CreateElement('Phone5'); + TDOMElement(child).SetAttribute('Type', + GetEnumName(TypeInfo(TVpPhoneType), ord(AContact.PhoneType5))); + txt := ADoc.CreateTextNode(AContact.Phone5); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Address <> '' then begin + child := ADoc.CreateElement('Address'); + txt := ADoc.CreateTextNode(AContact.Address); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.City <> '' then begin + child := ADoc.CreateElement('City'); + txt := ADoc.CreateTextNode(AContact.City); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.State <> '' then begin + child := ADoc.CreateElement('State'); + txt := ADoc.CreateTextNode(AContact.State); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Zip <> '' then begin + child := ADoc.CreateElement('Zip'); + txt := ADoc.CreateTextNode(AContact.Zip); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Country <> '' then begin + child := ADoc.CreateElement('Country'); + txt := ADoc.CreateTextNode(AContact.Country); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Notes <> '' then begin + child := ADoc.CreateElement('Notes'); + txt := ADoc.CreateTextNode(AContact.Notes); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Custom1 <> '' then begin + child := ADoc.CreateElement('Custom1'); + txt := ADoc.CreateTextNode(AContact.Custom1); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Custom2 <> '' then begin + child := ADoc.CreateElement('Custom2'); + txt := ADoc.CreateTextNode(AContact.Custom2); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Custom3 <> '' then begin + child := ADoc.CreateElement('Custom3'); + txt := ADoc.CreateTextNode(AContact.Custom3); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.Custom4 <> '' then begin + child := ADoc.CreateElement('Custom4'); + txt := ADoc.CreateTextNode(AContact.Custom4); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.UserField0 <> '' then begin + child := ADoc.CreateElement('UserField0'); + txt := ADoc.CreateTextNode(AContact.UserField0); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.UserField1 <> '' then begin + child := ADoc.CreateElement('UserField1'); + txt := ADoc.CreateTextNode(AContact.UserField1); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.UserField2 <> '' then begin + child := ADoc.CreateElement('UserField2'); + txt := ADoc.CreateTextNode(AContact.UserField2); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.UserField3 <> '' then begin + child := ADoc.CreateElement('UserField3'); + txt := ADoc.CreateTextNode(AContact.UserField3); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.UserField4 <> '' then begin + child := ADoc.CreateElement('UserField4'); + txt := ADoc.CreateTextNode(AContact.UserField4); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.UserField5 <> '' then begin + child := ADoc.CreateElement('UserField5'); + txt := ADoc.CreateTextNode(AContact.UserField5); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.UserField6 <> '' then begin + child := ADoc.CreateElement('UserField6'); + txt := ADoc.CreateTextNode(AContact.UserField6); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.UserField7 <> '' then begin + child := ADoc.CreateElement('UserField7'); + txt := ADoc.CreateTextNode(AContact.UserField7); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.UserField8 <> '' then begin + child := ADoc.CreateElement('UserField8'); + txt := ADoc.CreateTextNode(AContact.UserField8); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; + + if AContact.UserField9 <> '' then begin + child := ADoc.CreateElement('UserField9'); + txt := ADoc.CreateTextNode(AContact.UserField9); + child.AppendChild(txt); + AContactNode.AppendChild(child); + end; +end; + +procedure TVpXmlDatastore.WriteContacts(ADoc: TDOMDocument; AParentNode: TDOMNode; + AResource: TVpResource); +var + i: Integer; + node, contNode: TDOMNode; + cont: TVpContact; +begin + node := ADoc.CreateElement('Contacts'); + TDOMElement(node).SetAttribute('Count', IntToStr(AResource.Contacts.Count)); + AParentNode.AppendChild(node); + + for i := 0 to AResource.Contacts.Count-1 do begin + cont := AResource.Contacts.GetContact(i); + contNode := ADoc.CreateElement('Contact'); + node.AppendChild(contNode); + WriteContact(ADoc, contNode, cont); + end; +end; + +procedure TVpXmlDatastore.WriteEvent(ADoc: TDOMDocument; AEventNode: TDOMNode; + AEvent: TVpEvent); +var + child, txt: TDOMNode; +begin + with TDOMElement(AEventNode) do begin + SetAttribute('RecordID', IntToStr(AEvent.RecordID)); + SetAttribute('Category', IntToStr(AEvent.Category)); + if AEvent.StartTime <> 0 then + SetAttribute('StartTime', DateTimeToStr(AEvent.StartTime, FXmlSettings)); + if AEvent.EndTime <> 0 then + SetAttribute('EndTime', DateTimeToStr(AEvent.EndTime, FXmlSettings)); + SetAttribute('AllDayEvent', BoolToStr(AEvent.AllDayEvent, strTRUE, strFALSE)); + SetAttribute('RepeatCode', GetEnumName(TypeInfo(TVpRepeatType), ord(AEvent.RepeatCode))); + if AEvent.RepeatRangeEnd <> 0 then + SetAttribute('RepeatRangeEnd', DateTimeToStr(AEvent.RepeatRangeEnd, FXmlSettings)); + SetAttribute('AlarmSet', BoolToStr(AEvent.AlarmSet, strTRUE, strFALSE)); + SetAttribute('CustomInterval', IntToStr(AEvent.CustomInterval)); + if AEvent.SnoozeTime <> 0 then + SetAttribute('SnoozeTime', TimeToStr(AEvent.SnoozeTime, FXmlSettings)); + SetAttribute('AlarmAdvanceType', GetEnumName(TypeInfo(TVpAlarmAdvType), ord(AEvent.AlarmAdvanceType))); + SetAttribute('AlarmAdvance', IntToStr(AEvent.AlarmAdvance)); + SetAttribute('AlertDisplayed', BoolToStr(AEvent.AlertDisplayed, strTRUE, strFALSE)); + end; + + if AEvent.DingPath <> '' then begin + child := ADoc.CreateElement('DingPath'); + txt := ADoc.CreateTextNode(AEvent.DingPath); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.Description <> '' then begin + child := ADoc.CreateElement('Description'); + txt := ADoc.CreateTextNode(AEvent.Description); + child.AppendChild(txt); + AEventNode.Appendchild(child); + end; + + if AEvent.Notes <> '' then begin + child := ADoc.CreateElement('Notes'); + txt := ADoc.CreateTextNode(AEvent.Notes); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.Location <> '' then begin + child := ADoc.CreateElement('Location'); + txt := ADoc.CreateTextNode(AEvent.Location); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.UserField0 <> '' then begin + child := ADoc.CreateElement('UserField0'); + txt := ADoc.CreateTextNode(AEvent.UserField0); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.UserField1 <> '' then begin + child := ADoc.CreateElement('UserField1'); + txt := ADoc.CreateTextNode(AEvent.UserField1); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.UserField2 <> '' then begin + child := ADoc.CreateElement('UserField2'); + txt := ADoc.CreateTextNode(AEvent.UserField2); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.UserField3 <> '' then begin + child := ADoc.CreateElement('UserField3'); + txt := ADoc.CreateTextNode(AEvent.UserField3); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.UserField4 <> '' then begin + child := ADoc.CreateElement('UserField4'); + txt := ADoc.CreateTextNode(AEvent.UserField4); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.UserField5 <> '' then begin + child := ADoc.CreateElement('UserField5'); + txt := ADoc.CreateTextNode(AEvent.UserField5); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.Userfield6 <> '' then begin + child := ADoc.CreateElement('UserField6'); + txt := ADoc.CreateTextNode(AEvent.UserField6); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.UserField7 <> '' then begin + child := ADoc.CreateElement('UserField7'); + txt := ADoc.CreateTextNode(AEvent.UserField7); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.UserField8 <> '' then begin + child := ADoc.CreateElement('UserField8'); + txt := ADoc.CreateTextNode(AEvent.UserField8); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; + + if AEvent.UserField9 <> '' then begin + child := ADoc.CreateElement('UserField9'); + txt := ADoc.CreateTextNode(AEvent.UserField9); + child.AppendChild(txt); + AEventNode.AppendChild(child); + end; +end; + +procedure TVpXmlDatastore.WriteEvents(ADoc: TDOMDocument; AParentNode: TDOMNode; + AResource: TVpResource); +var + i: Integer; + node, evNode, child, txt: TDOMNode; + ev: TVpEvent; +begin + node := ADoc.CreateElement('Events'); + TDOMElement(node).SetAttribute('Count', IntToStr(AResource.Schedule.EventCount)); + AParentNode.AppendChild(node); + + for i:=0 to AResource.Schedule.EventCount-1 do begin + ev := AResource.Schedule.GetEvent(i); + evNode := ADoc.CreateElement('Event'); + node.AppendChild(evNode); + WriteEvent(ADoc, evNode, ev); + end; +end; + +procedure TVpXmlDatastore.WriteResources(ADoc: TDOMDocument; AParentNode: TDOMNode); +var + i: Integer; + node, resnode, child, txt: TDOMNode; + res: TVpResource; +begin + node := ADoc.CreateElement('Resources'); + TDOMElement(node).SetAttribute('Count', IntToStr(Resources.Count)); + AParentNode.AppendChild(node); + + for i:=0 to Resources.Count-1 do begin + res := Resources.Items[i]; + + resNode := ADoc.CreateElement('Resource'); + with TDOMElement(resNode) do begin + SetAttribute('ResourceID', IntToStr(res.ResourceID)); + SetAttribute('ResourceActive', BoolToStr(res.ResourceActive, strTRUE, strFALSE)); + end; + node.AppendChild(resnode); + + if res.Description <> '' then begin + child := ADoc.CreateElement('Description'); + txt := ADoc.CreateTextNode(res.Description); + child.AppendChild(txt);; + resnode.AppendChild(child); + end; + + if res.Notes <> '' then begin + child := ADoc.CreateElement('Notes'); + txt := ADoc.CreateTextNode(res.Notes); + child.AppendChild(txt); + resnode.AppendChild(child); + end; + + if res.UserField0 <> '' then begin + child := ADoc.CreateElement('UserField0'); + txt := ADoc.CreateTextNode(res.UserField0); + child.AppendChild(txt); + resnode.AppendChild(child); + end; + + if res.UserField1 <> '' then begin + child := ADoc.CreateElement('UserField1'); + txt := ADoc.CreateTextNode(res.UserField1); + child.AppendChild(txt); + resnode.AppendChild(child); + end; + + if res.UserField2 <> '' then begin + child := ADoc.CreateElement('UserField2'); + txt := ADoc.CreateTextNode(res.UserField2); + child.AppendChild(txt); + resnode.AppendChild(child); + end; + + if res.UserField3 <> '' then begin + child := ADoc.CreateElement('UserField3'); + txt := ADoc.CreateTextNode(res.UserField3); + child.AppendChild(txt); + resnode.AppendChild(child); + end; + + if res.UserField4 <> '' then begin + child := ADoc.CreateElement('UserField4'); + txt := ADoc.CreateTextNode(res.UserField4); + child.AppendChild(txt); + resnode.AppendChild(child); + end; + + if res.UserField5 <> '' then begin + child := ADoc.CreateElement('UserField5'); + txt := ADoc.CreateTextNode(res.UserField5); + child.AppendChild(txt); + resnode.AppendChild(child); + end; + + if res.UserField6 <> '' then begin + child := ADoc.CreateElement('UserField6'); + txt := ADoc.CreateTextNode(res.UserField6); + child.AppendChild(txt); + resnode.AppendChild(child); + end; + + if res.UserField7 <> '' then begin + child := ADoc.CreateElement('UserField7'); + txt := ADoc.CreateTextNode(res.UserField7); + child.AppendChild(txt); + resnode.AppendChild(child); + end; + + if res.UserField8 <> '' then begin + child := ADoc.CreateElement('UserField8'); + txt := ADoc.CreateTextNode(res.UserField8); + child.AppendChild(txt); + resnode.AppendChild(child); + end; + + if res.UserField9 <> '' then begin + child := ADoc.CreateElement('UserField9'); + txt := ADoc.CreateTextNode(res.UserField9); + child.AppendChild(txt); + resnode.AppendChild(child); + end; + + WriteContacts(ADoc, resnode, res); + WriteEvents(ADoc, resnode, res); + WriteTasks(ADoc, resNode, res); + end; +end; + +procedure TVpXmlDatastore.WriteTask(ADoc: TDOMDocument; ATaskNode: TDOMNode; + ATask: TVpTask); +var + child, txt: TDOMNode; +begin + with TDOMElement(ATaskNode) do begin + SetAttribute('RecordID', IntToStr(ATask.RecordID)); + SetAttribute('Category', IntToStr(ATask.Category)); + SetAttribute('Priority', IntToStr(ATask.Priority)); + SetAttribute('DueDate', DateToStr(ATask.DueDate, FXmlSettings)); + SetAttribute('Complete', BoolToStr(ATask.Complete, strTRUE, strFALSE)); + if ATask.CreatedOn > 0 then + SetAttribute('CreatedOn', DateToStr(ATask.CreatedOn, FXmlSettings)); + if ATask.CompletedOn > 0 then + SetAttribute('CompletedOn', DateToStr(ATask.CompletedOn, FXmlSettings)); + end; + + if ATask.Description <> '' then begin + child := ADoc.CreateElement('Description'); + txt := ADoc.CreateTextNode(ATask.Description); + child.AppendChild(txt);; + ATaskNode.AppendChild(child); + end; + + if ATask.Details <> '' then begin + child := ADoc.CreateElement('Details'); + txt := ADoc.CreateTextNode(ATask.Details); + child.AppendChild(txt); + ATaskNode.AppendChild(child); + end; + + if ATask.UserField0 <> '' then begin + child := ADoc.CreateElement('UserField0'); + txt := ADoc.CreateTextNode(ATask.UserField0); + child.AppendChild(txt); + ATaskNode.AppendChild(child); + end; + + if ATask.UserField1 <> '' then begin + child := ADoc.CreateElement('UserField1'); + txt := ADoc.CreateTextNode(ATask.UserField1); + child.AppendChild(txt); + ATaskNode.AppendChild(child); + end; + + if ATask.UserField2 <> '' then begin + child := ADoc.CreateElement('UserField2'); + txt := ADoc.CreateTextNode(ATask.UserField2); + child.AppendChild(txt); + ATaskNode.AppendChild(child); + end; + + if ATask.UserField3 <> '' then begin + child := ADoc.CreateElement('UserField3'); + txt := ADoc.CreateTextNode(ATask.UserField3); + child.AppendChild(txt); + ATaskNode.AppendChild(child); + end; + + if ATask.UserField4 <> '' then begin + child := ADoc.CreateElement('UserField4'); + txt := ADoc.CreateTextNode(ATask.UserField4); + child.AppendChild(txt); + ATaskNode.AppendChild(child); + end; + + if ATask.UserField5 <> '' then begin + child := ADoc.CreateElement('UserField5'); + txt := ADoc.CreateTextNode(ATask.UserField5); + child.AppendChild(txt); + ATaskNode.AppendChild(child); + end; + + if ATask.UserField6 <> '' then begin + child := ADoc.CreateElement('UserField6'); + txt := ADoc.CreateTextNode(ATask.UserField6); + child.AppendChild(txt); + ATaskNode.AppendChild(child); + end; + + if ATask.UserField7 <> '' then begin + child := ADoc.CreateElement('UserField7'); + txt := ADoc.CreateTextNode(ATask.UserField7); + child.AppendChild(txt); + ATaskNode.AppendChild(child); + end; + + if ATask.UserField8 <> '' then begin + child := ADoc.CreateElement('UserField8'); + txt := ADoc.CreateTextNode(ATask.UserField8); + child.AppendChild(txt); + ATaskNode.AppendChild(child); + end; + + if ATask.UserField9 <> '' then begin + child := ADoc.CreateElement('UserField9'); + txt := ADoc.CreateTextNode(ATask.UserField9); + child.AppendChild(txt); + ATaskNode.AppendChild(child); + end; +end; + +procedure TVpXmlDatastore.WriteTasks(ADoc: TDOMDocument; AParentNode: TDOMNode; + AResource: TVpResource); +var + i: Integer; + node, tnode, child, txt: TDOMNode; + t: TVpTask; +begin + node := ADoc.CreateElement('Tasks'); + TDOMElement(node).SetAttribute('Count', IntToStr(AResource.Tasks.Count)); + AParentNode.AppendChild(node); + + for i:=0 to AResource.Tasks.Count-1 do begin + t := AResource.Tasks.GetTask(i); + tNode := ADoc.CreateElement('Task'); + node.AppendChild(tNode); + WriteTask(ADoc, tNode, t); + end; +end; + +procedure TVpXmlDatastore.WriteToXML; +var + doc: TXMLDocument; + storeNode: TDOMNode; +begin + if FFileName = '' then + exit; + + doc := nil; + try + if FileExists(FFileName) then begin + // Read existing file and find the node containing the store data + ReadXMLFile(doc, FFileName); + storeNode := FindStoreNode(doc); + // If the file does not contain a store node create a new subtree + if storeNode = nil then + storeNode := CreateStoreNode(doc); + // Remove any pre-existing store data to be replaced by new data. + CleanNode(storeNode); + end else begin + // If file does not exist then create a new xml document + doc := TXMLDocument.Create; + storeNode := doc.CreateElement(STORE_NODE_NAME); + doc.AppendChild(storeNode); + end; + + WriteResources(doc, storeNode); + WriteXMLFile(doc, FFileName); + finally + doc.Free; + end; +end; + +end.