fpdatadict.pp 92 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2007 by Michael Van Canneyt, member of the
  4. Free Pascal development team
  5. Data Dictionary Implementation.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit fpdatadict;
  13. {$mode objfpc}{$H+}
  14. interface
  15. uses
  16. Classes, SysUtils,inicol, inifiles, contnrs, db, sqltypes;
  17. Type
  18. // Supported objects in this data dictionary
  19. TObjectType = (otUnknown,otDictionary,
  20. otTables,otTable,
  21. otFields,otField,
  22. otConnection,otTableData,
  23. otIndexDefs,otIndexDef,
  24. otSequenceDefs,otSequenceDef,
  25. otForeignKeyDefs,otForeignKeyDef,
  26. otDomainDefs,otDomainDef);
  27. TDDProgressEvent = Procedure(Sender : TObject; Const Msg : String) of Object;
  28. TFPDDFieldList = Class;
  29. TFPDDIndexList = Class;
  30. TDDTableDef = Class;
  31. TDDTableDefs = Class;
  32. TDDFieldDefs = Class;
  33. TDDDomainDef = Class;
  34. TFPDataDictionary = Class;
  35. { TDDFieldDef }
  36. TDDFieldDef = Class(TIniCollectionItem)
  37. private
  38. FAlignMent: TAlignMent;
  39. FConstraint: string;
  40. FConstraintErrorMessage: string;
  41. FCustomConstraint: string;
  42. FDefault: String;
  43. FDefaultExpression: string;
  44. FDisplayLabel: string;
  45. FDisplayWidth: Longint;
  46. FDomain: TDDDomainDef;
  47. FDomainName: string;
  48. FFieldName: string;
  49. FFieldType: TFieldType;
  50. FHint: String;
  51. FPrecision: Integer;
  52. FProviderFlags: TProviderFlags;
  53. FReadOnly: Boolean;
  54. FRequired: Boolean;
  55. FSize: Integer;
  56. FVisible: Boolean;
  57. function GetDomainName: string;
  58. Function IsSizeStored : Boolean;
  59. Function IsPrecisionStored : Boolean;
  60. procedure SetDomain(const AValue: TDDDomainDef);
  61. procedure SetDomainName(const AValue: string);
  62. protected
  63. function GetSectionName: String; override;
  64. procedure SetSectionName(const Value: String); override;
  65. function GetDisplayName: string; override;
  66. Public
  67. Constructor Create(ACollection : TCollection); override;
  68. Function FieldDefs : TDDFieldDefs;
  69. Function DataDictionary : TFPDataDictionary;
  70. // Will return True if the field or the domain it is based on is required
  71. Function FieldIsRequired : Boolean;
  72. Procedure ResolveDomain(ErrorOnFail : Boolean);
  73. Procedure ImportFromField(F: TField; Existing : Boolean = True);
  74. Procedure ApplyToField(F : TField);
  75. Procedure Assign(Source : TPersistent); override;
  76. Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
  77. Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
  78. Property Domain : TDDDomainDef Read FDomain Write SetDomain;
  79. Published
  80. property FieldType : TFieldType Read FFieldType Write FFieldType;
  81. property AlignMent : TAlignMent Read FAlignMent write FAlignment default taLeftJustify;
  82. property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
  83. property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
  84. Property DBDefault : String Read FDefault Write FDEfault;
  85. property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
  86. property DisplayLabel : string read FDisplayLabel write FDisplayLabel;
  87. property DisplayWidth: Longint read FDisplayWidth write FDisplayWidth;
  88. property FieldName: string read FFieldName write FFieldName;
  89. property DomainName: string read GetDomainName write SetDomainName;
  90. property Constraint: string read FConstraint write FConstraint;
  91. property ReadOnly: Boolean read FReadOnly write FReadOnly;
  92. property Required: Boolean read FRequired write FRequired;
  93. property Visible: Boolean read FVisible write FVisible default True;
  94. Property Size : Integer Read FSize Write FSize Stored IsSizeStored;
  95. Property Precision : Integer Read FPrecision Write FPrecision Stored IsPrecisionStored;
  96. Property Hint : String Read FHint Write FHint;
  97. Property ProviderFlags : TProviderFlags Read FProviderFlags Write FProviderFlags;
  98. end;
  99. TDDFieldDefClass = Class of TDDFieldDef;
  100. { TDDTableCollection }
  101. TDDTableCollection = Class(TIniCollection)
  102. private
  103. FTableDef : TDDTableDef;
  104. FTableName: String;
  105. function GetTableName: String;
  106. Protected
  107. Procedure SetTableDef(ATableDef : TDDTableDef);
  108. procedure SetTableName(const AValue: String); virtual;
  109. Public
  110. Function DataDictionary : TFPDataDictionary;
  111. Property TableDef : TDDTableDef Read FTableDef;
  112. Property TableName : String Read GetTableName Write SetTableName;
  113. end;
  114. { TDDFieldDefs }
  115. TDDFieldDefs = Class(TDDTableCollection)
  116. private
  117. function GetField(Index : Integer): TDDFieldDef;
  118. procedure SetField(Index : Integer; const AValue: TDDFieldDef);
  119. Protected
  120. procedure SetTableName(const AValue: String); override;
  121. Public
  122. Constructor Create(ATableDef : TDDTableDef);
  123. Constructor Create(const ATableName : string);
  124. Class Function FieldDefClass : TDDFieldDefClass; virtual;
  125. Property TableDef : TDDTableDef Read FTableDef;
  126. Property TableName : String Read GetTableName Write SetTableName;
  127. Function AddField(AFieldName: String = '') : TDDFieldDef;
  128. Function IndexOfField(const AFieldName : String) : Integer;
  129. Function FindField(const AFieldName : String) : TDDFieldDef;
  130. Function FieldByName(const AFieldName : String) : TDDFieldDef;
  131. Procedure FillFieldList(Const AFieldNames: String; List : TFPDDFieldList);
  132. Property Fields[Index : Integer] : TDDFieldDef Read GetField Write SetField; default;
  133. end;
  134. { TDDIndexDef }
  135. TDDIndexDef = Class(TIniCollectionItem)
  136. private
  137. FCaseinsFields: string;
  138. FDescFields: string;
  139. FExpression: string;
  140. FFields: string;
  141. FIndexName: String;
  142. FOptions: TIndexOptions;
  143. FSource: string;
  144. protected
  145. function GetSectionName: String; override;
  146. procedure SetSectionName(const Value: String); override;
  147. procedure Assign(ASource : TPersistent); override;
  148. Public
  149. Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
  150. Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
  151. Published
  152. Property IndexName : String Read FIndexName Write FIndexName;
  153. property Expression: string read FExpression write FExpression;
  154. property Fields: string read FFields write FFields;
  155. property CaseInsFields: string read FCaseinsFields write FCaseInsFields;
  156. property DescFields: string read FDescFields write FDescFields;
  157. property Options: TIndexOptions read FOptions write FOptions;
  158. property Source: string read FSource write FSource;
  159. end;
  160. { TDDIndexDefs }
  161. TDDIndexDefs = Class(TDDTableCollection)
  162. private
  163. function GetIndex(Index : Integer): TDDIndexDef;
  164. procedure SetIndex(Index : Integer; const AValue: TDDIndexDef);
  165. Protected
  166. procedure SetTableName(const AValue: String); override;
  167. Public
  168. Constructor Create(ATableDef : TDDTableDef);
  169. Constructor Create(const ATableName : String);
  170. Function AddDDIndexDef(AName : String) : TDDIndexDef;
  171. function AddIndex (const AName: String) : TDDIndexDef;
  172. function IndexByName(const AIndexName: String): TDDIndexDef;
  173. function FindIndex(const AIndexName: String): TDDIndexDef;
  174. function IndexOfIndex(const AIndexName: String): Integer;
  175. Property Indexes[Index : Integer] : TDDIndexDef Read GetIndex Write SetIndex; default;
  176. end;
  177. { TDDForeignKeyDef }
  178. TDDForeignKeyDef = Class(TIniCollectionItem)
  179. private
  180. FKeyFields: String;
  181. FKeyName: String;
  182. FReferencedFields: String;
  183. FTableName: String;
  184. procedure SetKeyName(const AValue: String);
  185. protected
  186. function GetSectionName: String; override;
  187. procedure SetSectionName(const Value: String); override;
  188. procedure Assign(ASource : TPersistent); override;
  189. Public
  190. Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
  191. Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
  192. Published
  193. Property KeyName : String Read FKeyName Write SetKeyName;
  194. Property ReferencesTable : String Read FTableName Write FTableName;
  195. Property KeyFields : String Read FKeyFields Write FKeyFields;
  196. Property ReferencedFields : String Read FReferencedFields Write FReferencedFields;
  197. end;
  198. { TDDForeignKeyDefs }
  199. TDDForeignKeyDefs = Class(TIniCollection)
  200. private
  201. FTableName: String;
  202. function GetKey(AIndex : Integer): TDDForeignKeyDef;
  203. procedure SetKey(AIndex : Integer; const AValue: TDDForeignKeyDef);
  204. procedure SetTableName(const AValue: String);
  205. Public
  206. Constructor Create(const ATableName : String);
  207. Function AddForeignKeyDef(const AName : String) : TDDForeignKeyDef;
  208. Property TableName : String Read FTableName Write SetTableName;
  209. Property Indexes[AIndex : Integer] : TDDForeignKeyDef Read GetKey Write SetKey; default;
  210. end;
  211. { TDDTableDef }
  212. TDDTableDef = Class(TIniCollectionItem)
  213. private
  214. FFieldDefs: TDDFieldDefs;
  215. FIndexDefs: TDDIndexDefs;
  216. FKeyDefs: TDDForeignKeyDefs;
  217. FPrimaryKeyName: String;
  218. FTableName: String;
  219. function GetOnProgress: TDDProgressEvent;
  220. function GetPrimaryKeyName: String;
  221. function GetPrimaryIndexDef : TDDIndexDef;
  222. procedure SetTableName(const AValue: String);
  223. protected
  224. function GetSectionName: String; override;
  225. procedure SetSectionName(const Value: String); override;
  226. Public
  227. Constructor Create(ACollection : TCollection); override;
  228. Destructor Destroy; override;
  229. Function DataDictionary : TFPDataDictionary;
  230. Function TableDefs : TDDTableDefs;
  231. Function ImportFromDataset(Dataset : TDataSet; DoClear : Boolean = False; UpdateExisting : Boolean = True) : Integer;
  232. Procedure ApplyToDataset(Dataset : TDataset);
  233. Function AddField(const AFieldName : String = '') : TDDFieldDef;
  234. Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
  235. Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
  236. procedure PrimaryIndexToFields;
  237. procedure FieldsToPrimaryIndex;
  238. Property Fields : TDDFieldDefs Read FFieldDefs;
  239. Property Indexes : TDDIndexDefs Read FIndexDefs;
  240. Property ForeignKeys : TDDForeignKeyDefs Read FKeyDefs;
  241. Property OnProgress : TDDProgressEvent Read GetOnProgress;
  242. Property PrimaryIndexDef : TDDIndexDef read GetPrimaryIndexDef;
  243. Published
  244. Property TableName : String Read FTableName Write SetTableName;
  245. Property PrimaryKeyConstraintName : String Read GetPrimaryKeyName Write FPrimaryKeyName;
  246. end;
  247. { TDDTableDefs }
  248. TDDTableDefs = Class(TIniCollection)
  249. private
  250. FDataDictionary: TFPDataDictionary;
  251. FOnProgress: TDDProgressEvent;
  252. function GetTable(Index : Integer): TDDTableDef;
  253. procedure SetTable(Index : Integer; const AValue: TDDTableDef);
  254. Public
  255. Property DataDictionary: TFPDataDictionary Read FDataDictionary;
  256. Function AddTable(aTableName : String = '') : TDDTableDef;
  257. Function IndexOfTable(const ATableName : String) : Integer;
  258. Function FindTable(const ATableName : String) : TDDTableDef;
  259. Function TableByName(const ATableName : String) : TDDTableDef;
  260. Property Tables[Index : Integer] : TDDTableDef Read GetTable Write SetTable; default;
  261. Property OnProgress : TDDProgressEvent Read FOnProgress Write FOnProgress;
  262. end;
  263. { TDDSequenceDef }
  264. TDDSequenceDef = Class(TIniCollectionItem)
  265. private
  266. FIncrement: Integer;
  267. FSequenceName: String;
  268. FStartValue: Integer;
  269. procedure SetSequenceName(const AValue: String);
  270. protected
  271. function GetSectionName: String; override;
  272. procedure SetSectionName(const Value: String); override;
  273. procedure Assign(ASource : TPersistent); override;
  274. Public
  275. Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
  276. Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
  277. Published
  278. Property SequenceName : String Read FSequenceName Write SetSequenceName;
  279. Property StartValue : Integer Read FStartValue Write FStartValue;
  280. Property Increment : Integer Read FIncrement Write FIncrement;
  281. end;
  282. { TDDSequenceDefs }
  283. TDDSequenceDefs = Class(TIniCollection)
  284. private
  285. FDataDictionary: TFPDataDictionary;
  286. FOnProgress: TDDProgressEvent;
  287. function GetSequence(Index : Integer): TDDSequenceDef;
  288. procedure SetSequence(Index : Integer; const AValue: TDDSequenceDef);
  289. Public
  290. Constructor Create;
  291. Function AddSequence(const ASequenceName : String = '') : TDDSequenceDef;
  292. Function IndexOfSequence(const ASequenceName : String) : Integer;
  293. Function FindSequence(const ASequenceName : String) : TDDSequenceDef;
  294. Function SequenceByName(const ASequenceName : String) : TDDSequenceDef;
  295. Property DataDictionary : TFPDataDictionary Read FDataDictionary;
  296. Property Sequences[Index : Integer] : TDDSequenceDef Read GetSequence Write SetSequence; default;
  297. Property OnProgress : TDDProgressEvent Read FOnProgress Write FOnProgress;
  298. end;
  299. { TDDDomainDef }
  300. TDDDomainDef = Class(TIniCollectionItem)
  301. procedure SetDomainName(const AValue: String);
  302. private
  303. FCheckConstraint: String;
  304. FDomainName: String;
  305. FFieldType: TFieldType;
  306. FPrecision: Integer;
  307. FRequired: Boolean;
  308. FSize: Integer;
  309. protected
  310. function GetSectionName: String; override;
  311. procedure SetSectionName(const Value: String); override;
  312. procedure Assign(ASource : TPersistent); override;
  313. Public
  314. Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
  315. Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
  316. Published
  317. Property DomainName : String Read FDomainName Write SetDomainName;
  318. Property FieldType : TFieldType Read FFieldType Write FFieldType;
  319. property Size : Integer Read FSize Write FSize;
  320. property Precision : Integer Read FPrecision Write FPrecision;
  321. Property Required : Boolean Read FRequired Write FRequired;
  322. Property CheckConstraint : String Read FCheckConstraint Write FCheckConstraint;
  323. end;
  324. { TDDDomainDefs }
  325. TDDDomainDefs = Class(TIniCollection)
  326. private
  327. FDataDictionary: TFPDataDictionary;
  328. FOnProgress: TDDProgressEvent;
  329. function GetDomain(Index : Integer): TDDDomainDef;
  330. procedure SetDomain(Index : Integer; const AValue: TDDDomainDef);
  331. Public
  332. Constructor Create;
  333. Property DataDictionary : TFPDataDictionary Read FDataDictionary;
  334. Function AddDomain(const ADomainName : String = '') : TDDDomainDef;
  335. Function IndexOfDomain(const ADomainName : String) : Integer;
  336. Function FindDomain(const ADomainName : String) : TDDDomainDef;
  337. Function DomainByName(const ADomainName : String) : TDDDomainDef;
  338. Property Domains[Index : Integer] : TDDDomainDef Read GetDomain Write SetDomain; default;
  339. Property OnProgress : TDDProgressEvent Read FOnProgress Write FOnProgress;
  340. end;
  341. { TFPDataDictionary }
  342. TOnApplyDataDictEvent = Procedure (Sender : TObject; Source : TDDFieldDef; Dest : TField; Var Allow : Boolean) of object;
  343. TFPDataDictionary = Class(TPersistent)
  344. private
  345. FDDName: String;
  346. FDomains: TDDDomainDefs;
  347. FFileName: String;
  348. FOnApplyDataDictEvent: TOnApplyDataDictEvent;
  349. FOnProgress: TDDProgressEvent;
  350. FSequences: TDDSequenceDefs;
  351. FTables: TDDTableDefs;
  352. // Last table that returned a match for findfieldDef
  353. FLastMatchTableDef : TDDTableDef;
  354. procedure SetOnProgress(const AValue: TDDProgressEvent);
  355. Public
  356. Constructor Create;
  357. Destructor Destroy; override;
  358. Procedure SaveToFile(const AFileName : String; KeepBackup: Boolean = True);
  359. Procedure SaveToIni(Ini : TCustomIniFile; ASection : String); virtual;
  360. Procedure LoadFromFile(const AFileName : String);
  361. Procedure LoadFromIni(Ini : TCustomIniFile; ASection : String); virtual;
  362. Procedure ApplyToDataset(ADataset : TDataset);
  363. Procedure ApplyToDataset(ADataset : TDataset; OnApply : TOnApplyDataDictEvent);
  364. Function FindFieldDef(const FieldName : String; out TableName : String) : TDDFieldDef;
  365. Function FindFieldDef(const FieldName : String) : TDDFieldDef;
  366. function CanonicalizeFieldName(const InFN: String; Out TN, FN: String): Boolean;
  367. function CanonicalizeFieldName(const InFN: String; Out TableDef : TDDTableDef; Out FN: String): Boolean;
  368. Property Tables : TDDTableDefs Read FTables;
  369. Property Sequences : TDDSequenceDefs Read FSequences;
  370. Property Domains : TDDDomainDefs Read FDomains;
  371. Property FileName : String Read FFileName;
  372. Property Name : String Read FDDName Write FDDName;
  373. Property OnProgress : TDDProgressEvent Read FOnProgress Write SetOnProgress;
  374. Published
  375. // Using name confuses the object inspector grid.
  376. Property DataDictionaryName : String Read FDDName Write FDDName;
  377. Property OnApplyDataDictEvent : TOnApplyDataDictEvent Read FOnApplyDataDictEvent Write FOnApplyDataDictEvent;
  378. end;
  379. { TFPDDFieldList }
  380. TFPDDFieldList = Class(TObjectList)
  381. private
  382. function GetFieldDef(Index : Integer): TDDFieldDef;
  383. procedure SetFieldDef(Index : Integer; const AValue: TDDFieldDef);
  384. Public
  385. Constructor CreateFromTableDef(TD : TDDTableDef);
  386. Constructor CreateFromFieldDefs(FD : TDDFieldDefs);
  387. Property FieldDefs[Index : Integer] : TDDFieldDef Read GetFieldDef Write SetFieldDef; default;
  388. end;
  389. { TFPDDIndexList }
  390. TFPDDIndexList = Class(TObjectList)
  391. private
  392. function GetIndexDef(AIndex : Integer): TDDIndexDef;
  393. procedure SetIndexDef(AIndex : Integer; const AValue: TDDIndexDef);
  394. Public
  395. Constructor CreateFromIndexDefs(FD : TDDIndexDefs);
  396. Property IndexDefs[AIndex : Integer] : TDDIndexDef Read GetIndexDef Write SetIndexDef; default;
  397. end;
  398. { TFPDDSequenceList }
  399. TFPDDSequenceList = Class(TObjectList)
  400. private
  401. function GetSequenceDef(AIndex : Integer): TDDSequenceDef;
  402. procedure SetSequenceDef(AIndex : Integer; const AValue: TDDSequenceDef);
  403. Public
  404. Constructor CreateFromSequenceDefs(SD : TDDSequenceDefs);
  405. Property SequenceDefs[AIndex : Integer] : TDDSequenceDef Read GetSequenceDef Write SetSequenceDef; default;
  406. end;
  407. { TFPDDDomainList }
  408. TFPDDDomainList = Class(TObjectList)
  409. private
  410. function GetDomainDef(AIndex : Integer): TDDDomainDef;
  411. procedure SetDomainDef(AIndex : Integer; const AValue: TDDDomainDef);
  412. Public
  413. Constructor CreateFromDomainDefs(DD : TDDDomainDefs);
  414. Property DomainDefs[AIndex : Integer] : TDDDomainDef Read GetDomainDef Write SetDomainDef; default;
  415. end;
  416. { TFPDDSQLEngine }
  417. TSQLEngineOption = (eoLineFeedAfterField,eoUseOldInWhereParams,eoAndTermsInBrackets,
  418. eoQuoteFieldNames,eoLineFeedAfterAndTerm,eoAddTerminator,
  419. eoSkipForeignkeys);
  420. TSQLEngineOptions = Set of TSQLEngineOption;
  421. TFPDDSQLEngine = Class(TPersistent)
  422. private
  423. FFieldQuoteChar: Char;
  424. FIndent: Integer;
  425. FMaxLineLength: Integer;
  426. FLastLength: integer;
  427. FOptions: TSQLEngineOptions;
  428. FTableDef: TDDTableDef;
  429. FNoIndent : Boolean;
  430. FTerminatorChar : Char;
  431. Protected
  432. procedure CheckTableDef;
  433. Procedure NoIndent;
  434. Procedure ResetLine;
  435. Procedure AddToStringLN(Var Res : String; const S : String);
  436. Procedure AddToString(Var Res : String; S : String);
  437. Procedure FixUpStatement(var Res : String; ForceTerminator : Boolean = False);
  438. Procedure FixUpStatement(SQL : TStrings; ForceTerminator : Boolean = False);
  439. Procedure AddWhereClause(Var Res : String; FieldList: TFPDDFieldList; UseOldParam:Boolean);
  440. Function CreateAndTerm(FD : TDDFieldDef; UseOldParam : Boolean): string;
  441. // Primitives. Override for engine-specifics
  442. Procedure AddFieldString(Var Res: String;const S : String);
  443. Function FieldNameString(FD : TDDFieldDef) : string; virtual;
  444. Function TableNameString(TD : TDDTableDef) : string; virtual;
  445. Function FieldParamString(FD : TDDFieldDef; UseOldParam : Boolean) : string; virtual;
  446. Function FieldTypeString(ft : TFieldType; ASize,APrecision : Integer) : String; virtual;
  447. Function FieldTypeString(FD : TDDFieldDef) : String;
  448. Function FieldDefaultString(FD : TDDFieldDef) : String; virtual;
  449. Function FieldCheckString(FD : TDDFieldDef) : String; virtual;
  450. Function FieldDeclarationString(FD : TDDFieldDef) : String; virtual;
  451. Property FieldQuoteChar : Char Read FFieldQuoteChar Write FFieldQuoteChar;
  452. Property TerminatorChar : Char Read FTerminatorChar Write FTerminatorChar;
  453. Public
  454. Constructor Create; virtual;
  455. function CreateWhereSQL(Var Res : String; FieldList: TFPDDFieldList; UseOldParam:Boolean): String;
  456. // Methods that fill a stringlist
  457. Procedure CreateSelectSQLStrings(FieldList,KeyFields : TFPDDFieldList; SQL : TStrings);
  458. Procedure CreateInsertSQLStrings(FieldList : TFPDDFieldList; SQL : TStrings);
  459. Procedure CreateUpdateSQLStrings(FieldList,KeyFields : TFPDDFieldList; SQL : TStrings);
  460. Procedure CreateDeleteSQLStrings(KeyFields : TFPDDFieldList; SQL : TStrings);
  461. Procedure CreateCreateSQLStrings(Fields,KeyFields : TFPDDFieldList; SQL : TStrings);
  462. Procedure CreateCreateSQLStrings(KeyFields : TFPDDFieldList; SQL : TStrings);
  463. Procedure CreateIndexesSQLStrings(Indexes : TFPDDIndexList; SQL : TStrings);
  464. Procedure CreateForeignKeysSQLStrings(ForeignKeys: TDDForeignKeyDefs; SQL : TStrings);
  465. Procedure CreateSequencesSQLStrings(Sequences : TFPDDSequenceList; SQL : TStrings);
  466. Procedure CreateDomainsSQLStrings(Domains : TFPDDDomainList; SQL : TStrings);
  467. // Insert/Update/Delete statements.
  468. Function CreateSelectSQL(FieldList,KeyFields : TFPDDFieldList) : String; virtual;
  469. Function CreateInsertSQL(FieldList : TFPDDFieldList) : String; virtual;
  470. Function CreateUpdateSQL(FieldList,KeyFields : TFPDDFieldList) : String; virtual;
  471. Function CreateDeleteSQL(KeyFields : TFPDDFieldList) : String; virtual;
  472. // CREATE TABLE statement
  473. Function CreateCreateSQL(Fields,KeyFields : TFPDDFieldList) : String; virtual;
  474. Function CreateCreateSQL(KeyFields : TFPDDFieldList) : String; virtual;
  475. // CREATE INDEX
  476. Function CreateIndexSQL(Index : TDDIndexDef) : String; virtual;
  477. Function CreateIndexesSQL(Indexes : TFPDDIndexList) : String;
  478. Function CreateIndexesSQL(Indexes : TDDIndexDefs) : String;
  479. // CONSTRAINT: Foreign keys
  480. Function CreateForeignKeySQL(ForeignKey: TDDForeignKeyDef) : String;virtual;
  481. Function CreateForeignKeysSQL(ForeignKeys: TDDForeignKeyDefs) : String;
  482. // CREATE SEQUENCE
  483. Function CreateSequenceSQL(Sequence : TDDSequenceDef) : String; virtual;
  484. Function CreateSequencesSQL(Sequences : TFPDDSequenceList) : String;
  485. Function CreateSequencesSQL(Sequences : TDDSequenceDefs) : String;
  486. // CREATE DOMAIN
  487. Function CreateDomainSQL(Domain : TDDDomainDef) : String; virtual;
  488. Function CreateDomainsSQL(Domains : TFPDDDomainList) : String;
  489. Function CreateDomainsSQL(Domains : TDDDomainDefs) : String;
  490. // Convenience calls
  491. Function CreateTableSQL : String;
  492. Procedure CreateTableSQLStrings(SQL : TStrings);
  493. Property TableDef : TDDTableDef Read FTableDef Write FTableDef;
  494. Published
  495. Property MaxLineLength : Integer Read FMaxLineLength Write FMaxLineLength default 72;
  496. Property Indent : Integer Read FIndent Write FIndent default 2;
  497. Property Options : TSQLEngineOptions Read FOptions Write FOptions;
  498. end;
  499. { TFPDDEngine }
  500. TFPDDEngineCapability =(ecImport,ecCreateTable,ecViewTable, ecTableIndexes,
  501. ecRunQuery, ecRowsAffected, ecSequences, ecDomains);
  502. TFPDDEngineCapabilities = set of TFPDDEngineCapability;
  503. {
  504. to avoid dependencies on GUI elements in the data dictionary engines,
  505. connection string dialogs must be registered separately.
  506. TGetConnectionEvent is the callback prototype for such a dialog
  507. }
  508. TGetConnectionEvent = Procedure(Sender: TObject; Var Connection : String) of object;
  509. TFPDDEngine = Class(TComponent)
  510. private
  511. FOnProgress: TDDProgressEvent;
  512. Protected
  513. FConnected: Boolean;
  514. FConnectString: String;
  515. Procedure DoProgress(Const Msg : String);
  516. // Utility routine which can be used by descendents.
  517. procedure IndexDefsToDDIndexDefs(IDS : TIndexDefs; DDIDS : TDDindexDefs);
  518. Public
  519. Destructor Destroy; override;
  520. Function GetConnectString : String; virtual;
  521. // Mandatory for all data dictionary engines.
  522. Class function Description : string; virtual; abstract;
  523. Class function DBType : String; virtual; abstract;
  524. Class function EngineCapabilities : TFPDDEngineCapabilities; virtual;
  525. Function Connect(const ConnectString : String) : Boolean; virtual; abstract;
  526. Procedure Disconnect ; virtual; abstract;
  527. procedure ImportDatadict (Adatadict: TFPDataDictionary; UpdateExisting : Boolean);
  528. Function GetTableList(List : TStrings) : Integer; virtual; abstract;
  529. Function GetObjectList(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual; abstract;
  530. Function ImportTables(Tables : TDDTableDefs; List : TStrings; UpdateExisting : Boolean) : Integer;
  531. Function ImportFields(Table : TDDTableDef) : Integer; virtual; abstract;
  532. Function ImportIndexes(Table : TDDTableDef) : Integer; virtual; abstract;
  533. function GetDomainList(List: TSTrings) : integer; virtual;
  534. Function ImportDomains(Domains : TDDDomainDefs; List : TStrings; UpdateExisting : boolean) : Integer; virtual;
  535. function GetSequenceList (List:TStrings): integer; virtual;
  536. Function ImportSequences(Sequences : TDDSequenceDefs; List : TStrings; UpdateExisting : boolean) : Integer; virtual;
  537. // Override depending on capabilities
  538. Procedure CreateTable(Table : TDDTableDef); virtual;
  539. // Should not open the dataset.
  540. Function ViewTable(Const TableName: String; DatasetOwner : TComponent) : TDataset; virtual;
  541. // Run a non-select query. If possible, returns the number of modified records.
  542. Function RunQuery(SQL : String) : Integer; Virtual;
  543. // Create a select query TDataset. Do not open the resulting dataset.
  544. Function CreateQuery(SQL : String; DatasetOwner : TComponent) : TDataset; Virtual;
  545. // Assign a select query and open the resulting dataset.
  546. Procedure SetQueryStatement(SQL : String; AQuery : TDataset); Virtual;
  547. // Get table index defs. Return number of defs (if ecTableIndexes in capabilities)
  548. Function GetTableIndexDefs(ATableName : String; Defs : TDDIndexDefs) : integer ;virtual;
  549. // Override if a better implementation exists.
  550. Function CreateSQLEngine : TFPDDSQLEngine; virtual;
  551. Property OnProgress : TDDProgressEvent Read FOnProgress Write FOnProgress;
  552. Property ConnectString : String Read FConnectString;
  553. Property Connected : Boolean Read FConnected Write FConnected;
  554. end;
  555. TFPDDEngineClass = Class of TFPDDEngine;
  556. EDataDict = Class(Exception);
  557. Procedure RegisterDictionaryEngine(AEngine :TFPDDEngineClass);
  558. Function IsDictionaryEngineRegistered(AEngine :TFPDDEngineClass) : boolean;
  559. Procedure RegisterConnectionStringCallback(Const AName: String; CallBack : TGetConnectionEvent);
  560. Procedure UnRegisterDictionaryEngine(AEngine :TFPDDEngineClass);
  561. Function GetDictionaryEngineList(List : TStrings) : Integer;
  562. Function GetDictionaryEngineInfo(Const AName : String; out ADescription,ADBType: String; out ACapabilities : TFPDDEngineCapabilities) : boolean;
  563. Function CreateDictionaryEngine(const AName : String; AOWner : TComponent) : TFPDDEngine;
  564. Function IndexOptionsToString (Options : TIndexOptions) : String;
  565. Var
  566. DefaultDDExt : String = '.fpd';
  567. // Default values for SQL Engine properties.
  568. DefaultSQLEngineOptions : TSQLEngineOptions
  569. = [eoLineFeedAfterField,eoUseOldInWhereParams,
  570. eoAndTermsInBrackets,eoLineFeedAfterAndTerm];
  571. DefaultSQLEngineIndent : Integer = 2;
  572. DefaultSQLEngineLineLength : Integer = 72;
  573. DefaultSQLTerminatorChar : Char = ';';
  574. DefaultSQLFieldQuoteChar : Char = '"';
  575. implementation
  576. uses typinfo;
  577. { ---------------------------------------------------------------------
  578. Constants, not to be localized
  579. ---------------------------------------------------------------------}
  580. Const
  581. // Datadict saving
  582. SDataDict = 'FPDataDict';
  583. KeyDataDictName = 'DataDictName';
  584. // Tables Saving
  585. SDataDictTables = SDataDict+'_Tables';
  586. KeyTableName = 'TableName';
  587. KeyPrimaryKeyConstraint = 'PrimaryKeyConstraint';
  588. // Fields Saving
  589. SFieldSuffix = '_Fields';
  590. KeyAlignMent = 'AlignMent';
  591. KeyCustomConstraint = 'CustomConstraint';
  592. KeyConstraintErrorMessage = 'ConstraintErrorMessage';
  593. KeyDBDefault = 'DBDefault';
  594. KeyDefaultExpression = 'DefaultExpression';
  595. KeyDisplayLabel = 'DisplayLabel';
  596. KeyDisplayWidth = 'DisplayWidth';
  597. KeyFieldName = 'FieldName';
  598. KeyDomainName = 'DomainName';
  599. KeyConstraint = 'Constraint';
  600. KeyReadOnly = 'ReadOnly';
  601. KeyRequired = 'Required';
  602. KeyVisible = 'Visible';
  603. KeySize = 'Size';
  604. KeyPrecision = 'Precision';
  605. KeyFieldType = 'FieldType';
  606. KeyHint = 'Hint';
  607. KeyProviderFlags = 'Providerflags';
  608. // Index saving
  609. SIndexSuffix = '_Indices';
  610. KeyExpression = 'Expression';
  611. KeyFields = 'Fields';
  612. KeyCaseInsFields = 'CaseInsFields';
  613. KeyDescFields = 'DescFields';
  614. KeySource = 'Source';
  615. KeyOptions = 'Options';
  616. // Foreign key Saving
  617. SKeySuffix = '_FOREIGNKEYS';
  618. KeyKeyFields = 'KeyFields';
  619. KeyKeyName = 'KeyName';
  620. KeyReferencesTable = 'ReferencesTable';
  621. KeyReferencedFields = 'ReferencedFields';
  622. // Sequence saving
  623. SDatadictSequences = SDataDict+'_Sequences';
  624. KeyStartValue = 'StartValue';
  625. KeyIncrement = 'Increment';
  626. // Domain saving
  627. SDataDictDomains = SDataDict+'_Domains';
  628. KeyCheckConstraint = 'Constraint';
  629. // SQL Keywords
  630. SSelect = 'SELECT';
  631. SFrom = 'FROM';
  632. SWhere = 'WHERE';
  633. SInsertInto = 'INSERT INTO';
  634. SUpdate = 'UPDATE';
  635. SSet = 'SET';
  636. SDeleteFrom = 'DELETE FROM';
  637. SAnd = 'AND';
  638. SOLD = 'OLD';
  639. SValues = 'VALUES';
  640. SCreateTable = 'CREATE TABLE';
  641. SNotNull = 'NOT NULL';
  642. SDefault = 'DEFAULT';
  643. SCheck = 'CHECK'; // Check constraint
  644. SPrimaryKey = 'PRIMARY KEY';
  645. SConstraint = 'CONSTRAINT';
  646. SQLFieldTypes : Array[TFieldType] of string = (
  647. '', 'VARCHAR', 'SMALLINT', 'INT', 'SMALLINT',
  648. 'BOOL', 'FLOAT', 'DECIMAL','DECIMAL','DATE', 'TIME', 'TIMESTAMP',
  649. '', '', 'INT', 'BLOB', 'BLOB', 'BLOB', 'BLOB',
  650. '', '', '', '', 'CHAR',
  651. 'CHAR', 'BIGINT', '', '', '',
  652. '', '', '', '', '',
  653. '', '', 'TIMESTAMP', 'DECIMAL','CHAR','BLOB',
  654. '', '', '', '', '', '','FLOAT');
  655. { ---------------------------------------------------------------------
  656. Constants which can be localized
  657. ---------------------------------------------------------------------}
  658. Resourcestring
  659. SErrFieldNotFound = '"%s": Field "%s" not found.';
  660. SErrIndexNotFound = '"%s": Index "%s" not found.';
  661. SErrTableNotFound = 'Table "%s" not found.';
  662. SErrDuplicateTableName = 'Duplicate table name: "%s"';
  663. SErrDuplicateFieldName = '"%s": Duplicate field name: "%s"';
  664. SNewTable = 'NewTable';
  665. SNewField = 'NewField';
  666. SErrNoFileName = 'No filename given for save';
  667. SErrNotRegistering = 'Not registering data dictionary engine "%s": %s';
  668. SErrNoEngineCapabilities = 'It reports no capabilities.';
  669. SErrNoEngineDBType = 'It reports no database type';
  670. SErrNoEngineDescription = 'It reports no description';
  671. SErrUnknownEngine = 'Unknown datadictionary: "%s"';
  672. SErrMissingTableDef = 'Cannot perform this operation without tabledef.';
  673. SErrFieldTypeNotSupported = 'Field type "%s" is not supported in this SQL dialect';
  674. SErrNoConnectionDialog = 'No connection dialog registered for data dictionary engine "%s".';
  675. SDDImportingTable = 'Importing table definition for table "%s"';
  676. SErrCreateTableNotSupported = 'Creating tables is not supported by the "%s" engine.';
  677. SErrViewTableNotSupported = 'Viewing tables is not supported by the "%s" engine.';
  678. SErrRunQueryNotSupported = 'Running queries is not supported by the "%s" engine.';
  679. SErrOpenQueryNotSupported = 'Running and opening SELECT queries is not supported by the "%s" engine.';
  680. SErrSetQueryStatementNotSupported = 'Setting the SQL statement is not supported by the "%s" engine.';
  681. SErrGetTableIndexDefsNotSupported = 'Getting index definitions of a table is not supported by the "%s" engine.';
  682. SSavingFieldsFrom = 'Saving fields from %s';
  683. SLoadingFieldsFrom = 'Loading fields from %s';
  684. SWarnFieldNotFound = 'Could not find field "%s".';
  685. SLogFieldFoundIn = 'Field "%s" found in table "%s".';
  686. SErrSequenceNotFound = 'Sequence "%s" not found.';
  687. SErrDuplicateSequence = 'Duplicate sequence name: "%s"';
  688. SErrDuplicateDomain = 'Duplicate domain name: "%s"';
  689. SErrDomainNotFound = 'Domain "%s" not found.';
  690. SErrNoDataDict = '%s : No data dictionary available';
  691. SErrResolveDomain = 'Cannot resolve domain';
  692. Const
  693. SIndexOptionPrimary = 'Primary key';
  694. SIndexOptionUnique = 'Unique';
  695. SIndexOptionDescending = 'Descending';
  696. SIndexOptionCaseInsensitive = 'Case insensitive';
  697. SIndexOptionExpression = 'Expression';
  698. SIndexOptionNonMaintained = 'Not maintained';
  699. Const
  700. IndexOptionNames : Array [TIndexOption] of String
  701. = (SIndexOptionPrimary, SIndexOptionUnique,
  702. SIndexOptionDescending, SIndexOptionCaseInsensitive,
  703. SIndexOptionExpression, SIndexOptionNonMaintained);
  704. { ---------------------------------------------------------------------
  705. Dictionary Engine registration
  706. ---------------------------------------------------------------------}
  707. Var
  708. DDEngines : TStringList = nil;
  709. Type
  710. { TEngineRegistration }
  711. TEngineRegistration = Class(TObject)
  712. Private
  713. FEngine : TFPDDEngineClass;
  714. FCallBack : TGetConnectionEvent;
  715. Public
  716. Constructor Create(AEngine : TFPDDEngineClass);
  717. end;
  718. { TEngineRegistration }
  719. constructor TEngineRegistration.Create(AEngine: TFPDDEngineClass);
  720. begin
  721. FEngine:=AEngine;
  722. end;
  723. procedure RegisterDictionaryEngine(AEngine: TFPDDEngineClass);
  724. begin
  725. If (AEngine.EngineCapabilities=[]) then
  726. Raise EDataDict.CreateFmt(SErrNotRegistering,[AEngine.ClassName,SErrNoEngineCapabilities]);
  727. If (AEngine.DBType='') then
  728. Raise EDataDict.CreateFmt(SErrNotRegistering,[AEngine.ClassName,SErrNoEngineDBType]);
  729. If (AEngine.Description='') then
  730. Raise EDataDict.CreateFmt(SErrNotRegistering,[AEngine.ClassName,SErrNoEngineDescription]);
  731. If not assigned(DDEngines) then
  732. begin
  733. DDEngines:=TStringList.Create;
  734. DDEngines.Sorted:=true;
  735. DDEngines.Duplicates:=dupError;
  736. end;
  737. DDEngines.AddObject(Aengine.ClassName,TEngineRegistration.Create(AEngine));
  738. end;
  739. procedure UnRegisterDictionaryEngine(AEngine: TFPDDEngineClass);
  740. Var
  741. I : Integer;
  742. begin
  743. If Assigned(DDEngines) then
  744. begin
  745. I:=DDEngines.IndexOf(Aengine.ClassName);
  746. If (i<>-1) then
  747. begin
  748. DDEngines.Objects[i].Free;
  749. DDEngines.Delete(i);
  750. end;
  751. if (DDEngines.Count=0) then
  752. FreeAndNil(DDEngines);
  753. end;
  754. end;
  755. function GetDictionaryEngineList(List: TStrings): Integer;
  756. begin
  757. If Not Assigned(DDEngines) then
  758. Result:=0
  759. else
  760. begin
  761. If Assigned(List) then
  762. List.Text:=DDEngines.Text;
  763. Result:=DDEngines.Count;
  764. end;
  765. end;
  766. Function IndexOfDDEngine(Const AName: String) : Integer;
  767. begin
  768. If Assigned(DDEngines) then
  769. Result:=DDEngines.IndexOf(AName)
  770. else
  771. Result:=-1;
  772. end;
  773. Function FindEngineRegistration(Const AName : String) : TEngineRegistration;
  774. Var
  775. I : integer;
  776. begin
  777. I:=IndexOfDDEngine(AName);
  778. if (I<>-1) then
  779. Result:=TEngineRegistration(DDEngines.Objects[i])
  780. else
  781. Result:=Nil;
  782. end;
  783. Function GetEngineRegistration(Const AName : String) : TEngineRegistration;
  784. begin
  785. Result:=FindEngineRegistration(AName);
  786. If (Result=Nil) then
  787. Raise EDataDict.CreateFmt(SErrUnknownEngine,[AName]);
  788. end;
  789. Function FindDictionaryClass(Const AName : String) : TFPDDEngineClass;
  790. Var
  791. R : TEngineRegistration;
  792. begin
  793. R:=FindEngineRegistration(AName);
  794. If (R=Nil) then
  795. Result:=Nil
  796. else
  797. Result:=R.FEngine;
  798. end;
  799. Function GetDictionaryClass(Const AName : String) : TFPDDEngineClass;
  800. begin
  801. Result:=GetEngineRegistration(AName).FEngine;
  802. end;
  803. function IsDictionaryEngineRegistered(AEngine: TFPDDEngineClass): boolean;
  804. Var
  805. I : Integer;
  806. begin
  807. Result:=Assigned(DDEngines);
  808. If Result then
  809. begin
  810. Result:=False;
  811. I:=0;
  812. While (Not Result) and (I<DDEngines.Count) do
  813. begin
  814. Result:=(TEngineRegistration(DDEngines.Objects[i]).FEngine=AEngine);
  815. inc(I);
  816. end;
  817. end;
  818. end;
  819. procedure RegisterConnectionStringCallback(Const AName : String;
  820. CallBack: TGetConnectionEvent);
  821. begin
  822. GetEngineRegistration(AName).FCallBack:=CallBack;
  823. end;
  824. function GetEngineConnectionStringCallBack(Const AName : String) : TGetConnectionEvent;
  825. begin
  826. Result:=GetEngineRegistration(AName).FCallBack;
  827. end;
  828. Function GetDictionaryEngineInfo(Const AName : String; out ADescription,ADBType: String;out ACapabilities : TFPDDEngineCapabilities) : boolean;
  829. Var
  830. DDEC : TFPDDEngineClass;
  831. begin
  832. DDEC:=FindDictionaryClass(AName);
  833. Result:=DDEC<>Nil;
  834. If Result then
  835. begin
  836. ADescription:=DDEC.Description;
  837. ADBType:=DDEC.DBType;
  838. ACapabilities:=DDEC.EngineCapabilities;
  839. end;
  840. end;
  841. function CreateDictionaryEngine(const AName: String; AOWner : TComponent): TFPDDEngine;
  842. begin
  843. Result:=GetDictionaryClass(AName).Create(AOwner);
  844. end;
  845. function IndexOptionsToString(Options: TIndexOptions): String;
  846. Var
  847. IO : TIndexOption;
  848. begin
  849. Result:='';
  850. For IO:=Low(TIndexOption) to High(TIndexOption) do
  851. If IO in Options then
  852. begin
  853. If (Result<>'') then
  854. Result:=Result+',';
  855. Result:=Result+IndexOptionNames[IO];
  856. end;
  857. end;
  858. { ---------------------------------------------------------------------
  859. TDDFieldDef
  860. ---------------------------------------------------------------------}
  861. function TDDFieldDef.IsSizeStored: Boolean;
  862. begin
  863. Result:=FieldType in [ftUnknown, ftString, ftBCD,
  864. ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
  865. ftParadoxOle, ftDBaseOle, ftTypedBinary, ftFixedChar,
  866. ftWideString,ftArray, ftOraBlob, ftOraClob, ftFMTBcd];
  867. end;
  868. function TDDFieldDef.GetDomainName: string;
  869. begin
  870. If Assigned(FDomain) then
  871. Result:=FDomain.DomainName
  872. else // Not resolved yet
  873. Result:=FDomainName;
  874. end;
  875. function TDDFieldDef.IsPrecisionStored: Boolean;
  876. begin
  877. Result:=FieldType in [ftFloat,ftBCD,ftFMTBCD];
  878. end;
  879. procedure TDDFieldDef.SetDomain(const AValue: TDDDomainDef);
  880. begin
  881. if FDomain=AValue then exit;
  882. FDomain:=AValue;
  883. If Assigned(FDomain) then
  884. FDomainName:=FDomain.DomainName;
  885. end;
  886. procedure TDDFieldDef.SetDomainName(const AValue: string);
  887. begin
  888. FDomainName:=AValue;
  889. If (AValue<>'') then
  890. ResolveDomain(False);
  891. end;
  892. function TDDFieldDef.GetSectionName: String;
  893. begin
  894. Result:=FFieldName;
  895. end;
  896. procedure TDDFieldDef.SetSectionName(const Value: String);
  897. begin
  898. FFieldName:=Value;
  899. end;
  900. function TDDFieldDef.GetDisplayName: string;
  901. begin
  902. If (FieldName<>'') then
  903. Result:=FieldName
  904. else
  905. Result:=inherited GetDisplayName;
  906. end;
  907. constructor TDDFieldDef.Create(ACollection: TCollection);
  908. begin
  909. Inherited;
  910. FVisible:=True;
  911. FAlignMent:=taLeftJustify;
  912. end;
  913. function TDDFieldDef.FieldDefs: TDDFieldDefs;
  914. begin
  915. Result:=(Collection as TDDFieldDefs)
  916. end;
  917. function TDDFieldDef.DataDictionary: TFPDataDictionary;
  918. begin
  919. If Assigned(FieldDefs) then
  920. Result:=FieldDefs.DataDictionary
  921. else
  922. Result:=Nil;
  923. end;
  924. function TDDFieldDef.FieldIsRequired: Boolean;
  925. begin
  926. Result:=Required;
  927. If (Not Result) and (DomainName<>'') then
  928. begin
  929. ResolveDomain(True);
  930. Result:=Domain.Required;
  931. end;
  932. end;
  933. procedure TDDFieldDef.ResolveDomain(ErrorOnFail : Boolean);
  934. Var
  935. DD : TFPDataDictionary;
  936. begin
  937. If (FDomainName<>'') then
  938. Exit;
  939. DD:=DataDictionary;
  940. If Not Assigned(DD) then
  941. begin
  942. If ErrorOnFail then
  943. Raise EDataDict.CreateFmt(SErrNoDataDict,[SErrResolveDomain]);
  944. end
  945. else if (Not Assigned(FDomain)) or (CompareText(FDomain.DomainName,FDomainName)<>0) then
  946. begin
  947. If ErrorOnFail then
  948. FDomain:=DD.Domains.DomainByName(FDomainName)
  949. else
  950. FDomain:=DD.Domains.FindDomain(FDomainName);
  951. end;
  952. end;
  953. procedure TDDFieldDef.ImportFromField(F: TField; Existing : Boolean = True);
  954. begin
  955. FieldName:=F.FieldName;
  956. FieldType:=F.DataType;
  957. If IsSizeStored then
  958. Size:=F.Size;
  959. If IsPrecisionStored then
  960. begin
  961. If F is TBCDFIeld then
  962. Precision:=TBCDField(F).Precision
  963. else if F is TFloatField then
  964. Precision:=TFloatField(F).Precision;
  965. end;
  966. if not Existing then
  967. begin
  968. AlignMent:=F.AlignMent;
  969. DisplayWidth:=F.DisplayWidth;
  970. CustomConstraint:=F.CustomConstraint;
  971. ConstraintErrorMessage:=F.ConstraintErrorMessage;
  972. DefaultExpression:=F.DefaultExpression;
  973. DisplayLabel:=F.DisplayLabel;
  974. ReadOnly:=F.ReadOnly;
  975. Required:=F.Required;
  976. Visible:=F.Visible;
  977. ProviderFlags:=F.ProviderFlags;
  978. end;
  979. end;
  980. procedure TDDFieldDef.ApplyToField(F: TField);
  981. begin
  982. { // Normally, these should never be assigned...
  983. F.FieldName := FieldName;
  984. F.DataType := FieldType;
  985. If IsSizeStored then
  986. F.Size:=Size;
  987. }
  988. F.AlignMent := AlignMent;
  989. F.DisplayWidth := DisplayWidth;
  990. F.CustomConstraint := CustomConstraint;
  991. F.ConstraintErrorMessage := ConstraintErrorMessage;
  992. F.DefaultExpression := DefaultExpression;
  993. F.DisplayLabel := DisplayLabel;
  994. F.ReadOnly := ReadOnly;
  995. F.Required := Required;
  996. F.Visible := Visible;
  997. F.ProviderFlags := ProviderFlags;
  998. end;
  999. procedure TDDFieldDef.Assign(Source: TPersistent);
  1000. Var
  1001. DF : TDDFieldDef;
  1002. begin
  1003. if Source is TField then
  1004. ImportFromField(TField(Source))
  1005. else If Source is TDDFieldDef then
  1006. begin
  1007. DF:=TDDFieldDef(Source);
  1008. FieldType:=DF.FieldType;
  1009. If IsSizeStored then
  1010. Size:=DF.Size;
  1011. AlignMent:=DF.AlignMent;
  1012. DisplayWidth:=DF.DisplayWidth;
  1013. CustomConstraint:=DF.CustomConstraint;
  1014. ConstraintErrorMessage:=DF.ConstraintErrorMessage;
  1015. DefaultExpression:=DF.DefaultExpression;
  1016. DBDefault:=DF.DBDefault;
  1017. DisplayLabel:=DisplayLabel;
  1018. FieldName:=DF.FieldName;
  1019. DomainName:=DF.DomainName;
  1020. Constraint:=DF.Constraint;
  1021. Hint:=DF.Hint;
  1022. ReadOnly:=DF.ReadOnly;
  1023. Required:=DF.Required;
  1024. Visible:=DF.Visible;
  1025. ProviderFlags:=DF.ProviderFlags;
  1026. end
  1027. else
  1028. Inherited;
  1029. end;
  1030. procedure TDDFieldDef.SaveToIni(Ini: TCustomInifile; ASection: String);
  1031. Var
  1032. T : PTypeInfo;
  1033. O : Integer;
  1034. begin
  1035. With Ini do
  1036. begin
  1037. WriteInteger(ASection,KeyFieldType,Ord(Fieldtype));
  1038. If IsSizeStored then
  1039. WriteInteger(ASection,KeySize,Size);
  1040. If IsPrecisionStored then
  1041. WriteInteger(ASection,KeyPrecision,Precision);
  1042. WriteInteger(ASection,KeyAlignMent,Ord(AlignMent));
  1043. WriteInteger(ASection,KeyDisplayWidth,DisplayWidth);
  1044. WriteString(ASection,KeyCustomConstraint,CustomConstraint);
  1045. WriteString(ASection,KeyConstraintErrorMessage,ConstraintErrorMessage);
  1046. WriteString(ASection,KeyDefaultExpression,DefaultExpression);
  1047. WriteString(ASection,KeyDBDefault,DBDefault);
  1048. WriteString(ASection,KeyDisplayLabel,DisplayLabel);
  1049. WriteString(ASection,KeyFieldName,FieldName);
  1050. WriteString(ASection,KeyDomainName,DomainName);
  1051. WriteString(ASection,KeyConstraint,Constraint);
  1052. WriteString(ASection,KeyHint,Hint);
  1053. O:=Integer(ProviderFlags);
  1054. T:=TypeInfo(TProviderFlags);
  1055. WriteString(ASection,KeyProviderFlags,SetToString(T,O,False));
  1056. WriteBool(ASection,KeyReadOnly,ReadOnly);
  1057. WriteBool(ASection,KeyRequired,Required);
  1058. WriteBool(ASection,KeyVisible,Visible);
  1059. end;
  1060. end;
  1061. procedure TDDFieldDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
  1062. Var
  1063. T : PTypeInfo;
  1064. O : Integer;
  1065. PF : TProviderFlags;
  1066. S : String;
  1067. begin
  1068. With Ini do
  1069. begin
  1070. FieldType:=TFieldType(ReadInteger(ASection,KeyFieldType,Ord(Fieldtype)));
  1071. If IsSizeStored then
  1072. Size:=ReadInteger(ASection,KeySize,0);
  1073. If IsPrecisionStored then
  1074. Precision:=ReadInteger(ASection,KeyPrecision,0);
  1075. Alignment:=TAlignment(ReadInteger(ASection,KeyAlignMent,Ord(AlignMent)));
  1076. DisplayWidth:=ReadInteger(ASection,KeyDisplayWidth,DisplayWidth);
  1077. CustomConstraint:=ReadString(ASection,KeyCustomConstraint,CustomConstraint);
  1078. ConstraintErrorMessage:=ReadString(ASection,KeyConstraintErrorMessage,ConstraintErrorMessage);
  1079. DefaultExpression:=ReadString(ASection,KeyDefaultExpression,DefaultExpression);
  1080. DBDefault:=ReadString(ASection,KeyDBDefault,DBDefault);
  1081. DisplayLabel:=ReadString(ASection,KeyDisplayLabel,DisplayLabel);
  1082. FieldName:=ReadString(ASection,KeyFieldName,FieldName);
  1083. DomainName:=ReadString(ASection,KeyDomainName,DomainName);
  1084. Constraint:=ReadString(ASection,KeyConstraint,Constraint);
  1085. Hint:=ReadString(ASection,KeyHint,Hint);
  1086. S:=ReadString(ASection,KeyProviderFlags,'');
  1087. T:=TypeInfo(TProviderFlags);
  1088. O:=StringToSet(T,S);
  1089. Integer(PF):=O;
  1090. ProviderFlags:=PF;
  1091. ReadOnly:=ReadBool(ASection,KeyReadOnly,ReadOnly);
  1092. Required:=ReadBool(ASection,KeyRequired,Required);
  1093. Visible:=ReadBool(ASection,KeyVisible,Visible);
  1094. end;
  1095. end;
  1096. { ---------------------------------------------------------------------
  1097. TDDFieldDefs
  1098. ---------------------------------------------------------------------}
  1099. procedure TDDFieldDefs.SetTableName(const AValue: String);
  1100. begin
  1101. Inherited;
  1102. FSectionPrefix:=AValue;
  1103. GlobalSection:=AValue+SFieldSuffix;
  1104. end;
  1105. constructor TDDFieldDefs.Create(ATableDef: TDDTableDef);
  1106. begin
  1107. Inherited Create(FieldDefClass);
  1108. FPrefix:='Field';
  1109. SetTableDef(ATableDef);
  1110. end;
  1111. constructor TDDFieldDefs.Create(const ATableName: String);
  1112. begin
  1113. Inherited Create(FieldDefClass);
  1114. FPrefix:='Field';
  1115. TableName:=ATableName;
  1116. end;
  1117. class function TDDFieldDefs.FieldDefClass: TDDFieldDefClass;
  1118. begin
  1119. Result:=TDDFieldDef
  1120. end;
  1121. function TDDFieldDefs.GetField(Index : Integer): TDDFieldDef;
  1122. begin
  1123. Result:=TDDFieldDef(Items[Index]);
  1124. end;
  1125. procedure TDDFieldDefs.SetField(Index : Integer; const AValue: TDDFieldDef);
  1126. begin
  1127. Items[Index]:=AValue;
  1128. end;
  1129. function TDDFieldDefs.AddField(AFieldName: String): TDDFieldDef;
  1130. Var
  1131. I : Integer;
  1132. begin
  1133. If (AFieldName<>'') and (IndexOfField(AFieldName)<>-1) then
  1134. Raise EDataDict.CreateFmt(SErrDuplicateFieldName,[TableName,AFieldName]);
  1135. If (AFieldName='') then
  1136. begin
  1137. I:=0;
  1138. Repeat
  1139. Inc(I);
  1140. AFieldName:=SNewField+IntToStr(i);
  1141. Until (IndexOfField(AFieldName)=-1);
  1142. end;
  1143. Result:=Add as TDDFieldDef;
  1144. Result.FieldName:=AFieldName;
  1145. end;
  1146. function TDDFieldDefs.IndexOfField(const AFieldName: String): Integer;
  1147. begin
  1148. Result:=Count-1;
  1149. While (Result>=0) and (CompareText(GetField(Result).FieldName,AFieldName)<>0) do
  1150. Dec(Result)
  1151. end;
  1152. function TDDFieldDefs.FindField(const AFieldName: String): TDDFieldDef;
  1153. Var
  1154. I : integer;
  1155. begin
  1156. I:=IndexOfField(AFieldName);
  1157. If (I=-1) then
  1158. Result:=Nil
  1159. else
  1160. Result:=GetField(I);
  1161. end;
  1162. function TDDFieldDefs.FieldByName(const AFieldName: String): TDDFieldDef;
  1163. begin
  1164. Result:=FindField(AFieldName);
  1165. If Result=Nil then
  1166. Raise EDatadict.CreateFmt(SErrFieldNotFound,[TableName,AFieldName]);
  1167. end;
  1168. procedure TDDFieldDefs.FillFieldList(const AFieldNames: String;
  1169. List: TFPDDFieldList);
  1170. Var
  1171. I : Integer;
  1172. S,T : String;
  1173. F : TDDFieldDef;
  1174. begin
  1175. T:=Trim(AFieldNames);
  1176. Repeat
  1177. I:=Pos(';',T);
  1178. If I=0 Then
  1179. I:=Length(T)+1;
  1180. S:=Trim(Copy(T,1,I-1));
  1181. System.Delete(T,1,I);
  1182. List.Add(FieldByName(S));
  1183. Until (T='');
  1184. end;
  1185. { ---------------------------------------------------------------------
  1186. TDDTableDef
  1187. ---------------------------------------------------------------------}
  1188. procedure TDDTableDef.SetTableName(const AValue: String);
  1189. begin
  1190. FTableName:=AValue;
  1191. FFieldDefs.TableName:=AValue;
  1192. FIndexDefs.TableName:=AValue;
  1193. FKeyDefs.TableName:=AValue;
  1194. end;
  1195. function TDDTableDef.GetPrimaryKeyName: String;
  1196. var i : TDDIndexDef;
  1197. begin
  1198. if FPrimaryKeyName <> '' then
  1199. Result := FPrimaryKeyName
  1200. else
  1201. begin
  1202. I := GetPrimaryIndexDef;
  1203. if assigned (I) then
  1204. Result := I.IndexName
  1205. else
  1206. Result:=Tablename+'_PK';
  1207. end;
  1208. end;
  1209. function TDDTableDef.GetPrimaryIndexDef: TDDIndexDef;
  1210. var r : integer;
  1211. begin
  1212. r := Indexes.count;
  1213. repeat
  1214. dec (r);
  1215. until (r < 0) or (ixPrimary in Indexes[r].Options);
  1216. if r < 0 then
  1217. result := nil
  1218. else
  1219. result := Indexes[r];
  1220. end;
  1221. function TDDTableDef.GetOnProgress: TDDProgressEvent;
  1222. begin
  1223. Result:=Nil;
  1224. If (Collection Is TDDTableDefs) then
  1225. Result:=(Collection As TDDTableDefs).OnProgress;
  1226. end;
  1227. function TDDTableDef.GetSectionName: String;
  1228. begin
  1229. Result:=FTableName;
  1230. end;
  1231. procedure TDDTableDef.SetSectionName(const Value: String);
  1232. begin
  1233. TableName:=Value;
  1234. end;
  1235. constructor TDDTableDef.Create(ACollection: TCollection);
  1236. begin
  1237. inherited Create(ACollection);
  1238. FFieldDefs:=TDDFieldDefs.Create(Self);
  1239. FIndexDefs:=TDDIndexDefs.Create(Self);
  1240. FKeyDefs:=TDDForeignkeyDefs.Create('NewTable');
  1241. end;
  1242. destructor TDDTableDef.Destroy;
  1243. begin
  1244. FreeAndNil(FKeyDefs);
  1245. FreeAndNil(FFieldDefs);
  1246. FreeAndNil(FIndexDefs);
  1247. inherited Destroy;
  1248. end;
  1249. function TDDTableDef.DataDictionary: TFPDataDictionary;
  1250. begin
  1251. If Assigned(TableDefs) then
  1252. Result:=TableDefs.DataDictionary
  1253. else
  1254. Result:=Nil;
  1255. end;
  1256. function TDDTableDef.TableDefs: TDDTableDefs;
  1257. begin
  1258. Result:=TDDTableDefs(Collection);
  1259. end;
  1260. Function TDDTableDef.ImportFromDataset(Dataset: TDataSet; DoClear : Boolean = False; UpdateExisting : Boolean = True) : Integer;
  1261. Var
  1262. I : Integer;
  1263. FD : TDDFieldDef;
  1264. F : TField;
  1265. FieldExists : Boolean;
  1266. begin
  1267. if DoClear then
  1268. FFieldDefs.Clear;
  1269. Result:=0;
  1270. For I:=0 to Dataset.Fields.Count-1 do
  1271. begin
  1272. F:=Dataset.Fields[i];
  1273. FD:=FFieldDefs.FindField(F.FieldName);
  1274. If (FD=Nil) then
  1275. begin
  1276. FD:=FFieldDefs.AddField(F.FieldName);
  1277. FieldExists := False;
  1278. end
  1279. else
  1280. begin
  1281. if not UpdateExisting then FD:=Nil;
  1282. FieldExists := True;
  1283. end;
  1284. if (FD<>Nil) then
  1285. begin
  1286. Inc(Result);
  1287. FD.ImportFromField(F,FieldExists);
  1288. end;
  1289. end;
  1290. end;
  1291. procedure TDDTableDef.ApplyToDataset(Dataset: TDataset);
  1292. var
  1293. I : integer;
  1294. FD : TDDFieldDef;
  1295. F : TField;
  1296. begin
  1297. For I:=0 to Dataset.FieldCount-1 do
  1298. begin
  1299. F:=Dataset.Fields[i];
  1300. FD:=FFieldDefs.FieldByName(F.FieldName);
  1301. If (FD<>Nil) then
  1302. FD.ApplyToField(F);
  1303. end;
  1304. end;
  1305. function TDDTableDef.AddField(const AFieldName: String): TDDFieldDef;
  1306. begin
  1307. Result:=Fields.AddField(AFieldName);
  1308. end;
  1309. procedure TDDTableDef.SaveToIni(Ini: TCustomInifile; ASection: String);
  1310. begin
  1311. With Ini do
  1312. begin
  1313. WriteString(ASection,KeyTableName,TableName);
  1314. WriteString(ASection,KeyPrimaryKeyConstraint,FPRimaryKeyName);
  1315. end;
  1316. If Assigned(OnProgress) then
  1317. OnProgress(Self,Format(SSavingFieldsFrom,[TableName]));
  1318. FFieldDefs.SaveToIni(Ini,ASection+SFieldSuffix);
  1319. FIndexDefs.SaveToIni(Ini,ASection+SIndexSuffix);
  1320. FKeyDefs.SaveToIni(Ini,ASection+SKeySuffix);
  1321. end;
  1322. procedure TDDTableDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
  1323. begin
  1324. With Ini do
  1325. begin
  1326. TableName:=ReadString(ASection,KeyTableName,TableName);
  1327. FPrimaryKeyName:=ReadString(ASection,KeyPrimaryKeyConstraint,'');
  1328. end;
  1329. If Assigned(OnProgress) then
  1330. OnProgress(Self,Format(SLoadingFieldsFrom,[TableName]));
  1331. FFieldDefs.LoadFromIni(Ini,ASection+SFieldSuffix);
  1332. FIndexDefs.LoadFromIni(Ini,ASection+SIndexSuffix);
  1333. FKeyDefs.LoadFromIni(Ini,ASection+SKeySuffix);
  1334. end;
  1335. procedure TDDTableDef.PrimaryIndexToFields;
  1336. var I : TDDIndexDef;
  1337. r : integer;
  1338. l : TFPDDFieldList;
  1339. begin
  1340. I := GetPrimaryIndexDef;
  1341. if assigned (I) then
  1342. begin
  1343. for r := 0 to Fields.count-1 do
  1344. Fields[r].ProviderFlags := Fields[r].ProviderFlags - [pfInKey];
  1345. l := TFPDDFieldList.create;
  1346. try
  1347. Fields.FillFieldList (I.Fields, l);
  1348. for r := 0 to l.count-1 do
  1349. l[r].ProviderFlags := l[r].ProviderFlags + [pfInKey];
  1350. finally
  1351. l.Free;
  1352. end;
  1353. end;
  1354. end;
  1355. procedure TDDTableDef.FieldsToPrimaryIndex;
  1356. var I : TDDIndexDef;
  1357. r : integer;
  1358. s : string;
  1359. begin
  1360. I := GetPrimaryIndexDef;
  1361. s := '';
  1362. for r := 0 to fields.count-1 do
  1363. if pfInKey in fields[r].ProviderFlags then
  1364. s := s + ';' + fields[r].FieldName;
  1365. if s = '' then
  1366. begin
  1367. if assigned (I) then
  1368. I.Free;
  1369. end
  1370. else
  1371. begin
  1372. s := copy(s, 2, maxint);
  1373. if assigned (I) then
  1374. I.Fields := s
  1375. else
  1376. begin
  1377. I := Indexes.AddIndex(GetPrimaryKeyName);
  1378. I.Fields := s;
  1379. I.Options := I.Options + [ixPrimary];
  1380. end;
  1381. end;
  1382. end;
  1383. { ---------------------------------------------------------------------
  1384. TDDTableDefs
  1385. ---------------------------------------------------------------------}
  1386. function TDDTableDefs.GetTable(Index : Integer): TDDTableDef;
  1387. begin
  1388. Result:=TDDTableDef(Items[Index]);
  1389. end;
  1390. procedure TDDTableDefs.SetTable(Index : Integer; const AValue: TDDTableDef);
  1391. begin
  1392. Items[Index]:=AValue;
  1393. end;
  1394. function TDDTableDefs.AddTable(ATableName: String): TDDTableDef;
  1395. Var
  1396. I : Integer;
  1397. begin
  1398. If (ATableName<>'') and (IndexOfTable(ATableName)<>-1) then
  1399. Raise EDataDict.CreateFmt(SErrDuplicateTableName,[ATableName]);
  1400. If (ATableName='') then
  1401. begin
  1402. I:=0;
  1403. Repeat
  1404. Inc(I);
  1405. ATAbleName:=SNewTable+IntToStr(i);
  1406. Until (IndexOfTable(ATableName)=-1);
  1407. end;
  1408. Result:=Add as TDDTableDef;
  1409. Result.TableName:=ATableName;
  1410. end;
  1411. function TDDTableDefs.IndexOfTable(const ATableName: String): Integer;
  1412. begin
  1413. Result:=Count-1;
  1414. While (Result>=0) and (CompareText(GetTable(Result).TableName,ATableName)<>0) do
  1415. Dec(Result)
  1416. end;
  1417. function TDDTableDefs.FindTable(const ATableName: String): TDDTableDef;
  1418. Var
  1419. I : integer;
  1420. begin
  1421. I:=IndexOfTable(ATableName);
  1422. If (I=-1) then
  1423. Result:=Nil
  1424. else
  1425. Result:=GetTable(I);
  1426. end;
  1427. function TDDTableDefs.TableByName(const ATableName: String): TDDTableDef;
  1428. begin
  1429. Result:=FindTable(ATableName);
  1430. If Result=Nil then
  1431. Raise EDatadict.CreateFmt(SErrTableNotFound,[ATableName]);
  1432. end;
  1433. { ---------------------------------------------------------------------
  1434. TDatadictionary
  1435. ---------------------------------------------------------------------}
  1436. procedure TFPDataDictionary.SetOnProgress(const AValue: TDDProgressEvent);
  1437. begin
  1438. FOnProgress:=AValue;
  1439. FTables.OnProgress:=FOnProgress;
  1440. end;
  1441. constructor TFPDataDictionary.Create;
  1442. begin
  1443. FTables:=TDDTableDefs.Create(TDDTableDef);
  1444. FTables.FDataDictionary:=Self;
  1445. FSequences:=TDDSequenceDefs.Create;
  1446. FSequences.FDataDictionary:=Self;
  1447. FDomains:=TDDDomainDefs.Create;
  1448. FDomains.FDataDictionary:=Self;
  1449. end;
  1450. destructor TFPDataDictionary.Destroy;
  1451. begin
  1452. FreeAndNil(FDomains);
  1453. FreeAndNil(FSequences);
  1454. FreeAndNil(FTables);
  1455. inherited Destroy;
  1456. end;
  1457. procedure TFPDataDictionary.SaveToFile(const AFileName: String; KeepBackup: Boolean = True);
  1458. Var
  1459. Ini : TMemIniFile;
  1460. FN : String;
  1461. begin
  1462. FN:=aFileName;
  1463. If (FN='') then
  1464. FN:=FFileName;
  1465. if (FN='') and (Name<>'') then
  1466. FN:=Name+DefaultDDExt;
  1467. if (FN='') then
  1468. Raise EDataDict.Create(SErrNoFileName);
  1469. If FileExists(FN) then
  1470. If KeepBackup then
  1471. RenameFile(FN,FN+'.bak')
  1472. else
  1473. DeleteFile(FN);
  1474. Ini:=TMemIniFile.Create(FN);
  1475. try
  1476. SaveToIni(Ini,SDataDict);
  1477. Ini.UpdateFile;
  1478. FFileName:=FN;
  1479. finally
  1480. FreeAndNil(Ini);
  1481. end;
  1482. end;
  1483. procedure TFPDataDictionary.SaveToIni(Ini: TCustomIniFile; ASection: String);
  1484. begin
  1485. Ini.WriteString(ASection,KeyDataDictName,Name);
  1486. FDomains.SaveToIni(Ini,SDatadictDomains);
  1487. FSequences.SaveToIni(Ini,SDatadictSequences);
  1488. FTables.SaveToIni(Ini,SDatadictTables);
  1489. end;
  1490. procedure TFPDataDictionary.LoadFromFile(const AFileName: String);
  1491. Var
  1492. Ini : TMemInifile;
  1493. begin
  1494. if (AFileName='') then
  1495. Raise EDataDict.Create(SErrNoFileName);
  1496. Ini:=TMemIniFile.Create(AFileName);
  1497. try
  1498. LoadFromIni(Ini,SDataDict);
  1499. FFileName:=AFileName;
  1500. If (Name='') then
  1501. Name:=ChangeFileExt(ExtractFileName(AFileName),'');
  1502. finally
  1503. FreeAndNil(Ini);
  1504. end;
  1505. end;
  1506. procedure TFPDataDictionary.LoadFromIni(Ini: TCustomIniFile; ASection: String);
  1507. begin
  1508. FDDName:=Ini.ReadString(ASection,KeyDataDictName,'');
  1509. FDomains.Clear;
  1510. FDomains.LoadFromIni(Ini,SDataDictDomains);
  1511. FSequences.Clear;
  1512. FSequences.LoadFromIni(Ini,SDataDictSequences);
  1513. FTables.Clear;
  1514. FTables.LoadFromIni(Ini,SDataDictTables);
  1515. end;
  1516. procedure TFPDataDictionary.ApplyToDataset(ADataset: TDataset);
  1517. begin
  1518. ApplytoDataset(ADataset,FOnApplyDatadictEvent);
  1519. end;
  1520. procedure TFPDataDictionary.ApplyToDataset(ADataset: TDataset;
  1521. OnApply: TOnApplyDataDictEvent);
  1522. Var
  1523. I : Integer;
  1524. F : TField;
  1525. FD : TDDFieldDef;
  1526. FN,TN : String;
  1527. Allow : Boolean;
  1528. begin
  1529. For I:=0 to ADataset.Fields.Count-1 do
  1530. begin
  1531. F:=ADataset.Fields[i];
  1532. FN:=F.Origin;
  1533. If (FN='') then
  1534. FN:=F.FieldName;
  1535. FD:=FindFieldDef(FN,TN);
  1536. Allow:=(FD<>Nil);
  1537. If Assigned(OnApply) then
  1538. OnApply(Self,FD,F,Allow);
  1539. If (FD<>Nil) and Allow then
  1540. FD.ApplyToField(F);
  1541. end;
  1542. end;
  1543. function TFPDataDictionary.CanonicalizeFieldName(const InFN: String; Out TableDef : TDDTableDef; Out FN: String): Boolean;
  1544. Var
  1545. TN : String;
  1546. P : integer;
  1547. begin
  1548. Result:=False;
  1549. FN:=InFN;
  1550. TableDef:=Nil;
  1551. // Improve to check for quotes
  1552. P:=Pos('.',FN);
  1553. If (P<>0) then
  1554. begin
  1555. TN:=Copy(FN,1,P-1);
  1556. Delete(FN,1,P);
  1557. TableDef:=Tables.FindTable(TN);
  1558. end;
  1559. Result:=TableDef<>Nil;
  1560. end;
  1561. Function TFPDataDictionary.CanonicalizeFieldName(Const InFN : String; Out TN,FN : String) : Boolean;
  1562. Var
  1563. TD : TDDTableDef;
  1564. begin
  1565. Result:=CanonicalizeFieldName(InFN,TD,FN);
  1566. If Result then
  1567. TN:=TD.TableName
  1568. else
  1569. TN:='';
  1570. end;
  1571. // To be good, we should make a hashlist with all tables.fields and search that...
  1572. // For now, we cache the last matching table. This should work well for most common cases.
  1573. function TFPDataDictionary.FindFieldDef(const FieldName: String; out TableName: String
  1574. ): TDDFieldDef;
  1575. Var
  1576. TD : TDDTableDef;
  1577. FN,TN : String;
  1578. I : Integer;
  1579. begin
  1580. Result:=Nil;
  1581. If CanonicalizeFieldName(FieldName,TD,FN) then
  1582. begin
  1583. Result:=TD.Fields.FieldByName(FN);
  1584. If (Result<>Nil) then
  1585. FLastMatchTableDef:=TD;
  1586. end
  1587. else
  1588. begin
  1589. If (FLastMatchTableDef<>Nil) then
  1590. TD:=FLastMatchTableDef;
  1591. If (TD<>Nil) then
  1592. Result:=TD.Fields.FindField(FN);
  1593. If Result=Nil then
  1594. begin
  1595. // Hard scan of all tables...
  1596. I:=0;
  1597. While (Result=Nil) and (I<Tables.Count) do
  1598. begin
  1599. TD:=Tables[i];
  1600. Result:=TD.Fields.FindField(FN);
  1601. If (Result<>Nil) then
  1602. FLastMatchTableDef:=TD;
  1603. Inc(I);
  1604. end;
  1605. end;
  1606. end;
  1607. If (Result<>Nil) then
  1608. TableName:=FLastMatchTableDef.TableName;
  1609. end;
  1610. function TFPDataDictionary.FindFieldDef(const FieldName: String): TDDFieldDef;
  1611. Var
  1612. Dummy : String;
  1613. begin
  1614. Result:=FindFieldDef(FieldName,Dummy);
  1615. end;
  1616. { ---------------------------------------------------------------------
  1617. TFPDDEngine
  1618. ---------------------------------------------------------------------}
  1619. procedure TFPDDEngine.DoProgress(const Msg: String);
  1620. begin
  1621. If Assigned(FOnProgress) then
  1622. FOnProgress(Self,Msg);
  1623. end;
  1624. procedure TFPDDEngine.IndexDefsToDDIndexDefs(IDS: TIndexDefs; DDIDS: TDDindexDefs
  1625. );
  1626. Var
  1627. D : TIndexDef;
  1628. DD : TDDindexDef;
  1629. I : Integer;
  1630. begin
  1631. DDIDS.Clear;
  1632. For I:=0 to IDS.Count-1 do
  1633. begin
  1634. D:=IDS[I];
  1635. DD:=DDIDS.AddDDIndexDef(D.Name);
  1636. DD.Assign(D);
  1637. end;
  1638. end;
  1639. destructor TFPDDEngine.Destroy;
  1640. begin
  1641. Disconnect;
  1642. inherited Destroy;
  1643. end;
  1644. function TFPDDEngine.GetConnectString: String;
  1645. Var
  1646. CB : TGetConnectionEvent;
  1647. begin
  1648. CB:=GetEngineConnectionStringCallBack(Self.ClassName);
  1649. if (CB=Nil) then
  1650. Raise EDataDict.CreateFmt(SerrNoConnectionDialog,[Self.ClassName]);
  1651. Result:='';
  1652. CB(Self,Result);
  1653. end;
  1654. function TFPDDEngine.ImportTables(Tables: TDDTableDefs; List: TStrings; UpdateExisting : Boolean): Integer;
  1655. Var
  1656. I,J : Integer;
  1657. TD : TDDTableDef;
  1658. begin
  1659. Result:=0;
  1660. For I:=0 to List.Count-1 do
  1661. begin
  1662. TD:=Nil;
  1663. j:=Tables.IndexOfTable(List[i]);
  1664. If (J=-1) then
  1665. TD:=Tables.AddTable(List[i])
  1666. else if UpdateExisting then
  1667. TD:=Tables[J];
  1668. If (TD<>nil) then
  1669. begin
  1670. DoProgress(Format(SDDImportingTable,[TD.TableName]));
  1671. ImportFields(TD);
  1672. if ecTableIndexes in EngineCapabilities then
  1673. ImportIndexes(TD);
  1674. Inc(Result);
  1675. end
  1676. end;
  1677. end;
  1678. function TFPDDEngine.GetDomainList(List: TSTrings): integer;
  1679. begin
  1680. List.Clear;
  1681. result := 0;
  1682. end;
  1683. function TFPDDEngine.CreateSQLEngine: TFPDDSQLEngine;
  1684. begin
  1685. Result:=TFPDDSQLEngine.Create;
  1686. end;
  1687. class function TFPDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
  1688. begin
  1689. Result:=[];
  1690. end;
  1691. procedure TFPDDEngine.ImportDatadict(Adatadict: TFPDatadictionary;
  1692. UpdateExisting: Boolean);
  1693. var L : TStringList;
  1694. r : integer;
  1695. begin
  1696. l := TStringlist.Create;
  1697. try
  1698. if ecDomains in EngineCapabilities then
  1699. begin
  1700. GetDomainList (L);
  1701. if UpdateExisting then // Delete domains that don't exist anymore
  1702. begin
  1703. for r := ADatadict.Domains.count-1 downto 0 do
  1704. if L.indexOf(ADatadict.Domains[r].DomainName) < 0 then
  1705. ADatadict.Domains[r].Free;
  1706. end;
  1707. ImportDomains (ADatadict.Domains, L, UpdateExisting);
  1708. end;
  1709. L.Clear;
  1710. GetTableList (L);
  1711. if UpdateExisting then // delete tables that don't exist anymore
  1712. begin
  1713. for r := ADatadict.Tables.count-1 downto 0 do
  1714. if L.indexOf(ADatadict.Tables[r].TableName) < 0 then
  1715. ADatadict.Tables[r].Free;
  1716. end;
  1717. ImportTables (ADatadict.Tables, L, UpdateExisting);
  1718. if ecSequences in EngineCapabilities then
  1719. begin
  1720. L.Clear;
  1721. GetSequenceList (L);
  1722. if UpdateExisting then // Delete sequences that don't exist anymore
  1723. begin
  1724. for r := ADatadict.Sequences.count-1 downto 0 do
  1725. if L.indexOf(ADatadict.Sequences[r].SequenceName) < 0 then
  1726. ADatadict.Sequences[r].Free;
  1727. end;
  1728. ImportSequences (ADatadict.Sequences, L, UpdateExisting);
  1729. end;
  1730. finally
  1731. L.Free;
  1732. end;
  1733. end;
  1734. function TFPDDEngine.ImportDomains(Domains: TDDDomainDefs; List : TStrings; UpdateExisting : boolean) : Integer;
  1735. begin
  1736. result := 0;
  1737. end;
  1738. function TFPDDEngine.GetSequenceList(List: TStrings): integer;
  1739. begin
  1740. List.Clear;
  1741. result := 0;
  1742. end;
  1743. function TFPDDEngine.ImportSequences(Sequences: TDDSequenceDefs; List : TStrings; UpdateExisting : boolean) : Integer;
  1744. begin
  1745. result := 0;
  1746. end;
  1747. procedure TFPDDEngine.CreateTable(Table: TDDTableDef);
  1748. begin
  1749. Raise EDataDict.CreateFmt(SErrCreateTableNotSupported,[DBType]);
  1750. end;
  1751. function TFPDDEngine.ViewTable(Const TableName: String; DatasetOwner: TComponent
  1752. ): TDataset;
  1753. begin
  1754. Raise EDataDict.CreateFmt(SErrViewTableNotSupported,[DBType]);
  1755. end;
  1756. function TFPDDEngine.RunQuery(SQL: String): Integer;
  1757. begin
  1758. Raise EDataDict.CreateFmt(SErrRunQueryNotSupported,[DBType]);
  1759. end;
  1760. function TFPDDEngine.CreateQuery(SQL: String; DatasetOwner : TComponent): TDataset;
  1761. begin
  1762. Raise EDataDict.CreateFmt(SErrOpenQueryNotSupported,[DBType]);
  1763. end;
  1764. procedure TFPDDEngine.SetQueryStatement(SQL: String; AQuery: TDataset);
  1765. begin
  1766. Raise EDataDict.CreateFmt(SErrSetQueryStatementNotSupported,[DBType]);
  1767. end;
  1768. function TFPDDEngine.GetTableIndexDefs(ATableName: String; Defs: TDDIndexDefs
  1769. ): integer;
  1770. begin
  1771. Raise EDataDict.CreateFmt(SErrGetTableIndexDefsNotSupported,[DBType]);
  1772. end;
  1773. { ---------------------------------------------------------------------
  1774. TFPDDSQLEngine
  1775. ---------------------------------------------------------------------}
  1776. { Utility functions }
  1777. constructor TFPDDSQLEngine.Create;
  1778. begin
  1779. FTerminatorChar:=DefaultSQLTerminatorChar;
  1780. FFieldQuoteChar:=DefaultSQLFieldQuoteChar;
  1781. FOptions:=DefaultSQLEngineOptions;
  1782. FMaxLineLength:=DefaultSQLEngineLineLength;
  1783. FIndent:=DefaultSQLEngineIndent;
  1784. end;
  1785. procedure TFPDDSQLEngine.CheckTableDef;
  1786. begin
  1787. If (FTableDef=Nil) then
  1788. Raise EDataDict.Create(SErrMissingTableDef);
  1789. end;
  1790. procedure TFPDDSQLEngine.NoIndent;
  1791. begin
  1792. FNoIndent:=True;
  1793. end;
  1794. procedure TFPDDSQLEngine.ResetLine;
  1795. begin
  1796. FLastLength:=0;
  1797. NoIndent;
  1798. end;
  1799. procedure TFPDDSQLEngine.FixUpStatement(var Res: String; ForceTerminator : Boolean = False);
  1800. Var
  1801. L : Integer;
  1802. begin
  1803. Res:=Trim(Res);
  1804. if (eoAddTerminator in Options) or ForceTerminator then
  1805. begin
  1806. L:=Length(Res);
  1807. If (L=0) or (Res[L]<>FTerminatorChar) then
  1808. Res:=Res+FTerminatorChar;
  1809. end;
  1810. end;
  1811. procedure TFPDDSQLEngine.FixUpStatement(SQL: TStrings; ForceTerminator: Boolean = False);
  1812. Var
  1813. S : String;
  1814. begin
  1815. If (SQL.Count>0) then
  1816. begin
  1817. S:=SQL[SQL.Count-1];
  1818. FixupStatement(S,ForceTerminator);
  1819. SQL[SQL.Count-1]:=S;
  1820. end;
  1821. end;
  1822. Procedure TFPDDSQLEngine.AddToStringLN(Var Res : String;const S : String);
  1823. begin
  1824. AddToString(Res,S);
  1825. Res:=Res+LineEnding;
  1826. FLastLength:=0;
  1827. end;
  1828. procedure TFPDDSQLEngine.AddToString(Var Res: String; S: String);
  1829. begin
  1830. If (FMaxLineLength>0) and (FLastLength+Length(S)+1>FMaxLineLength) then
  1831. begin
  1832. FLastLength:=0;
  1833. Res:=Res+LineEnding;
  1834. end
  1835. else If (FLastLength<>0) and (S<>'') then
  1836. S:=' '+S;
  1837. If (FLastlength=0) then
  1838. begin
  1839. If not FNoIndent then
  1840. begin
  1841. Res:=Res+StringOfChar(' ',Indent);
  1842. FLastlength:=FlastLength+Indent;
  1843. end;
  1844. end;
  1845. FLastLength:=FLastLength+Length(S);
  1846. FNoIndent:=False;
  1847. Res:=Res+S;
  1848. end;
  1849. procedure TFPDDSQLEngine.AddFieldString(var Res: String; const S: String);
  1850. begin
  1851. If eoLineFeedAfterField in FOptions then
  1852. AddToStringLn(Res,S)
  1853. else
  1854. AddToString(Res,S)
  1855. end;
  1856. function TFPDDSQLEngine.CreateAndTerm(FD: TDDFieldDef; UseOldParam: Boolean
  1857. ): string;
  1858. begin
  1859. Result:=FieldNameString(FD)+' = '+FieldParamString(FD,UseOldParam);
  1860. if (eoAndTermsInBrackets in FOptions) then
  1861. Result:='('+Result+')';
  1862. end;
  1863. function TFPDDSQLEngine.CreateWhereSQL(var Res : String;FieldList: TFPDDFieldList; UseOldParam:Boolean): String;
  1864. Var
  1865. i : Integer;
  1866. FD : TDDFieldDef;
  1867. S : String;
  1868. begin
  1869. Result:='';
  1870. If Assigned(FieldList) and (FieldList.Count>0) then
  1871. begin
  1872. For i:=0 to FieldList.Count-1 do
  1873. begin
  1874. FD:=FieldList[i];
  1875. S:=CreateAndTerm(FD,UseOldParam);
  1876. If (I>0) then
  1877. S:=SAnd+' '+S;
  1878. If eoLineFeedAfterAndTerm in Options then
  1879. AddToStringLN(Res,S)
  1880. else
  1881. AddToString(Res,S);
  1882. end;
  1883. end;
  1884. end;
  1885. procedure TFPDDSQLEngine.AddWhereClause(var Res: String;
  1886. FieldList: TFPDDFieldList; UseOldParam: Boolean);
  1887. begin
  1888. If Assigned(FieldList) and (FieldList.Count>0) then
  1889. begin
  1890. NoIndent;
  1891. AddToStringLn(Res,SWhere);
  1892. CreateWhereSQL(Res,FieldList,UseOldParam);
  1893. end;
  1894. end;
  1895. { Functions with engine-specific strings in it. Can be overridden }
  1896. function TFPDDSQLEngine.FieldNameString(FD: TDDFieldDef): string;
  1897. begin
  1898. Result:=FD.FieldName;
  1899. if (eoQuoteFieldNames in FOptions) then
  1900. Result:=FFieldQuoteChar+Result+FFieldQuoteChar;
  1901. end;
  1902. function TFPDDSQLEngine.TableNameString(TD: TDDTableDef): string;
  1903. begin
  1904. Result:=TD.TableName;
  1905. end;
  1906. function TFPDDSQLEngine.FieldParamString(FD: TDDFieldDef; UseOldParam: Boolean
  1907. ): string;
  1908. begin
  1909. Result:=FD.FieldName;
  1910. If UseOldParam then
  1911. Result:=SOLD+Result;
  1912. Result:=':'+Result;
  1913. end;
  1914. function TFPDDSQLEngine.FieldTypeString(FD : TDDFieldDef) : String;
  1915. begin
  1916. if FD.DomainName <> '' then
  1917. Result := FD.DomainName
  1918. else
  1919. Result:=FieldTypeString(FD.FieldType,FD.Size,FD.Precision);
  1920. end;
  1921. Function TFPDDSQLEngine.FieldTypeString(FT : TFieldType; ASize,APrecision : Integer) : String;
  1922. {
  1923. ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  1924. ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  1925. ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
  1926. ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
  1927. ftWideString, ftLargeint, ftADT, ftArray, ftReference,
  1928. ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
  1929. ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd}
  1930. begin
  1931. Result:=SQLFieldTypes[FT];
  1932. If (Result='') then
  1933. Raise EDataDict.CreateFmt(SErrFieldTypeNotSupported,[GetEnumName(TypeInfo(TFieldType),Ord(FT))]);
  1934. case FT of
  1935. ftString,
  1936. ftFixedChar,
  1937. ftWideString :
  1938. Result:=Result+Format('(%d)',[ASize]);
  1939. ftBCD,
  1940. ftFMTBCD :
  1941. Result:=Result+Format('(%d,%d)',[APrecision,ASize]);
  1942. end;
  1943. end;
  1944. function TFPDDSQLEngine.FieldDefaultString(FD : TDDFieldDef) : String;
  1945. begin
  1946. Result:=SDefault+' '+FD.DBDefault;
  1947. end;
  1948. function TFPDDSQLEngine.FieldCheckString(FD : TDDFieldDef) : String;
  1949. begin
  1950. Result:=Trim(FD.Constraint);
  1951. If (Result<>'') then
  1952. begin
  1953. If (Result[1]<>'(') or (Result[Length(Result)]<>')') then
  1954. Result:='('+Result+')';
  1955. Result:=SCheck+' '+Result;
  1956. end;
  1957. end;
  1958. function TFPDDSQLEngine.FieldDeclarationString(FD : TDDFieldDef) : String;
  1959. var
  1960. S : String;
  1961. begin
  1962. Result:=FieldNameString(FD)+' '+FieldTypeString(FD);
  1963. If (FD.DBDefault<>'') then
  1964. Result:=Result+' '+FieldDefaultString(FD);
  1965. If FD.Required then
  1966. Result:=Result+' '+SNotNull;
  1967. S:=FieldCheckString(FD);
  1968. If (S<>'') then
  1969. Result:=Result+' '+S;
  1970. end;
  1971. { SQL Creation functions. Can be overridden if needed. }
  1972. function TFPDDSQLEngine.CreateSelectSQL(FieldList, KeyFields: TFPDDFieldList
  1973. ): String;
  1974. Var
  1975. i : Integer;
  1976. FD : TDDFieldDef;
  1977. S : String;
  1978. begin
  1979. CheckTableDef;
  1980. Result:='';
  1981. ResetLine;
  1982. AddToStringLn(Result,SSelect);
  1983. For i:=0 to FieldList.Count-1 do
  1984. begin
  1985. FD:=FieldList[i];
  1986. S:=FieldNameString(FD);
  1987. If (I<FieldList.Count-1) then
  1988. S:=S+',';
  1989. AddFieldString(Result,S);
  1990. end;
  1991. If Not (eoLineFeedAfterField in FOptions) then
  1992. AddToStringLn(Result,'');
  1993. NoIndent;
  1994. AddToStringLn(Result,SFrom);
  1995. AddToStringLn(Result,TableNameString(TableDef));
  1996. AddWhereClause(Result,KeyFields,False);
  1997. FixUpStatement(Result);
  1998. end;
  1999. function TFPDDSQLEngine.CreateInsertSQL(FieldList: TFPDDFieldList): String;
  2000. Var
  2001. i : Integer;
  2002. FD : TDDFieldDef;
  2003. S : String;
  2004. begin
  2005. CheckTableDef;
  2006. Result:='';
  2007. ResetLine;
  2008. AddToString(Result,SInsertInto);
  2009. AddToStringLn(Result,TableNameString(TableDef));
  2010. For i:=0 to FieldList.Count-1 do
  2011. begin
  2012. FD:=FieldList[i];
  2013. S:=FieldNameString(FD);
  2014. If (I=0) then
  2015. S:='('+S;
  2016. If (I<FieldList.Count-1) then
  2017. S:=S+','
  2018. else
  2019. S:=S+')';
  2020. AddFieldString(Result,S);
  2021. end;
  2022. If Not (eoLineFeedAfterField in FOptions) then
  2023. AddToStringLn(Result,'');
  2024. NoIndent;
  2025. AddToStringLn(Result,SValues);
  2026. For i:=0 to FieldList.Count-1 do
  2027. begin
  2028. FD:=FieldList[i];
  2029. S:=FieldParamString(FD,False);
  2030. If (I=0) then
  2031. S:='('+S;
  2032. If (I<FieldList.Count-1) then
  2033. S:=S+','
  2034. else
  2035. S:=S+')';
  2036. AddFieldString(Result,S);
  2037. end;
  2038. FixUpStatement(Result);
  2039. end;
  2040. function TFPDDSQLEngine.CreateUpdateSQL(FieldList, KeyFields: TFPDDFieldList
  2041. ): String;
  2042. Var
  2043. i : Integer;
  2044. FD : TDDFieldDef;
  2045. S : String;
  2046. begin
  2047. CheckTableDef;
  2048. ResetLine;
  2049. Result:='';
  2050. AddToString(Result,SUPDATE);
  2051. AddToStringLN(Result,TableNameString(TableDef));
  2052. NoIndent;
  2053. AddToStringLN(Result,SSET);
  2054. If Assigned(FieldList) and (FieldList.Count>0) then
  2055. begin
  2056. For i:=0 to FieldList.Count-1 do
  2057. begin
  2058. FD:=FieldList[i];
  2059. S:=FieldNameString(FD)+' = '+FieldParamString(FD,False);
  2060. If (I<FieldList.Count-1) then
  2061. S:=S+',';
  2062. AddFieldString(Result,S);
  2063. end;
  2064. end;
  2065. AddWhereClause(Result,KeyFields,eoUseOldInWhereParams in Options);
  2066. FixUpStatement(Result);
  2067. end;
  2068. function TFPDDSQLEngine.CreateDeleteSQL(KeyFields: TFPDDFieldList): String;
  2069. begin
  2070. CheckTableDef;
  2071. ResetLine;
  2072. Result:='';
  2073. AddToStringLN(Result,SDeleteFrom);
  2074. AddToStringLN(Result,TableNameString(TableDef));
  2075. AddWhereClause(Result,KeyFields,eoUseOldInWhereParams in Options);
  2076. FixUpStatement(Result);
  2077. end;
  2078. function TFPDDSQLEngine.CreateCreateSQL(Fields, KeyFields: TFPDDFieldList
  2079. ): String;
  2080. Var
  2081. S : String;
  2082. I : integer;
  2083. begin
  2084. CheckTableDef;
  2085. Result:='';
  2086. ResetLine;
  2087. AddToStringLn(Result,SCreateTable+' '+TableNameString(TableDef)+' (');
  2088. For I:=0 to Fields.Count-1 do
  2089. begin
  2090. S:=FieldDeclarationString(Fields[i]);
  2091. If (I<Fields.Count-1) or (Assigned(KeyFields) and (KeyFields.Count<>0)) then
  2092. S:=S+',';
  2093. AddToStringLn(Result,S);
  2094. end;
  2095. If (Assigned(KeyFields) and (KeyFields.Count<>0)) then
  2096. begin
  2097. S:=SCONSTRAINT+' '+TableDef.PrimaryKeyConstraintName+' '+SPrimaryKey+' (';
  2098. For I:=0 to KeyFields.Count-1 do
  2099. begin
  2100. S:=S+FieldNameString(KeyFields[i]);
  2101. If I<KeyFields.Count-1 then
  2102. S:=S+','
  2103. else
  2104. S:=S+')'
  2105. end;
  2106. AddToStringLn(Result,S);
  2107. end;
  2108. NoIndent;
  2109. AddToStringLn(Result,')');
  2110. FixUpStatement(Result);
  2111. end;
  2112. function TFPDDSQLEngine.CreateCreateSQL(KeyFields: TFPDDFieldList): String;
  2113. Var
  2114. Fl : TFPDDFieldList;
  2115. begin
  2116. CheckTableDef;
  2117. FL:=TFPDDfieldList.CreateFromTableDef(TableDef);
  2118. try
  2119. FL.OwnsObjects:=False;
  2120. Result:=CreateCreateSQL(FL,KeyFields);
  2121. finally
  2122. FL.Free;
  2123. end;
  2124. end;
  2125. function TFPDDSQLEngine.CreateIndexSQL(Index: TDDIndexDef): String;
  2126. Var
  2127. L : TFPDDFieldList;
  2128. I : Integer;
  2129. begin
  2130. Result:='CREATE ';
  2131. If ixUnique in Index.Options then
  2132. Result:=Result+'UNIQUE ';
  2133. If ixDescending in Index.Options then
  2134. Result:=Result+'DESCENDING ';
  2135. Result:=Result+'INDEX '+Index.IndexName;
  2136. Result:=Result+' ON '+TableDef.TableName+' (';
  2137. L:=TFPDDFieldList.Create;
  2138. try
  2139. L.OwnsObjects:=False;
  2140. TableDef.Fields.FillFieldList(Index.Fields,L);
  2141. For I:=0 to L.Count-1 do
  2142. begin
  2143. If (I>0) then
  2144. Result:=Result+',';
  2145. Result:=Result+L[I].FieldName;
  2146. end;
  2147. finally
  2148. L.Free;
  2149. end;
  2150. Result:=Result+')';
  2151. end;
  2152. function TFPDDSQLEngine.CreateIndexesSQL(Indexes: TFPDDIndexList): String;
  2153. Var
  2154. SQL : TStringList;
  2155. begin
  2156. SQL:=TStringList.Create;
  2157. try
  2158. CreateIndexesSQLStrings(Indexes,SQL);
  2159. Result:=SQL.Text;
  2160. finally
  2161. SQL.free;
  2162. end;
  2163. end;
  2164. function TFPDDSQLEngine.CreateIndexesSQL(Indexes: TDDIndexDefs): String;
  2165. Var
  2166. IL : TFPDDIndexList;
  2167. begin
  2168. IL:=TFPDDIndexList.CreateFromIndexDefs(Indexes);
  2169. try
  2170. IL.OwnsObjects:=False;
  2171. Result:=CreateIndexesSQL(IL);
  2172. finally
  2173. IL.Free;
  2174. end;
  2175. end;
  2176. function TFPDDSQLEngine.CreateForeignKeySQL(ForeignKey: TDDForeignKeyDef
  2177. ): String;
  2178. begin
  2179. Result:=Format('ALTER TABLE %s ADD CONSTRAINT %s',[TableDef.TableName,ForeignKey.KeyName]);
  2180. Result:=Result+Format(' FOREIGN KEY (%s)',[ForeignKey.KeyFields]);
  2181. Result:=Result+Format(' REFERENCES %s(%s)',[ForeignKey.ReferencesTable,ForeignKey.ReferencedFields])
  2182. end;
  2183. function TFPDDSQLEngine.CreateForeignKeysSQL(ForeignKeys: TDDForeignKeyDefs
  2184. ): String;
  2185. Var
  2186. SQL : TStrings;
  2187. begin
  2188. SQL:=TStringList.Create;
  2189. try
  2190. CreateForeignKeysSQLStrings(ForeignKeys,SQL);
  2191. Result:=SQL.Text;
  2192. finally
  2193. SQL.Free;
  2194. end;
  2195. end;
  2196. function TFPDDSQLEngine.CreateSequenceSQL(Sequence: TDDSequenceDef): String;
  2197. begin
  2198. Result:='CREATE SEQUENCE '+Sequence.SequenceName;
  2199. If (Sequence.StartValue<>0) then
  2200. Result:=Result+' START WITH '+IntToStr(Sequence.StartValue);
  2201. If (Sequence.Increment<>0) then
  2202. Result:=Result+' INCREMENT BY '+IntToStr(Sequence.Increment);
  2203. end;
  2204. function TFPDDSQLEngine.CreateSequencesSQL(Sequences: TFPDDSequenceList): String;
  2205. Var
  2206. SQL : TStrings;
  2207. begin
  2208. SQL:=TStringList.Create;
  2209. Try
  2210. CreateSequencesSQLStrings(Sequences,SQL);
  2211. Result:=SQL.Text;
  2212. Finally
  2213. SQL.Free;
  2214. end;
  2215. end;
  2216. function TFPDDSQLEngine.CreateSequencesSQL(Sequences: TDDSequenceDefs): String;
  2217. Var
  2218. L : TFPDDSequenceList;
  2219. begin
  2220. L:=TFPDDSequenceList.CreateFromSequenceDefs(Sequences);
  2221. try
  2222. L.OwnsObjects:=False;
  2223. Result:=CreateSequencesSQl(L);
  2224. finally
  2225. L.Free;
  2226. end;
  2227. end;
  2228. function TFPDDSQLEngine.CreateDomainSQL(Domain: TDDDomainDef): String;
  2229. begin
  2230. Result:='CREATE DOMAIN '+Domain.DomainName+' ';
  2231. Result:=Result+FieldTypeString(Domain.FieldType,Domain.Size,Domain.Precision);
  2232. If Domain.Required then
  2233. Result:=Result+' NOT NULL';
  2234. If (Domain.CheckConstraint<>'') then
  2235. Result:=Result+' CHECK ('+Domain.CheckConstraint+')';
  2236. end;
  2237. function TFPDDSQLEngine.CreateDomainsSQL(Domains: TFPDDDomainList): String;
  2238. Var
  2239. SQL : TStrings;
  2240. begin
  2241. SQL:=TStringList.Create;
  2242. Try
  2243. CreateDomainsSQLStrings(Domains,SQL);
  2244. Result:=SQL.Text;
  2245. Finally
  2246. SQL.Free;
  2247. end;
  2248. end;
  2249. function TFPDDSQLEngine.CreateDomainsSQL(Domains: TDDDomainDefs): String;
  2250. Var
  2251. L : TFPDDDomainList;
  2252. begin
  2253. L:=TFPDDDomainList.CreateFromDomainDefs(Domains);
  2254. try
  2255. L.OwnsObjects:=False;
  2256. Result:=CreateDomainsSQl(L);
  2257. finally
  2258. L.Free;
  2259. end;
  2260. end;
  2261. function TFPDDSQLEngine.CreateTableSQL: String;
  2262. Var
  2263. SQL : TStrings;
  2264. begin
  2265. SQL:=TStringList.Create;
  2266. try
  2267. CreateTableSQLStrings(SQL);
  2268. Result:=SQL.Text;
  2269. finally
  2270. SQL.Free;
  2271. end;
  2272. end;
  2273. procedure TFPDDSQLEngine.CreateTableSQLStrings(SQL: TStrings);
  2274. Var
  2275. L : TStrings;
  2276. I : Integer;
  2277. KF : TFPDDFieldlist;
  2278. ID : TDDIndexDef;
  2279. FD : TDDFieldDef;
  2280. S : String;
  2281. begin
  2282. CheckTableDef;
  2283. L:=TStringList.Create;
  2284. try
  2285. KF:=TFPDDFieldlist.Create(False);
  2286. try
  2287. KF.OwnsObjects:=False;
  2288. if assigned (TableDef.PrimaryIndexDef) then
  2289. TableDef.fields.FillFieldList(TableDef.PrimaryIndexDef.Fields, KF)
  2290. else
  2291. For I:=0 to TableDef.Fields.Count-1 do
  2292. begin
  2293. FD:=TableDef.Fields[I];
  2294. If pfInKey in FD.ProviderFlags then
  2295. KF.Add(FD);
  2296. end;
  2297. CreateCreateSQLStrings(KF,SQL);
  2298. FixupStatement(SQL,True);
  2299. L.Text:=CreateIndexesSQL(TableDef.Indexes);
  2300. If (L.Count>0) then
  2301. begin
  2302. SQL.AddStrings(L);
  2303. FixupStatement(SQL,True);
  2304. end;
  2305. L.Clear;
  2306. If Not (eoSkipForeignKeys in Options) then
  2307. L.Text:=CreateForeignKeysSQL(TableDef.ForeignKeys);
  2308. SQL.AddStrings(L);
  2309. finally
  2310. KF.Free;
  2311. end;
  2312. finally
  2313. L.Free;
  2314. end;
  2315. end;
  2316. { TStrings versions of SQL creation statements. }
  2317. procedure TFPDDSQLEngine.CreateSelectSQLStrings(FieldList,KeyFields: TFPDDFieldList; SQL: TStrings);
  2318. begin
  2319. SQL.Text:=CreateSelectSQL(FieldList,KeyFields);
  2320. end;
  2321. procedure TFPDDSQLEngine.CreateInsertSQLStrings(FieldList: TFPDDFieldList; SQL: TStrings);
  2322. begin
  2323. SQL.Text:=CreateInsertSQL(FieldList);
  2324. end;
  2325. procedure TFPDDSQLEngine.CreateUpdateSQLStrings(FieldList, KeyFields: TFPDDFieldList;
  2326. SQL: TStrings);
  2327. begin
  2328. SQL.Text:=CreateUpdateSQL(FieldList,KeyFields);
  2329. end;
  2330. procedure TFPDDSQLEngine.CreateDeleteSQLStrings(KeyFields: TFPDDFieldList;
  2331. SQL: TStrings);
  2332. begin
  2333. SQL.Text:=CreateDeleteSQL(KeyFields);
  2334. end;
  2335. procedure TFPDDSQLEngine.CreateCreateSQLStrings(Fields,
  2336. KeyFields: TFPDDFieldList; SQL: TStrings);
  2337. begin
  2338. SQL.Text:=CreateCreateSQL(Fields,KeyFields);
  2339. end;
  2340. procedure TFPDDSQLEngine.CreateCreateSQLStrings(KeyFields: TFPDDFieldList;
  2341. SQL: TStrings);
  2342. begin
  2343. SQL.Text:=CreateCreateSQL(KeyFields);
  2344. end;
  2345. procedure TFPDDSQLEngine.CreateIndexesSQLStrings(Indexes: TFPDDIndexList; SQL: TStrings);
  2346. Var
  2347. I : integer;
  2348. begin
  2349. For I:=0 to Indexes.Count-1 do
  2350. if not (ixPrimary in Indexes[i].Options) then
  2351. SQL.Add(CreateIndexSQL(Indexes[i])+TerminatorChar);
  2352. end;
  2353. procedure TFPDDSQLEngine.CreateForeignKeysSQLStrings(
  2354. ForeignKeys: TDDForeignKeyDefs; SQL: TStrings);
  2355. Var
  2356. I : integer;
  2357. begin
  2358. For I:=0 to ForeignKeys.Count-1 do
  2359. SQL.Add(CreateForeignKeySQL(ForeignKeys[i])+TerminatorChar);
  2360. end;
  2361. procedure TFPDDSQLEngine.CreateSequencesSQLStrings(Sequences: TFPDDSequenceList;
  2362. SQL: TStrings);
  2363. Var
  2364. I : integer;
  2365. begin
  2366. For I:=0 to Sequences.Count-1 do
  2367. SQL.Add(CreateSequenceSQL(Sequences[i])+TerminatorChar);
  2368. end;
  2369. procedure TFPDDSQLEngine.CreateDomainsSQLStrings(Domains: TFPDDDomainList;
  2370. SQL: TStrings);
  2371. Var
  2372. I : integer;
  2373. begin
  2374. For I:=0 to Domains.Count-1 do
  2375. SQL.Add(CreateDomainSQL(Domains[i])+TerminatorChar);
  2376. end;
  2377. { ---------------------------------------------------------------------
  2378. TDDFieldList
  2379. ---------------------------------------------------------------------}
  2380. function TFPDDFieldList.GetFieldDef(Index : Integer): TDDFieldDef;
  2381. begin
  2382. Result:=TDDFieldDef(Items[Index]);
  2383. end;
  2384. procedure TFPDDFieldList.SetFieldDef(Index : Integer; const AValue: TDDFieldDef);
  2385. begin
  2386. Items[Index]:=AValue;
  2387. end;
  2388. constructor TFPDDFieldList.CreateFromTableDef(TD: TDDTableDef);
  2389. begin
  2390. CreateFromFieldDefs(TD.Fields);
  2391. end;
  2392. constructor TFPDDFieldList.CreateFromFieldDefs(FD: TDDFieldDefs);
  2393. Var
  2394. I : Integer;
  2395. begin
  2396. Inherited Create;
  2397. Capacity:=FD.Count;
  2398. For I:=0 to FD.Count-1 do
  2399. Add(FD[i]);
  2400. end;
  2401. function TFPDDIndexList.GetIndexDef(AIndex: Integer): TDDIndexDef;
  2402. begin
  2403. Result:=TDDIndexDef(Items[AIndex]);
  2404. end;
  2405. procedure TFPDDIndexList.SetIndexDef(AIndex: Integer; const AValue: TDDIndexDef
  2406. );
  2407. begin
  2408. Items[AIndex]:=AValue
  2409. end;
  2410. constructor TFPDDIndexList.CreateFromIndexDefs(FD: TDDIndexDefs);
  2411. var
  2412. I : Integer;
  2413. begin
  2414. Inherited Create;
  2415. For I:=0 to FD.Count-1 do
  2416. Add(FD[I]);
  2417. end;
  2418. { TDDIndexDef }
  2419. function TDDIndexDef.GetSectionName: String;
  2420. begin
  2421. Result:=IndexName;
  2422. end;
  2423. procedure TDDIndexDef.SetSectionName(const Value: String);
  2424. begin
  2425. IndexName:=Value;
  2426. end;
  2427. procedure TDDIndexDef.Assign(ASource: TPersistent);
  2428. Var
  2429. DD : TDDIndexDef;
  2430. D : TIndexDef;
  2431. begin
  2432. If ASource is TDDIndexDef then
  2433. begin
  2434. DD:=ASource as TDDIndexDef;
  2435. IndexName:=DD.IndexName;
  2436. Expression:=DD.Expression;
  2437. Fields:=DD.Expression;
  2438. CaseInsFields:=DD.CaseInsFields;
  2439. DescFields:=DD.DescFields;
  2440. Options:=DD.Options;
  2441. Source:=DD.Source;
  2442. end
  2443. else if ASource is TIndexDef then
  2444. begin
  2445. D:=ASource as TIndexDef;
  2446. IndexName:=D.Name;
  2447. Expression:=D.Expression;
  2448. Fields:=D.Fields;
  2449. CaseInsFields:=D.CaseInsFields;
  2450. DescFields:=D.DescFields;
  2451. Options:=D.Options;
  2452. Source:=D.Source;
  2453. end
  2454. else
  2455. inherited Assign(ASource);
  2456. end;
  2457. procedure TDDIndexDef.SaveToIni(Ini: TCustomInifile; ASection: String);
  2458. Var
  2459. O : Integer;
  2460. T : PTypeInfo;
  2461. begin
  2462. With Ini do
  2463. begin
  2464. WriteString(ASection,KeyExpression,Expression);
  2465. WriteString(ASection,KeyFields,Fields);
  2466. WriteString(ASection,KeyCaseInsFields,CaseInsFields);
  2467. WriteString(ASection,KeyDescFields,DescFields);
  2468. WriteString(ASection,KeySource,Source);
  2469. O:=Integer(self.Options);
  2470. T:=TypeInfo(TIndexOptions);
  2471. WriteString(ASection,KeyOptions,SetToString(T,O,False));
  2472. end;
  2473. end;
  2474. procedure TDDIndexDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
  2475. Var
  2476. O : Integer;
  2477. OP : TIndexOptions;
  2478. T : PTypeInfo;
  2479. S : String;
  2480. begin
  2481. With Ini do
  2482. begin
  2483. Expression:=ReadString(ASection,KeyExpression,'');
  2484. Fields:=ReadString(ASection,KeyFields,'');
  2485. CaseInsFields:=ReadString(ASection,KeyCaseInsFields,'');
  2486. DescFields:=ReadString(ASection,KeyDescFields,'');
  2487. Source:=ReadString(ASection,KeySource,'');
  2488. S:=ReadString(ASection,KeyOptions,'');
  2489. T:=TypeInfo(TIndexOptions);
  2490. O:=StringToSet(T,S);
  2491. OP:=TIndexOptions(O);
  2492. Self.Options:=OP;
  2493. end;
  2494. end;
  2495. { TDDIndexDefs }
  2496. function TDDIndexDefs.GetIndex(Index : Integer): TDDIndexDef;
  2497. begin
  2498. Result:=Items[Index] as TDDIndexDef;
  2499. end;
  2500. procedure TDDIndexDefs.SetIndex(Index : Integer; const AValue: TDDIndexDef);
  2501. begin
  2502. Items[Index]:=AValue;
  2503. end;
  2504. procedure TDDIndexDefs.SetTableName(const AValue: String);
  2505. begin
  2506. Inherited;
  2507. FSectionPrefix:=AValue;
  2508. GlobalSection:=AValue+SIndexSuffix;
  2509. end;
  2510. constructor TDDIndexDefs.Create(ATableDef: TDDTableDef);
  2511. begin
  2512. FTableDef:=ATableDef;
  2513. If Assigned(FTableDef) then
  2514. Create(FTableDef.TableName)
  2515. else
  2516. Create('')
  2517. end;
  2518. constructor TDDIndexDefs.Create(const ATableName: String);
  2519. begin
  2520. FPrefix:='Index';
  2521. TableName:=ATableName;
  2522. Inherited Create(TDDIndexDef);
  2523. end;
  2524. function TDDIndexDefs.AddDDIndexDef(AName: String): TDDIndexDef;
  2525. begin
  2526. result := AddIndex (AName);
  2527. end;
  2528. function TDDIndexDefs.AddIndex(const AName: String): TDDIndexDef;
  2529. begin
  2530. Result:=Add as TDDIndexDef;
  2531. Result.IndexName:=AName;
  2532. end;
  2533. { TDDForeignKeyDef }
  2534. procedure TDDForeignKeyDef.SetKeyName(const AValue: String);
  2535. begin
  2536. if FKeyName=AValue then exit;
  2537. FKeyName:=AValue;
  2538. end;
  2539. function TDDForeignKeyDef.GetSectionName: String;
  2540. begin
  2541. Result:=FKeyName;
  2542. end;
  2543. procedure TDDForeignKeyDef.SetSectionName(const Value: String);
  2544. begin
  2545. FkeyName:=Value;
  2546. end;
  2547. procedure TDDForeignKeyDef.Assign(ASource: TPersistent);
  2548. Var
  2549. K : TDDForeignKeyDef;
  2550. begin
  2551. if ASource is TDDForeignKeyDef then
  2552. begin
  2553. K:=ASource as TDDForeignKeyDef;
  2554. FKeyFields:=K.KeyFields;
  2555. FKeyName:=K.KeyName;
  2556. FReferencedFields:=K.ReferencedFields;
  2557. FTableName:=K.FTableName;
  2558. end
  2559. else
  2560. inherited Assign(ASource);
  2561. end;
  2562. procedure TDDForeignKeyDef.SaveToIni(Ini: TCustomInifile; ASection: String);
  2563. begin
  2564. With Ini Do
  2565. begin
  2566. WriteString(ASection,KeyKeyFields,KeyFields);
  2567. WriteString(ASection,KeyKeyName,KeyName);
  2568. WriteString(ASection,KeyReferencesTable,ReferencesTable);
  2569. WriteString(ASection,KeyReferencedFields,ReferencedFields);
  2570. end;
  2571. end;
  2572. procedure TDDForeignKeyDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
  2573. begin
  2574. With Ini Do
  2575. begin
  2576. KeyFields:=ReadString(ASection,KeyKeyFields,'');
  2577. KeyName:=ReadString(ASection,KeyKeyName,'');
  2578. ReferencesTable:=ReadString(ASection,KeyReferencesTable,'');
  2579. ReferencedFields:=ReadString(ASection,KeyReferencedFields,'');
  2580. end;
  2581. end;
  2582. { TDDForeignKeyDefs }
  2583. function TDDForeignKeyDefs.GetKey(AIndex : Integer): TDDForeignKeyDef;
  2584. begin
  2585. Result:=TDDForeignKeyDef(Items[AIndex]);
  2586. end;
  2587. procedure TDDForeignKeyDefs.SetKey(AIndex : Integer; const AValue: TDDForeignKeyDef
  2588. );
  2589. begin
  2590. Items[AIndex]:=AValue
  2591. end;
  2592. procedure TDDForeignKeyDefs.SetTableName(const AValue: String);
  2593. begin
  2594. if FTableName=AValue then exit;
  2595. FSectionPrefix:=AValue;
  2596. GlobalSection:=AValue+SKeySuffix;
  2597. end;
  2598. constructor TDDForeignKeyDefs.Create(const ATableName: String);
  2599. begin
  2600. Inherited Create(TDDForeignKeyDef);
  2601. FPrefix:='Key';
  2602. SetTableName(ATAbleName);
  2603. end;
  2604. function TDDForeignKeyDefs.AddForeignKeyDef(const AName: String): TDDForeignKeyDef;
  2605. begin
  2606. Result:=Add as TDDForeignKeyDef;
  2607. Result.KeyName:=AName;
  2608. end;
  2609. function TDDIndexDefs.IndexOfIndex(const AIndexName: String): Integer;
  2610. begin
  2611. Result:=Count-1;
  2612. While (Result>=0) and (CompareText(GetIndex(Result).IndexName,AIndexName)<>0) do
  2613. Dec(Result)
  2614. end;
  2615. function TDDIndexDefs.FindIndex(const AIndexName: String): TDDIndexDef;
  2616. Var
  2617. I : integer;
  2618. begin
  2619. I:=IndexOfIndex(AIndexName);
  2620. If (I=-1) then
  2621. Result:=Nil
  2622. else
  2623. Result:=GetIndex(I);
  2624. end;
  2625. function TDDIndexDefs.IndexByName(const AIndexName: String): TDDIndexDef;
  2626. begin
  2627. Result:=FindIndex(AIndexName);
  2628. If Result=Nil then
  2629. Raise EDatadict.CreateFmt(SErrIndexNotFound,[TableName,AIndexName]);
  2630. end;
  2631. { TDDDomainDefs }
  2632. function TDDDomainDefs.GetDomain(Index: Integer): TDDDomainDef;
  2633. begin
  2634. Result:=TDDDomainDef(Items[Index]);
  2635. end;
  2636. procedure TDDDomainDefs.SetDomain(Index: Integer;
  2637. const AValue: TDDDomainDef);
  2638. begin
  2639. Items[Index]:=AValue;
  2640. end;
  2641. constructor TDDDomainDefs.Create;
  2642. begin
  2643. FPrefix:='Domain';
  2644. FSectionPrefix:='Domain';
  2645. GlobalSection:='Domains';
  2646. inherited Create(TDDDomainDef);
  2647. end;
  2648. function TDDDomainDefs.AddDomain(const ADomainName: String): TDDDomainDef;
  2649. begin
  2650. Result:=Add as TDDDomainDef;
  2651. Result.DomainName:=ADomainName;
  2652. end;
  2653. function TDDDomainDefs.IndexOfDomain(const ADomainName: String): Integer;
  2654. begin
  2655. Result := Count;
  2656. repeat
  2657. Dec(Result);
  2658. until (Result < 0) or (CompareText(GetDomain(Result).DomainName,ADomainName) = 0);
  2659. end;
  2660. function TDDDomainDefs.FindDomain(const ADomainName: String): TDDDomainDef;
  2661. Var
  2662. I : Integer;
  2663. begin
  2664. I:=IndexOfDomain(ADomainName);
  2665. If (I=-1) then
  2666. Result:=Nil
  2667. else
  2668. Result:=GetDomain(I);
  2669. end;
  2670. function TDDDomainDefs.DomainByName(const ADomainName: String): TDDDomainDef;
  2671. begin
  2672. Result:=FindDomain(ADomainName);
  2673. If (Result=Nil) then
  2674. Raise EDatadict.CreateFmt(SErrDomainNotFound,[ADomainName]);
  2675. end;
  2676. { TDDDomainDef }
  2677. procedure TDDDomainDef.SetDomainName(const AValue: String);
  2678. begin
  2679. if FDomainName=AValue then exit;
  2680. If Assigned(Collection) and
  2681. ((Collection as TDDDomainDefs).FindDomain(AValue)<>Nil) then
  2682. EDataDict.CreateFmt(SErrDuplicateDomain,[AValue]);
  2683. FDomainName:=AValue;
  2684. end;
  2685. function TDDDomainDef.GetSectionName: String;
  2686. begin
  2687. Result:=FDomainName;
  2688. end;
  2689. procedure TDDDomainDef.SetSectionName(const Value: String);
  2690. begin
  2691. FDomainName:=Value;
  2692. end;
  2693. procedure TDDDomainDef.Assign(ASource: TPersistent);
  2694. Var
  2695. D : TDDDomainDef;
  2696. begin
  2697. if (ASource is TDDDomainDef) then
  2698. begin
  2699. D:=(ASource as TDDDomainDef);
  2700. FDomainName:=D.DomainName;
  2701. FFieldType:=D.FieldType;
  2702. FCheckconstraint:=D.Checkconstraint;
  2703. FSize:=D.Size;
  2704. FPrecision:=D.Precision;
  2705. end
  2706. else
  2707. inherited Assign(ASource);
  2708. end;
  2709. procedure TDDDomainDef.SaveToIni(Ini: TCustomInifile; ASection: String);
  2710. begin
  2711. With Ini do
  2712. begin
  2713. WriteInteger(ASection,KeyFieldType,Ord(Fieldtype));
  2714. WriteBool(ASection,KeyRequired,Required);
  2715. WriteString(ASection,KeyCheckConstraint,CheckConstraint);
  2716. WriteInteger(ASection,KeySize,Size);
  2717. WriteInteger(ASection,KeyPrecision,Precision);
  2718. end;
  2719. end;
  2720. procedure TDDDomainDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
  2721. begin
  2722. With Ini do
  2723. begin
  2724. FieldType:=TFieldType(ReadInteger(ASection,KeyFieldType,Ord(Fieldtype)));
  2725. Required:=ReadBool(ASection,KeyRequired,Required);
  2726. CheckConstraint:=ReadString(ASection,KeyCheckConstraint,CheckConstraint);
  2727. Size:=ReadInteger(ASection,KeySize,Size);
  2728. Precision:=ReadInteger(ASection,KeyPrecision,Precision);
  2729. end;
  2730. end;
  2731. { TFPDDDomainList }
  2732. function TFPDDDomainList.GetDomainDef(AIndex: Integer): TDDDomainDef;
  2733. begin
  2734. Result:=TDDDomainDef(Items[AIndex]);
  2735. end;
  2736. procedure TFPDDDomainList.SetDomainDef(AIndex: Integer;
  2737. const AValue: TDDDomainDef);
  2738. begin
  2739. Items[AIndex]:=AValue;
  2740. end;
  2741. constructor TFPDDDomainList.CreateFromDomainDefs(DD: TDDDomainDefs);
  2742. Var
  2743. I : Integer;
  2744. begin
  2745. Inherited Create;
  2746. For I:=0 to DD.Count-1 do
  2747. Add(DD[I]);
  2748. end;
  2749. { TDDSequenceDef }
  2750. procedure TDDSequenceDef.SetSequenceName(const AValue: String);
  2751. begin
  2752. if FSequenceName=AValue then exit;
  2753. If Assigned(Collection) and
  2754. ((Collection as TDDSequenceDefs).FindSequence(AValue)<>Nil) then
  2755. EDataDict.CreateFmt(SErrDuplicateSequence,[AValue]);
  2756. FSequenceName:=AValue;
  2757. end;
  2758. function TDDSequenceDef.GetSectionName: String;
  2759. begin
  2760. Result:=SequenceName;
  2761. end;
  2762. procedure TDDSequenceDef.SetSectionName(const Value: String);
  2763. begin
  2764. SequenceName:=Value;
  2765. end;
  2766. procedure TDDSequenceDef.Assign(ASource: TPersistent);
  2767. Var
  2768. S : TDDSequenceDef;
  2769. begin
  2770. If ASource is TDDSequenceDef then
  2771. begin
  2772. S:=ASource as TDDSequenceDef;
  2773. FSequenceName:=S.SequenceName;
  2774. FStartvalue:=S.Startvalue;
  2775. FIncrement:=S.Increment;
  2776. end
  2777. else
  2778. inherited Assign(ASource);
  2779. end;
  2780. procedure TDDSequenceDef.SaveToIni(Ini: TCustomInifile; ASection: String);
  2781. begin
  2782. With Ini do
  2783. begin
  2784. WriteInteger(ASection,KeyStartValue,StartValue);
  2785. WriteInteger(ASection,KeyIncrement,StartValue);
  2786. end;
  2787. end;
  2788. procedure TDDSequenceDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
  2789. begin
  2790. With Ini do
  2791. begin
  2792. StartValue:=ReadInteger(ASection,KeyStartValue,0);
  2793. Increment:=ReadInteger(ASection,KeyIncrement,0);
  2794. end;
  2795. end;
  2796. { TDDSequenceDefs }
  2797. function TDDSequenceDefs.GetSequence(Index: Integer): TDDSequenceDef;
  2798. begin
  2799. Result:=TDDSequenceDef(Items[Index]);
  2800. end;
  2801. procedure TDDSequenceDefs.SetSequence(Index: Integer; const AValue: TDDSequenceDef);
  2802. begin
  2803. Items[Index]:=AValue;
  2804. end;
  2805. constructor TDDSequenceDefs.Create;
  2806. begin
  2807. FPrefix:='Sequence';
  2808. FSectionPrefix:='Sequence';
  2809. GlobalSection:='Sequences';
  2810. Inherited Create(TDDSequenceDef);
  2811. end;
  2812. function TDDSequenceDefs.AddSequence(const ASequenceName: String): TDDSequenceDef;
  2813. begin
  2814. Result:=Add as TDDSequenceDef;
  2815. Result.SequenceName:=ASequenceName;
  2816. end;
  2817. function TDDSequenceDefs.IndexOfSequence(const ASequenceName: String): Integer;
  2818. begin
  2819. result := count;
  2820. repeat
  2821. Dec(Result);
  2822. until (Result<0) or (CompareText(GetSequence(Result).SequenceName,ASequenceName)=0);
  2823. end;
  2824. function TDDSequenceDefs.FindSequence(const ASequenceName: String): TDDSequenceDef;
  2825. Var
  2826. I : Integer;
  2827. begin
  2828. I:=IndexOfSequence(ASequenceName);
  2829. If (I=-1) then
  2830. Result:=Nil
  2831. else
  2832. Result:=GetSequence(I);
  2833. end;
  2834. function TDDSequenceDefs.SequenceByName(const ASequenceName: String): TDDSequenceDef;
  2835. begin
  2836. Result:=FindSequence(ASequenceName);
  2837. If (Result=Nil) then
  2838. Raise EDatadict.CreateFmt(SErrSequenceNotFound,[ASequenceName]);
  2839. end;
  2840. { TFPDDSequenceList }
  2841. function TFPDDSequenceList.GetSequenceDef(AIndex: Integer): TDDSequenceDef;
  2842. begin
  2843. Result:=TDDSequenceDef(Items[AIndex]);
  2844. end;
  2845. procedure TFPDDSequenceList.SetSequenceDef(AIndex: Integer;
  2846. const AValue: TDDSequenceDef);
  2847. begin
  2848. Items[AIndex]:=AValue;
  2849. end;
  2850. constructor TFPDDSequenceList.CreateFromSequenceDefs(SD: TDDSequenceDefs);
  2851. Var
  2852. I : Integer;
  2853. begin
  2854. Inherited Create;
  2855. For I:=0 to SD.Count-1 do
  2856. Add(SD[I]);
  2857. end;
  2858. { TDDTableCollection }
  2859. function TDDTableCollection.GetTableName: String;
  2860. begin
  2861. If Assigned(FTableDef) then
  2862. Result:=FTableDef.TableName
  2863. else
  2864. Result:=FTableName;
  2865. end;
  2866. procedure TDDTableCollection.SetTableDef(ATableDef: TDDTableDef);
  2867. begin
  2868. FTableDef:=ATableDef;
  2869. If Assigned(FTableDef) then
  2870. TableName:=FTableDef.TableName;
  2871. end;
  2872. procedure TDDTableCollection.SetTableName(const AValue: String);
  2873. begin
  2874. FTableName:=AValue;
  2875. end;
  2876. function TDDTableCollection.DataDictionary: TFPDataDictionary;
  2877. begin
  2878. If Assigned(FTableDef) then
  2879. Result:=FTableDef.DataDictionary
  2880. else
  2881. Result:=Nil;
  2882. end;
  2883. initialization
  2884. finalization
  2885. if assigned(DDEngines) then FreeAndNil(DDEngines);
  2886. end.