12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362 |
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 2007 by Michael Van Canneyt, member of the
- Free Pascal development team
- Data Dictionary Implementation.
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit fpdatadict;
- {$mode objfpc}{$H+}
- interface
- uses
- Classes, SysUtils,inicol, inifiles, contnrs, db, sqltypes;
- Type
- // Supported objects in this data dictionary
- TObjectType = (otUnknown,otDictionary,
- otTables,otTable,
- otFields,otField,
- otConnection,otTableData,
- otIndexDefs,otIndexDef,
- otSequenceDefs,otSequenceDef,
- otForeignKeyDefs,otForeignKeyDef,
- otDomainDefs,otDomainDef);
- TDDProgressEvent = Procedure(Sender : TObject; Const Msg : String) of Object;
- TFPDDFieldList = Class;
- TFPDDIndexList = Class;
- TDDTableDef = Class;
- TDDTableDefs = Class;
- TDDFieldDefs = Class;
- TDDDomainDef = Class;
- TFPDataDictionary = Class;
- { TDDFieldDef }
- TDDFieldDef = Class(TIniCollectionItem)
- private
- FAlignMent: TAlignMent;
- FConstraint: string;
- FConstraintErrorMessage: string;
- FCustomConstraint: string;
- FDefault: String;
- FDefaultExpression: string;
- FDisplayLabel: string;
- FDisplayWidth: Longint;
- FDomain: TDDDomainDef;
- FDomainName: string;
- FFieldName: string;
- FFieldType: TFieldType;
- FHint: String;
- FPrecision: Integer;
- FProviderFlags: TProviderFlags;
- FReadOnly: Boolean;
- FRequired: Boolean;
- FSize: Integer;
- FVisible: Boolean;
- function GetDomainName: string;
- Function IsSizeStored : Boolean;
- Function IsPrecisionStored : Boolean;
- procedure SetDomain(const AValue: TDDDomainDef);
- procedure SetDomainName(const AValue: string);
- protected
- function GetSectionName: String; override;
- procedure SetSectionName(const Value: String); override;
- function GetDisplayName: string; override;
- Public
- Constructor Create(ACollection : TCollection); override;
- Function FieldDefs : TDDFieldDefs;
- Function DataDictionary : TFPDataDictionary;
- // Will return True if the field or the domain it is based on is required
- Function FieldIsRequired : Boolean;
- Procedure ResolveDomain(ErrorOnFail : Boolean);
- Procedure ImportFromField(F: TField; Existing : Boolean = True);
- Procedure ApplyToField(F : TField);
- Procedure Assign(Source : TPersistent); override;
- Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
- Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
- Property Domain : TDDDomainDef Read FDomain Write SetDomain;
- Published
- property FieldType : TFieldType Read FFieldType Write FFieldType;
- property AlignMent : TAlignMent Read FAlignMent write FAlignment default taLeftJustify;
- property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
- property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
- Property DBDefault : String Read FDefault Write FDEfault;
- property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
- property DisplayLabel : string read FDisplayLabel write FDisplayLabel;
- property DisplayWidth: Longint read FDisplayWidth write FDisplayWidth;
- property FieldName: string read FFieldName write FFieldName;
- property DomainName: string read GetDomainName write SetDomainName;
- property Constraint: string read FConstraint write FConstraint;
- property ReadOnly: Boolean read FReadOnly write FReadOnly;
- property Required: Boolean read FRequired write FRequired;
- property Visible: Boolean read FVisible write FVisible default True;
- Property Size : Integer Read FSize Write FSize Stored IsSizeStored;
- Property Precision : Integer Read FPrecision Write FPrecision Stored IsPrecisionStored;
- Property Hint : String Read FHint Write FHint;
- Property ProviderFlags : TProviderFlags Read FProviderFlags Write FProviderFlags;
- end;
- TDDFieldDefClass = Class of TDDFieldDef;
- { TDDTableCollection }
- TDDTableCollection = Class(TIniCollection)
- private
- FTableDef : TDDTableDef;
- FTableName: String;
- function GetTableName: String;
- Protected
- Procedure SetTableDef(ATableDef : TDDTableDef);
- procedure SetTableName(const AValue: String); virtual;
- Public
- Function DataDictionary : TFPDataDictionary;
- Property TableDef : TDDTableDef Read FTableDef;
- Property TableName : String Read GetTableName Write SetTableName;
- end;
- { TDDFieldDefs }
- TDDFieldDefs = Class(TDDTableCollection)
- private
- function GetField(Index : Integer): TDDFieldDef;
- procedure SetField(Index : Integer; const AValue: TDDFieldDef);
- Protected
- procedure SetTableName(const AValue: String); override;
- Public
- Constructor Create(ATableDef : TDDTableDef);
- Constructor Create(const ATableName : string);
- Class Function FieldDefClass : TDDFieldDefClass; virtual;
- Property TableDef : TDDTableDef Read FTableDef;
- Property TableName : String Read GetTableName Write SetTableName;
- Function AddField(AFieldName: String = '') : TDDFieldDef;
- Function IndexOfField(const AFieldName : String) : Integer;
- Function FindField(const AFieldName : String) : TDDFieldDef;
- Function FieldByName(const AFieldName : String) : TDDFieldDef;
- Procedure FillFieldList(Const AFieldNames: String; List : TFPDDFieldList);
- Property Fields[Index : Integer] : TDDFieldDef Read GetField Write SetField; default;
- end;
-
- { TDDIndexDef }
- TDDIndexDef = Class(TIniCollectionItem)
- private
- FCaseinsFields: string;
- FDescFields: string;
- FExpression: string;
- FFields: string;
- FIndexName: String;
- FOptions: TIndexOptions;
- FSource: string;
- protected
- function GetSectionName: String; override;
- procedure SetSectionName(const Value: String); override;
- procedure Assign(ASource : TPersistent); override;
- Public
- Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
- Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
- Published
- Property IndexName : String Read FIndexName Write FIndexName;
- property Expression: string read FExpression write FExpression;
- property Fields: string read FFields write FFields;
- property CaseInsFields: string read FCaseinsFields write FCaseInsFields;
- property DescFields: string read FDescFields write FDescFields;
- property Options: TIndexOptions read FOptions write FOptions;
- property Source: string read FSource write FSource;
- end;
-
- { TDDIndexDefs }
- TDDIndexDefs = Class(TDDTableCollection)
- private
- function GetIndex(Index : Integer): TDDIndexDef;
- procedure SetIndex(Index : Integer; const AValue: TDDIndexDef);
- Protected
- procedure SetTableName(const AValue: String); override;
- Public
- Constructor Create(ATableDef : TDDTableDef);
- Constructor Create(const ATableName : String);
- Function AddDDIndexDef(AName : String) : TDDIndexDef;
- function AddIndex (const AName: String) : TDDIndexDef;
- function IndexByName(const AIndexName: String): TDDIndexDef;
- function FindIndex(const AIndexName: String): TDDIndexDef;
- function IndexOfIndex(const AIndexName: String): Integer;
- Property Indexes[Index : Integer] : TDDIndexDef Read GetIndex Write SetIndex; default;
- end;
-
- { TDDForeignKeyDef }
-
- TDDForeignKeyDef = Class(TIniCollectionItem)
- private
- FKeyFields: String;
- FKeyName: String;
- FReferencedFields: String;
- FTableName: String;
- procedure SetKeyName(const AValue: String);
- protected
- function GetSectionName: String; override;
- procedure SetSectionName(const Value: String); override;
- procedure Assign(ASource : TPersistent); override;
- Public
- Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
- Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
- Published
- Property KeyName : String Read FKeyName Write SetKeyName;
- Property ReferencesTable : String Read FTableName Write FTableName;
- Property KeyFields : String Read FKeyFields Write FKeyFields;
- Property ReferencedFields : String Read FReferencedFields Write FReferencedFields;
- end;
-
- { TDDForeignKeyDefs }
- TDDForeignKeyDefs = Class(TIniCollection)
- private
- FTableName: String;
- function GetKey(AIndex : Integer): TDDForeignKeyDef;
- procedure SetKey(AIndex : Integer; const AValue: TDDForeignKeyDef);
- procedure SetTableName(const AValue: String);
- Public
- Constructor Create(const ATableName : String);
- Function AddForeignKeyDef(const AName : String) : TDDForeignKeyDef;
- Property TableName : String Read FTableName Write SetTableName;
- Property Indexes[AIndex : Integer] : TDDForeignKeyDef Read GetKey Write SetKey; default;
- end;
- { TDDTableDef }
- TDDTableDef = Class(TIniCollectionItem)
- private
- FFieldDefs: TDDFieldDefs;
- FIndexDefs: TDDIndexDefs;
- FKeyDefs: TDDForeignKeyDefs;
- FPrimaryKeyName: String;
- FTableName: String;
- function GetOnProgress: TDDProgressEvent;
- function GetPrimaryKeyName: String;
- function GetPrimaryIndexDef : TDDIndexDef;
- procedure SetTableName(const AValue: String);
- protected
- function GetSectionName: String; override;
- procedure SetSectionName(const Value: String); override;
- Public
- Constructor Create(ACollection : TCollection); override;
- Destructor Destroy; override;
- Function DataDictionary : TFPDataDictionary;
- Function TableDefs : TDDTableDefs;
- Function ImportFromDataset(Dataset : TDataSet; DoClear : Boolean = False; UpdateExisting : Boolean = True) : Integer;
- Procedure ApplyToDataset(Dataset : TDataset);
- Function AddField(const AFieldName : String = '') : TDDFieldDef;
- Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
- Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
- procedure PrimaryIndexToFields;
- procedure FieldsToPrimaryIndex;
- Property Fields : TDDFieldDefs Read FFieldDefs;
- Property Indexes : TDDIndexDefs Read FIndexDefs;
- Property ForeignKeys : TDDForeignKeyDefs Read FKeyDefs;
- Property OnProgress : TDDProgressEvent Read GetOnProgress;
- Property PrimaryIndexDef : TDDIndexDef read GetPrimaryIndexDef;
- Published
- Property TableName : String Read FTableName Write SetTableName;
- Property PrimaryKeyConstraintName : String Read GetPrimaryKeyName Write FPrimaryKeyName;
- end;
-
- { TDDTableDefs }
- TDDTableDefs = Class(TIniCollection)
- private
- FDataDictionary: TFPDataDictionary;
- FOnProgress: TDDProgressEvent;
- function GetTable(Index : Integer): TDDTableDef;
- procedure SetTable(Index : Integer; const AValue: TDDTableDef);
- Public
- Property DataDictionary: TFPDataDictionary Read FDataDictionary;
- Function AddTable(aTableName : String = '') : TDDTableDef;
- Function IndexOfTable(const ATableName : String) : Integer;
- Function FindTable(const ATableName : String) : TDDTableDef;
- Function TableByName(const ATableName : String) : TDDTableDef;
- Property Tables[Index : Integer] : TDDTableDef Read GetTable Write SetTable; default;
- Property OnProgress : TDDProgressEvent Read FOnProgress Write FOnProgress;
- end;
- { TDDSequenceDef }
- TDDSequenceDef = Class(TIniCollectionItem)
- private
- FIncrement: Integer;
- FSequenceName: String;
- FStartValue: Integer;
- procedure SetSequenceName(const AValue: String);
- protected
- function GetSectionName: String; override;
- procedure SetSectionName(const Value: String); override;
- procedure Assign(ASource : TPersistent); override;
- Public
- Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
- Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
- Published
- Property SequenceName : String Read FSequenceName Write SetSequenceName;
- Property StartValue : Integer Read FStartValue Write FStartValue;
- Property Increment : Integer Read FIncrement Write FIncrement;
- end;
- { TDDSequenceDefs }
- TDDSequenceDefs = Class(TIniCollection)
- private
- FDataDictionary: TFPDataDictionary;
- FOnProgress: TDDProgressEvent;
- function GetSequence(Index : Integer): TDDSequenceDef;
- procedure SetSequence(Index : Integer; const AValue: TDDSequenceDef);
- Public
- Constructor Create;
- Function AddSequence(const ASequenceName : String = '') : TDDSequenceDef;
- Function IndexOfSequence(const ASequenceName : String) : Integer;
- Function FindSequence(const ASequenceName : String) : TDDSequenceDef;
- Function SequenceByName(const ASequenceName : String) : TDDSequenceDef;
- Property DataDictionary : TFPDataDictionary Read FDataDictionary;
- Property Sequences[Index : Integer] : TDDSequenceDef Read GetSequence Write SetSequence; default;
- Property OnProgress : TDDProgressEvent Read FOnProgress Write FOnProgress;
- end;
- { TDDDomainDef }
- TDDDomainDef = Class(TIniCollectionItem)
- procedure SetDomainName(const AValue: String);
- private
- FCheckConstraint: String;
- FDomainName: String;
- FFieldType: TFieldType;
- FPrecision: Integer;
- FRequired: Boolean;
- FSize: Integer;
- protected
- function GetSectionName: String; override;
- procedure SetSectionName(const Value: String); override;
- procedure Assign(ASource : TPersistent); override;
- Public
- Procedure SaveToIni(Ini: TCustomInifile; ASection : String); override;
- Procedure LoadFromIni(Ini: TCustomInifile; ASection : String); override;
- Published
- Property DomainName : String Read FDomainName Write SetDomainName;
- Property FieldType : TFieldType Read FFieldType Write FFieldType;
- property Size : Integer Read FSize Write FSize;
- property Precision : Integer Read FPrecision Write FPrecision;
- Property Required : Boolean Read FRequired Write FRequired;
- Property CheckConstraint : String Read FCheckConstraint Write FCheckConstraint;
- end;
- { TDDDomainDefs }
- TDDDomainDefs = Class(TIniCollection)
- private
- FDataDictionary: TFPDataDictionary;
- FOnProgress: TDDProgressEvent;
- function GetDomain(Index : Integer): TDDDomainDef;
- procedure SetDomain(Index : Integer; const AValue: TDDDomainDef);
- Public
- Constructor Create;
- Property DataDictionary : TFPDataDictionary Read FDataDictionary;
- Function AddDomain(const ADomainName : String = '') : TDDDomainDef;
- Function IndexOfDomain(const ADomainName : String) : Integer;
- Function FindDomain(const ADomainName : String) : TDDDomainDef;
- Function DomainByName(const ADomainName : String) : TDDDomainDef;
- Property Domains[Index : Integer] : TDDDomainDef Read GetDomain Write SetDomain; default;
- Property OnProgress : TDDProgressEvent Read FOnProgress Write FOnProgress;
- end;
- { TFPDataDictionary }
- TOnApplyDataDictEvent = Procedure (Sender : TObject; Source : TDDFieldDef; Dest : TField; Var Allow : Boolean) of object;
- TFPDataDictionary = Class(TPersistent)
- private
- FDDName: String;
- FDomains: TDDDomainDefs;
- FFileName: String;
- FOnApplyDataDictEvent: TOnApplyDataDictEvent;
- FOnProgress: TDDProgressEvent;
- FSequences: TDDSequenceDefs;
- FTables: TDDTableDefs;
- // Last table that returned a match for findfieldDef
- FLastMatchTableDef : TDDTableDef;
- procedure SetOnProgress(const AValue: TDDProgressEvent);
- Public
- Constructor Create;
- Destructor Destroy; override;
- Procedure SaveToFile(const AFileName : String; KeepBackup: Boolean = True);
- Procedure SaveToIni(Ini : TCustomIniFile; ASection : String); virtual;
- Procedure LoadFromFile(const AFileName : String);
- Procedure LoadFromIni(Ini : TCustomIniFile; ASection : String); virtual;
- Procedure ApplyToDataset(ADataset : TDataset);
- Procedure ApplyToDataset(ADataset : TDataset; OnApply : TOnApplyDataDictEvent);
- Function FindFieldDef(const FieldName : String; out TableName : String) : TDDFieldDef;
- Function FindFieldDef(const FieldName : String) : TDDFieldDef;
- function CanonicalizeFieldName(const InFN: String; Out TN, FN: String): Boolean;
- function CanonicalizeFieldName(const InFN: String; Out TableDef : TDDTableDef; Out FN: String): Boolean;
- Property Tables : TDDTableDefs Read FTables;
- Property Sequences : TDDSequenceDefs Read FSequences;
- Property Domains : TDDDomainDefs Read FDomains;
- Property FileName : String Read FFileName;
- Property Name : String Read FDDName Write FDDName;
- Property OnProgress : TDDProgressEvent Read FOnProgress Write SetOnProgress;
- Published
- // Using name confuses the object inspector grid.
- Property DataDictionaryName : String Read FDDName Write FDDName;
- Property OnApplyDataDictEvent : TOnApplyDataDictEvent Read FOnApplyDataDictEvent Write FOnApplyDataDictEvent;
- end;
- { TFPDDFieldList }
- TFPDDFieldList = Class(TObjectList)
- private
- function GetFieldDef(Index : Integer): TDDFieldDef;
- procedure SetFieldDef(Index : Integer; const AValue: TDDFieldDef);
- Public
- Constructor CreateFromTableDef(TD : TDDTableDef);
- Constructor CreateFromFieldDefs(FD : TDDFieldDefs);
- Property FieldDefs[Index : Integer] : TDDFieldDef Read GetFieldDef Write SetFieldDef; default;
- end;
-
- { TFPDDIndexList }
- TFPDDIndexList = Class(TObjectList)
- private
- function GetIndexDef(AIndex : Integer): TDDIndexDef;
- procedure SetIndexDef(AIndex : Integer; const AValue: TDDIndexDef);
- Public
- Constructor CreateFromIndexDefs(FD : TDDIndexDefs);
- Property IndexDefs[AIndex : Integer] : TDDIndexDef Read GetIndexDef Write SetIndexDef; default;
- end;
-
- { TFPDDSequenceList }
- TFPDDSequenceList = Class(TObjectList)
- private
- function GetSequenceDef(AIndex : Integer): TDDSequenceDef;
- procedure SetSequenceDef(AIndex : Integer; const AValue: TDDSequenceDef);
- Public
- Constructor CreateFromSequenceDefs(SD : TDDSequenceDefs);
- Property SequenceDefs[AIndex : Integer] : TDDSequenceDef Read GetSequenceDef Write SetSequenceDef; default;
- end;
- { TFPDDDomainList }
- TFPDDDomainList = Class(TObjectList)
- private
- function GetDomainDef(AIndex : Integer): TDDDomainDef;
- procedure SetDomainDef(AIndex : Integer; const AValue: TDDDomainDef);
- Public
- Constructor CreateFromDomainDefs(DD : TDDDomainDefs);
- Property DomainDefs[AIndex : Integer] : TDDDomainDef Read GetDomainDef Write SetDomainDef; default;
- end;
- { TFPDDSQLEngine }
- TSQLEngineOption = (eoLineFeedAfterField,eoUseOldInWhereParams,eoAndTermsInBrackets,
- eoQuoteFieldNames,eoLineFeedAfterAndTerm,eoAddTerminator,
- eoSkipForeignkeys);
- TSQLEngineOptions = Set of TSQLEngineOption;
-
- TFPDDSQLEngine = Class(TPersistent)
- private
- FFieldQuoteChar: Char;
- FIndent: Integer;
- FMaxLineLength: Integer;
- FLastLength: integer;
- FOptions: TSQLEngineOptions;
- FTableDef: TDDTableDef;
- FNoIndent : Boolean;
- FTerminatorChar : Char;
- Protected
- procedure CheckTableDef;
- Procedure NoIndent;
- Procedure ResetLine;
- Procedure AddToStringLN(Var Res : String; const S : String);
- Procedure AddToString(Var Res : String; S : String);
- Procedure FixUpStatement(var Res : String; ForceTerminator : Boolean = False);
- Procedure FixUpStatement(SQL : TStrings; ForceTerminator : Boolean = False);
- Procedure AddWhereClause(Var Res : String; FieldList: TFPDDFieldList; UseOldParam:Boolean);
- Function CreateAndTerm(FD : TDDFieldDef; UseOldParam : Boolean): string;
- // Primitives. Override for engine-specifics
- Procedure AddFieldString(Var Res: String;const S : String);
- Function FieldNameString(FD : TDDFieldDef) : string; virtual;
- Function TableNameString(TD : TDDTableDef) : string; virtual;
- Function FieldParamString(FD : TDDFieldDef; UseOldParam : Boolean) : string; virtual;
- Function FieldTypeString(ft : TFieldType; ASize,APrecision : Integer) : String; virtual;
- Function FieldTypeString(FD : TDDFieldDef) : String;
- Function FieldDefaultString(FD : TDDFieldDef) : String; virtual;
- Function FieldCheckString(FD : TDDFieldDef) : String; virtual;
- Function FieldDeclarationString(FD : TDDFieldDef) : String; virtual;
- Property FieldQuoteChar : Char Read FFieldQuoteChar Write FFieldQuoteChar;
- Property TerminatorChar : Char Read FTerminatorChar Write FTerminatorChar;
- Public
- Constructor Create; virtual;
- function CreateWhereSQL(Var Res : String; FieldList: TFPDDFieldList; UseOldParam:Boolean): String;
- // Methods that fill a stringlist
- Procedure CreateSelectSQLStrings(FieldList,KeyFields : TFPDDFieldList; SQL : TStrings);
- Procedure CreateInsertSQLStrings(FieldList : TFPDDFieldList; SQL : TStrings);
- Procedure CreateUpdateSQLStrings(FieldList,KeyFields : TFPDDFieldList; SQL : TStrings);
- Procedure CreateDeleteSQLStrings(KeyFields : TFPDDFieldList; SQL : TStrings);
- Procedure CreateCreateSQLStrings(Fields,KeyFields : TFPDDFieldList; SQL : TStrings);
- Procedure CreateCreateSQLStrings(KeyFields : TFPDDFieldList; SQL : TStrings);
- Procedure CreateIndexesSQLStrings(Indexes : TFPDDIndexList; SQL : TStrings);
- Procedure CreateForeignKeysSQLStrings(ForeignKeys: TDDForeignKeyDefs; SQL : TStrings);
- Procedure CreateSequencesSQLStrings(Sequences : TFPDDSequenceList; SQL : TStrings);
- Procedure CreateDomainsSQLStrings(Domains : TFPDDDomainList; SQL : TStrings);
- // Insert/Update/Delete statements.
- Function CreateSelectSQL(FieldList,KeyFields : TFPDDFieldList) : String; virtual;
- Function CreateInsertSQL(FieldList : TFPDDFieldList) : String; virtual;
- Function CreateUpdateSQL(FieldList,KeyFields : TFPDDFieldList) : String; virtual;
- Function CreateDeleteSQL(KeyFields : TFPDDFieldList) : String; virtual;
- // CREATE TABLE statement
- Function CreateCreateSQL(Fields,KeyFields : TFPDDFieldList) : String; virtual;
- Function CreateCreateSQL(KeyFields : TFPDDFieldList) : String; virtual;
- // CREATE INDEX
- Function CreateIndexSQL(Index : TDDIndexDef) : String; virtual;
- Function CreateIndexesSQL(Indexes : TFPDDIndexList) : String;
- Function CreateIndexesSQL(Indexes : TDDIndexDefs) : String;
- // CONSTRAINT: Foreign keys
- Function CreateForeignKeySQL(ForeignKey: TDDForeignKeyDef) : String;virtual;
- Function CreateForeignKeysSQL(ForeignKeys: TDDForeignKeyDefs) : String;
- // CREATE SEQUENCE
- Function CreateSequenceSQL(Sequence : TDDSequenceDef) : String; virtual;
- Function CreateSequencesSQL(Sequences : TFPDDSequenceList) : String;
- Function CreateSequencesSQL(Sequences : TDDSequenceDefs) : String;
- // CREATE DOMAIN
- Function CreateDomainSQL(Domain : TDDDomainDef) : String; virtual;
- Function CreateDomainsSQL(Domains : TFPDDDomainList) : String;
- Function CreateDomainsSQL(Domains : TDDDomainDefs) : String;
- // Convenience calls
- Function CreateTableSQL : String;
- Procedure CreateTableSQLStrings(SQL : TStrings);
- Property TableDef : TDDTableDef Read FTableDef Write FTableDef;
- Published
- Property MaxLineLength : Integer Read FMaxLineLength Write FMaxLineLength default 72;
- Property Indent : Integer Read FIndent Write FIndent default 2;
- Property Options : TSQLEngineOptions Read FOptions Write FOptions;
- end;
-
- { TFPDDEngine }
- TFPDDEngineCapability =(ecImport,ecCreateTable,ecViewTable, ecTableIndexes,
- ecRunQuery, ecRowsAffected, ecSequences, ecDomains);
- TFPDDEngineCapabilities = set of TFPDDEngineCapability;
- {
- to avoid dependencies on GUI elements in the data dictionary engines,
- connection string dialogs must be registered separately.
- TGetConnectionEvent is the callback prototype for such a dialog
- }
- TGetConnectionEvent = Procedure(Sender: TObject; Var Connection : String) of object;
- TFPDDEngine = Class(TComponent)
- private
- FOnProgress: TDDProgressEvent;
- Protected
- FConnected: Boolean;
- FConnectString: String;
- Procedure DoProgress(Const Msg : String);
- // Utility routine which can be used by descendents.
- procedure IndexDefsToDDIndexDefs(IDS : TIndexDefs; DDIDS : TDDindexDefs);
- Public
- Destructor Destroy; override;
- Function GetConnectString : String; virtual;
- // Mandatory for all data dictionary engines.
- Class function Description : string; virtual; abstract;
- Class function DBType : String; virtual; abstract;
- Class function EngineCapabilities : TFPDDEngineCapabilities; virtual;
- Function Connect(const ConnectString : String) : Boolean; virtual; abstract;
- Procedure Disconnect ; virtual; abstract;
- procedure ImportDatadict (Adatadict: TFPDataDictionary; UpdateExisting : Boolean);
- Function GetTableList(List : TStrings) : Integer; virtual; abstract;
- Function GetObjectList(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual; abstract;
- Function ImportTables(Tables : TDDTableDefs; List : TStrings; UpdateExisting : Boolean) : Integer;
- Function ImportFields(Table : TDDTableDef) : Integer; virtual; abstract;
- Function ImportIndexes(Table : TDDTableDef) : Integer; virtual; abstract;
- function GetDomainList(List: TSTrings) : integer; virtual;
- Function ImportDomains(Domains : TDDDomainDefs; List : TStrings; UpdateExisting : boolean) : Integer; virtual;
- function GetSequenceList (List:TStrings): integer; virtual;
- Function ImportSequences(Sequences : TDDSequenceDefs; List : TStrings; UpdateExisting : boolean) : Integer; virtual;
- // Override depending on capabilities
- Procedure CreateTable(Table : TDDTableDef); virtual;
- // Should not open the dataset.
- Function ViewTable(Const TableName: String; DatasetOwner : TComponent) : TDataset; virtual;
- // Run a non-select query. If possible, returns the number of modified records.
- Function RunQuery(SQL : String) : Integer; Virtual;
- // Create a select query TDataset. Do not open the resulting dataset.
- Function CreateQuery(SQL : String; DatasetOwner : TComponent) : TDataset; Virtual;
- // Assign a select query and open the resulting dataset.
- Procedure SetQueryStatement(SQL : String; AQuery : TDataset); Virtual;
- // Get table index defs. Return number of defs (if ecTableIndexes in capabilities)
- Function GetTableIndexDefs(ATableName : String; Defs : TDDIndexDefs) : integer ;virtual;
- // Override if a better implementation exists.
- Function CreateSQLEngine : TFPDDSQLEngine; virtual;
- Property OnProgress : TDDProgressEvent Read FOnProgress Write FOnProgress;
- Property ConnectString : String Read FConnectString;
- Property Connected : Boolean Read FConnected Write FConnected;
- end;
- TFPDDEngineClass = Class of TFPDDEngine;
- EDataDict = Class(Exception);
- Procedure RegisterDictionaryEngine(AEngine :TFPDDEngineClass);
- Function IsDictionaryEngineRegistered(AEngine :TFPDDEngineClass) : boolean;
- Procedure RegisterConnectionStringCallback(Const AName: String; CallBack : TGetConnectionEvent);
- Procedure UnRegisterDictionaryEngine(AEngine :TFPDDEngineClass);
- Function GetDictionaryEngineList(List : TStrings) : Integer;
- Function GetDictionaryEngineInfo(Const AName : String; out ADescription,ADBType: String; out ACapabilities : TFPDDEngineCapabilities) : boolean;
- Function CreateDictionaryEngine(const AName : String; AOWner : TComponent) : TFPDDEngine;
- Function IndexOptionsToString (Options : TIndexOptions) : String;
- Var
- DefaultDDExt : String = '.fpd';
-
- // Default values for SQL Engine properties.
-
- DefaultSQLEngineOptions : TSQLEngineOptions
- = [eoLineFeedAfterField,eoUseOldInWhereParams,
- eoAndTermsInBrackets,eoLineFeedAfterAndTerm];
-
- DefaultSQLEngineIndent : Integer = 2;
- DefaultSQLEngineLineLength : Integer = 72;
- DefaultSQLTerminatorChar : Char = ';';
- DefaultSQLFieldQuoteChar : Char = '"';
-
- implementation
- uses typinfo;
- { ---------------------------------------------------------------------
- Constants, not to be localized
- ---------------------------------------------------------------------}
- Const
- // Datadict saving
- SDataDict = 'FPDataDict';
- KeyDataDictName = 'DataDictName';
- // Tables Saving
- SDataDictTables = SDataDict+'_Tables';
- KeyTableName = 'TableName';
- KeyPrimaryKeyConstraint = 'PrimaryKeyConstraint';
-
- // Fields Saving
- SFieldSuffix = '_Fields';
- KeyAlignMent = 'AlignMent';
- KeyCustomConstraint = 'CustomConstraint';
- KeyConstraintErrorMessage = 'ConstraintErrorMessage';
- KeyDBDefault = 'DBDefault';
- KeyDefaultExpression = 'DefaultExpression';
- KeyDisplayLabel = 'DisplayLabel';
- KeyDisplayWidth = 'DisplayWidth';
- KeyFieldName = 'FieldName';
- KeyDomainName = 'DomainName';
- KeyConstraint = 'Constraint';
- KeyReadOnly = 'ReadOnly';
- KeyRequired = 'Required';
- KeyVisible = 'Visible';
- KeySize = 'Size';
- KeyPrecision = 'Precision';
- KeyFieldType = 'FieldType';
- KeyHint = 'Hint';
- KeyProviderFlags = 'Providerflags';
-
- // Index saving
- SIndexSuffix = '_Indices';
- KeyExpression = 'Expression';
- KeyFields = 'Fields';
- KeyCaseInsFields = 'CaseInsFields';
- KeyDescFields = 'DescFields';
- KeySource = 'Source';
- KeyOptions = 'Options';
-
- // Foreign key Saving
- SKeySuffix = '_FOREIGNKEYS';
- KeyKeyFields = 'KeyFields';
- KeyKeyName = 'KeyName';
- KeyReferencesTable = 'ReferencesTable';
- KeyReferencedFields = 'ReferencedFields';
- // Sequence saving
- SDatadictSequences = SDataDict+'_Sequences';
- KeyStartValue = 'StartValue';
- KeyIncrement = 'Increment';
- // Domain saving
- SDataDictDomains = SDataDict+'_Domains';
- KeyCheckConstraint = 'Constraint';
- // SQL Keywords
- SSelect = 'SELECT';
- SFrom = 'FROM';
- SWhere = 'WHERE';
- SInsertInto = 'INSERT INTO';
- SUpdate = 'UPDATE';
- SSet = 'SET';
- SDeleteFrom = 'DELETE FROM';
- SAnd = 'AND';
- SOLD = 'OLD';
- SValues = 'VALUES';
- SCreateTable = 'CREATE TABLE';
- SNotNull = 'NOT NULL';
- SDefault = 'DEFAULT';
- SCheck = 'CHECK'; // Check constraint
- SPrimaryKey = 'PRIMARY KEY';
- SConstraint = 'CONSTRAINT';
- SQLFieldTypes : Array[TFieldType] of string = (
- '', 'VARCHAR', 'SMALLINT', 'INT', 'SMALLINT',
- 'BOOL', 'FLOAT', 'DECIMAL','DECIMAL','DATE', 'TIME', 'TIMESTAMP',
- '', '', 'INT', 'BLOB', 'BLOB', 'BLOB', 'BLOB',
- '', '', '', '', 'CHAR',
- 'CHAR', 'BIGINT', '', '', '',
- '', '', '', '', '',
- '', '', 'TIMESTAMP', 'DECIMAL','CHAR','BLOB',
- '', '', '', '', '', '','FLOAT');
-
- { ---------------------------------------------------------------------
- Constants which can be localized
- ---------------------------------------------------------------------}
- Resourcestring
- SErrFieldNotFound = '"%s": Field "%s" not found.';
- SErrIndexNotFound = '"%s": Index "%s" not found.';
- SErrTableNotFound = 'Table "%s" not found.';
- SErrDuplicateTableName = 'Duplicate table name: "%s"';
- SErrDuplicateFieldName = '"%s": Duplicate field name: "%s"';
- SNewTable = 'NewTable';
- SNewField = 'NewField';
- SErrNoFileName = 'No filename given for save';
- SErrNotRegistering = 'Not registering data dictionary engine "%s": %s';
- SErrNoEngineCapabilities = 'It reports no capabilities.';
- SErrNoEngineDBType = 'It reports no database type';
- SErrNoEngineDescription = 'It reports no description';
- SErrUnknownEngine = 'Unknown datadictionary: "%s"';
- SErrMissingTableDef = 'Cannot perform this operation without tabledef.';
- SErrFieldTypeNotSupported = 'Field type "%s" is not supported in this SQL dialect';
- SErrNoConnectionDialog = 'No connection dialog registered for data dictionary engine "%s".';
- SDDImportingTable = 'Importing table definition for table "%s"';
- SErrCreateTableNotSupported = 'Creating tables is not supported by the "%s" engine.';
- SErrViewTableNotSupported = 'Viewing tables is not supported by the "%s" engine.';
- SErrRunQueryNotSupported = 'Running queries is not supported by the "%s" engine.';
- SErrOpenQueryNotSupported = 'Running and opening SELECT queries is not supported by the "%s" engine.';
- SErrSetQueryStatementNotSupported = 'Setting the SQL statement is not supported by the "%s" engine.';
- SErrGetTableIndexDefsNotSupported = 'Getting index definitions of a table is not supported by the "%s" engine.';
- SSavingFieldsFrom = 'Saving fields from %s';
- SLoadingFieldsFrom = 'Loading fields from %s';
- SWarnFieldNotFound = 'Could not find field "%s".';
- SLogFieldFoundIn = 'Field "%s" found in table "%s".';
- SErrSequenceNotFound = 'Sequence "%s" not found.';
- SErrDuplicateSequence = 'Duplicate sequence name: "%s"';
- SErrDuplicateDomain = 'Duplicate domain name: "%s"';
- SErrDomainNotFound = 'Domain "%s" not found.';
- SErrNoDataDict = '%s : No data dictionary available';
- SErrResolveDomain = 'Cannot resolve domain';
-
- Const
- SIndexOptionPrimary = 'Primary key';
- SIndexOptionUnique = 'Unique';
- SIndexOptionDescending = 'Descending';
- SIndexOptionCaseInsensitive = 'Case insensitive';
- SIndexOptionExpression = 'Expression';
- SIndexOptionNonMaintained = 'Not maintained';
- Const
- IndexOptionNames : Array [TIndexOption] of String
- = (SIndexOptionPrimary, SIndexOptionUnique,
- SIndexOptionDescending, SIndexOptionCaseInsensitive,
- SIndexOptionExpression, SIndexOptionNonMaintained);
-
- { ---------------------------------------------------------------------
- Dictionary Engine registration
- ---------------------------------------------------------------------}
- Var
- DDEngines : TStringList = nil;
-
- Type
- { TEngineRegistration }
- TEngineRegistration = Class(TObject)
- Private
- FEngine : TFPDDEngineClass;
- FCallBack : TGetConnectionEvent;
- Public
- Constructor Create(AEngine : TFPDDEngineClass);
- end;
- { TEngineRegistration }
- constructor TEngineRegistration.Create(AEngine: TFPDDEngineClass);
- begin
- FEngine:=AEngine;
- end;
- procedure RegisterDictionaryEngine(AEngine: TFPDDEngineClass);
- begin
- If (AEngine.EngineCapabilities=[]) then
- Raise EDataDict.CreateFmt(SErrNotRegistering,[AEngine.ClassName,SErrNoEngineCapabilities]);
- If (AEngine.DBType='') then
- Raise EDataDict.CreateFmt(SErrNotRegistering,[AEngine.ClassName,SErrNoEngineDBType]);
- If (AEngine.Description='') then
- Raise EDataDict.CreateFmt(SErrNotRegistering,[AEngine.ClassName,SErrNoEngineDescription]);
- If not assigned(DDEngines) then
- begin
- DDEngines:=TStringList.Create;
- DDEngines.Sorted:=true;
- DDEngines.Duplicates:=dupError;
- end;
- DDEngines.AddObject(Aengine.ClassName,TEngineRegistration.Create(AEngine));
- end;
- procedure UnRegisterDictionaryEngine(AEngine: TFPDDEngineClass);
- Var
- I : Integer;
-
- begin
- If Assigned(DDEngines) then
- begin
- I:=DDEngines.IndexOf(Aengine.ClassName);
- If (i<>-1) then
- begin
- DDEngines.Objects[i].Free;
- DDEngines.Delete(i);
- end;
- if (DDEngines.Count=0) then
- FreeAndNil(DDEngines);
- end;
- end;
- function GetDictionaryEngineList(List: TStrings): Integer;
- begin
- If Not Assigned(DDEngines) then
- Result:=0
- else
- begin
- If Assigned(List) then
- List.Text:=DDEngines.Text;
- Result:=DDEngines.Count;
- end;
- end;
- Function IndexOfDDEngine(Const AName: String) : Integer;
- begin
- If Assigned(DDEngines) then
- Result:=DDEngines.IndexOf(AName)
- else
- Result:=-1;
- end;
- Function FindEngineRegistration(Const AName : String) : TEngineRegistration;
- Var
- I : integer;
- begin
- I:=IndexOfDDEngine(AName);
- if (I<>-1) then
- Result:=TEngineRegistration(DDEngines.Objects[i])
- else
- Result:=Nil;
- end;
- Function GetEngineRegistration(Const AName : String) : TEngineRegistration;
- begin
- Result:=FindEngineRegistration(AName);
- If (Result=Nil) then
- Raise EDataDict.CreateFmt(SErrUnknownEngine,[AName]);
- end;
- Function FindDictionaryClass(Const AName : String) : TFPDDEngineClass;
- Var
- R : TEngineRegistration;
- begin
- R:=FindEngineRegistration(AName);
- If (R=Nil) then
- Result:=Nil
- else
- Result:=R.FEngine;
- end;
- Function GetDictionaryClass(Const AName : String) : TFPDDEngineClass;
- begin
- Result:=GetEngineRegistration(AName).FEngine;
- end;
- function IsDictionaryEngineRegistered(AEngine: TFPDDEngineClass): boolean;
- Var
- I : Integer;
- begin
- Result:=Assigned(DDEngines);
- If Result then
- begin
- Result:=False;
- I:=0;
- While (Not Result) and (I<DDEngines.Count) do
- begin
- Result:=(TEngineRegistration(DDEngines.Objects[i]).FEngine=AEngine);
- inc(I);
- end;
- end;
- end;
- procedure RegisterConnectionStringCallback(Const AName : String;
- CallBack: TGetConnectionEvent);
- begin
- GetEngineRegistration(AName).FCallBack:=CallBack;
- end;
- function GetEngineConnectionStringCallBack(Const AName : String) : TGetConnectionEvent;
- begin
- Result:=GetEngineRegistration(AName).FCallBack;
- end;
- Function GetDictionaryEngineInfo(Const AName : String; out ADescription,ADBType: String;out ACapabilities : TFPDDEngineCapabilities) : boolean;
- Var
- DDEC : TFPDDEngineClass;
-
- begin
- DDEC:=FindDictionaryClass(AName);
- Result:=DDEC<>Nil;
- If Result then
- begin
- ADescription:=DDEC.Description;
- ADBType:=DDEC.DBType;
- ACapabilities:=DDEC.EngineCapabilities;
- end;
- end;
- function CreateDictionaryEngine(const AName: String; AOWner : TComponent): TFPDDEngine;
- begin
- Result:=GetDictionaryClass(AName).Create(AOwner);
- end;
- function IndexOptionsToString(Options: TIndexOptions): String;
- Var
- IO : TIndexOption;
- begin
- Result:='';
- For IO:=Low(TIndexOption) to High(TIndexOption) do
- If IO in Options then
- begin
- If (Result<>'') then
- Result:=Result+',';
- Result:=Result+IndexOptionNames[IO];
- end;
- end;
- { ---------------------------------------------------------------------
- TDDFieldDef
- ---------------------------------------------------------------------}
-
- function TDDFieldDef.IsSizeStored: Boolean;
- begin
- Result:=FieldType in [ftUnknown, ftString, ftBCD,
- ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
- ftParadoxOle, ftDBaseOle, ftTypedBinary, ftFixedChar,
- ftWideString,ftArray, ftOraBlob, ftOraClob, ftFMTBcd];
- end;
- function TDDFieldDef.GetDomainName: string;
- begin
- If Assigned(FDomain) then
- Result:=FDomain.DomainName
- else // Not resolved yet
- Result:=FDomainName;
- end;
- function TDDFieldDef.IsPrecisionStored: Boolean;
- begin
- Result:=FieldType in [ftFloat,ftBCD,ftFMTBCD];
- end;
- procedure TDDFieldDef.SetDomain(const AValue: TDDDomainDef);
- begin
- if FDomain=AValue then exit;
- FDomain:=AValue;
- If Assigned(FDomain) then
- FDomainName:=FDomain.DomainName;
- end;
- procedure TDDFieldDef.SetDomainName(const AValue: string);
- begin
- FDomainName:=AValue;
- If (AValue<>'') then
- ResolveDomain(False);
- end;
- function TDDFieldDef.GetSectionName: String;
- begin
- Result:=FFieldName;
- end;
- procedure TDDFieldDef.SetSectionName(const Value: String);
- begin
- FFieldName:=Value;
- end;
- function TDDFieldDef.GetDisplayName: string;
- begin
- If (FieldName<>'') then
- Result:=FieldName
- else
- Result:=inherited GetDisplayName;
- end;
- constructor TDDFieldDef.Create(ACollection: TCollection);
- begin
- Inherited;
- FVisible:=True;
- FAlignMent:=taLeftJustify;
- end;
- function TDDFieldDef.FieldDefs: TDDFieldDefs;
- begin
- Result:=(Collection as TDDFieldDefs)
- end;
- function TDDFieldDef.DataDictionary: TFPDataDictionary;
- begin
- If Assigned(FieldDefs) then
- Result:=FieldDefs.DataDictionary
- else
- Result:=Nil;
- end;
- function TDDFieldDef.FieldIsRequired: Boolean;
- begin
- Result:=Required;
- If (Not Result) and (DomainName<>'') then
- begin
- ResolveDomain(True);
- Result:=Domain.Required;
- end;
- end;
- procedure TDDFieldDef.ResolveDomain(ErrorOnFail : Boolean);
- Var
- DD : TFPDataDictionary;
- begin
- If (FDomainName<>'') then
- Exit;
- DD:=DataDictionary;
- If Not Assigned(DD) then
- begin
- If ErrorOnFail then
- Raise EDataDict.CreateFmt(SErrNoDataDict,[SErrResolveDomain]);
- end
- else if (Not Assigned(FDomain)) or (CompareText(FDomain.DomainName,FDomainName)<>0) then
- begin
- If ErrorOnFail then
- FDomain:=DD.Domains.DomainByName(FDomainName)
- else
- FDomain:=DD.Domains.FindDomain(FDomainName);
- end;
- end;
- procedure TDDFieldDef.ImportFromField(F: TField; Existing : Boolean = True);
- begin
- FieldName:=F.FieldName;
- FieldType:=F.DataType;
- If IsSizeStored then
- Size:=F.Size;
- If IsPrecisionStored then
- begin
- If F is TBCDFIeld then
- Precision:=TBCDField(F).Precision
- else if F is TFloatField then
- Precision:=TFloatField(F).Precision;
- end;
- if not Existing then
- begin
- AlignMent:=F.AlignMent;
- DisplayWidth:=F.DisplayWidth;
- CustomConstraint:=F.CustomConstraint;
- ConstraintErrorMessage:=F.ConstraintErrorMessage;
- DefaultExpression:=F.DefaultExpression;
- DisplayLabel:=F.DisplayLabel;
- ReadOnly:=F.ReadOnly;
- Required:=F.Required;
- Visible:=F.Visible;
- ProviderFlags:=F.ProviderFlags;
- end;
- end;
- procedure TDDFieldDef.ApplyToField(F: TField);
- begin
- { // Normally, these should never be assigned...
- F.FieldName := FieldName;
- F.DataType := FieldType;
- If IsSizeStored then
- F.Size:=Size;
- }
- F.AlignMent := AlignMent;
- F.DisplayWidth := DisplayWidth;
- F.CustomConstraint := CustomConstraint;
- F.ConstraintErrorMessage := ConstraintErrorMessage;
- F.DefaultExpression := DefaultExpression;
- F.DisplayLabel := DisplayLabel;
- F.ReadOnly := ReadOnly;
- F.Required := Required;
- F.Visible := Visible;
- F.ProviderFlags := ProviderFlags;
- end;
- procedure TDDFieldDef.Assign(Source: TPersistent);
- Var
- DF : TDDFieldDef;
-
- begin
- if Source is TField then
- ImportFromField(TField(Source))
- else If Source is TDDFieldDef then
- begin
- DF:=TDDFieldDef(Source);
- FieldType:=DF.FieldType;
- If IsSizeStored then
- Size:=DF.Size;
- AlignMent:=DF.AlignMent;
- DisplayWidth:=DF.DisplayWidth;
- CustomConstraint:=DF.CustomConstraint;
- ConstraintErrorMessage:=DF.ConstraintErrorMessage;
- DefaultExpression:=DF.DefaultExpression;
- DBDefault:=DF.DBDefault;
- DisplayLabel:=DisplayLabel;
- FieldName:=DF.FieldName;
- DomainName:=DF.DomainName;
- Constraint:=DF.Constraint;
- Hint:=DF.Hint;
- ReadOnly:=DF.ReadOnly;
- Required:=DF.Required;
- Visible:=DF.Visible;
- ProviderFlags:=DF.ProviderFlags;
- end
- else
- Inherited;
- end;
- procedure TDDFieldDef.SaveToIni(Ini: TCustomInifile; ASection: String);
- Var
- T : PTypeInfo;
- O : Integer;
- begin
- With Ini do
- begin
- WriteInteger(ASection,KeyFieldType,Ord(Fieldtype));
- If IsSizeStored then
- WriteInteger(ASection,KeySize,Size);
- If IsPrecisionStored then
- WriteInteger(ASection,KeyPrecision,Precision);
- WriteInteger(ASection,KeyAlignMent,Ord(AlignMent));
- WriteInteger(ASection,KeyDisplayWidth,DisplayWidth);
- WriteString(ASection,KeyCustomConstraint,CustomConstraint);
- WriteString(ASection,KeyConstraintErrorMessage,ConstraintErrorMessage);
- WriteString(ASection,KeyDefaultExpression,DefaultExpression);
- WriteString(ASection,KeyDBDefault,DBDefault);
- WriteString(ASection,KeyDisplayLabel,DisplayLabel);
- WriteString(ASection,KeyFieldName,FieldName);
- WriteString(ASection,KeyDomainName,DomainName);
- WriteString(ASection,KeyConstraint,Constraint);
- WriteString(ASection,KeyHint,Hint);
- O:=Integer(ProviderFlags);
- T:=TypeInfo(TProviderFlags);
- WriteString(ASection,KeyProviderFlags,SetToString(T,O,False));
- WriteBool(ASection,KeyReadOnly,ReadOnly);
- WriteBool(ASection,KeyRequired,Required);
- WriteBool(ASection,KeyVisible,Visible);
- end;
- end;
- procedure TDDFieldDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
- Var
- T : PTypeInfo;
- O : Integer;
- PF : TProviderFlags;
- S : String;
- begin
- With Ini do
- begin
- FieldType:=TFieldType(ReadInteger(ASection,KeyFieldType,Ord(Fieldtype)));
- If IsSizeStored then
- Size:=ReadInteger(ASection,KeySize,0);
- If IsPrecisionStored then
- Precision:=ReadInteger(ASection,KeyPrecision,0);
- Alignment:=TAlignment(ReadInteger(ASection,KeyAlignMent,Ord(AlignMent)));
- DisplayWidth:=ReadInteger(ASection,KeyDisplayWidth,DisplayWidth);
- CustomConstraint:=ReadString(ASection,KeyCustomConstraint,CustomConstraint);
- ConstraintErrorMessage:=ReadString(ASection,KeyConstraintErrorMessage,ConstraintErrorMessage);
- DefaultExpression:=ReadString(ASection,KeyDefaultExpression,DefaultExpression);
- DBDefault:=ReadString(ASection,KeyDBDefault,DBDefault);
- DisplayLabel:=ReadString(ASection,KeyDisplayLabel,DisplayLabel);
- FieldName:=ReadString(ASection,KeyFieldName,FieldName);
- DomainName:=ReadString(ASection,KeyDomainName,DomainName);
- Constraint:=ReadString(ASection,KeyConstraint,Constraint);
- Hint:=ReadString(ASection,KeyHint,Hint);
- S:=ReadString(ASection,KeyProviderFlags,'');
- T:=TypeInfo(TProviderFlags);
- O:=StringToSet(T,S);
- Integer(PF):=O;
- ProviderFlags:=PF;
- ReadOnly:=ReadBool(ASection,KeyReadOnly,ReadOnly);
- Required:=ReadBool(ASection,KeyRequired,Required);
- Visible:=ReadBool(ASection,KeyVisible,Visible);
- end;
- end;
- { ---------------------------------------------------------------------
- TDDFieldDefs
- ---------------------------------------------------------------------}
- procedure TDDFieldDefs.SetTableName(const AValue: String);
- begin
- Inherited;
- FSectionPrefix:=AValue;
- GlobalSection:=AValue+SFieldSuffix;
- end;
- constructor TDDFieldDefs.Create(ATableDef: TDDTableDef);
- begin
- Inherited Create(FieldDefClass);
- FPrefix:='Field';
- SetTableDef(ATableDef);
- end;
- constructor TDDFieldDefs.Create(const ATableName: String);
- begin
- Inherited Create(FieldDefClass);
- FPrefix:='Field';
- TableName:=ATableName;
- end;
- class function TDDFieldDefs.FieldDefClass: TDDFieldDefClass;
- begin
- Result:=TDDFieldDef
- end;
- function TDDFieldDefs.GetField(Index : Integer): TDDFieldDef;
- begin
- Result:=TDDFieldDef(Items[Index]);
- end;
- procedure TDDFieldDefs.SetField(Index : Integer; const AValue: TDDFieldDef);
- begin
- Items[Index]:=AValue;
- end;
- function TDDFieldDefs.AddField(AFieldName: String): TDDFieldDef;
- Var
- I : Integer;
- begin
- If (AFieldName<>'') and (IndexOfField(AFieldName)<>-1) then
- Raise EDataDict.CreateFmt(SErrDuplicateFieldName,[TableName,AFieldName]);
- If (AFieldName='') then
- begin
- I:=0;
- Repeat
- Inc(I);
- AFieldName:=SNewField+IntToStr(i);
- Until (IndexOfField(AFieldName)=-1);
- end;
- Result:=Add as TDDFieldDef;
- Result.FieldName:=AFieldName;
- end;
- function TDDFieldDefs.IndexOfField(const AFieldName: String): Integer;
- begin
- Result:=Count-1;
- While (Result>=0) and (CompareText(GetField(Result).FieldName,AFieldName)<>0) do
- Dec(Result)
- end;
- function TDDFieldDefs.FindField(const AFieldName: String): TDDFieldDef;
- Var
- I : integer;
-
- begin
- I:=IndexOfField(AFieldName);
- If (I=-1) then
- Result:=Nil
- else
- Result:=GetField(I);
- end;
- function TDDFieldDefs.FieldByName(const AFieldName: String): TDDFieldDef;
- begin
- Result:=FindField(AFieldName);
- If Result=Nil then
- Raise EDatadict.CreateFmt(SErrFieldNotFound,[TableName,AFieldName]);
- end;
- procedure TDDFieldDefs.FillFieldList(const AFieldNames: String;
- List: TFPDDFieldList);
- Var
- I : Integer;
- S,T : String;
- F : TDDFieldDef;
-
- begin
- T:=Trim(AFieldNames);
- Repeat
- I:=Pos(';',T);
- If I=0 Then
- I:=Length(T)+1;
- S:=Trim(Copy(T,1,I-1));
- System.Delete(T,1,I);
- List.Add(FieldByName(S));
- Until (T='');
- end;
- { ---------------------------------------------------------------------
- TDDTableDef
- ---------------------------------------------------------------------}
-
-
- procedure TDDTableDef.SetTableName(const AValue: String);
- begin
- FTableName:=AValue;
- FFieldDefs.TableName:=AValue;
- FIndexDefs.TableName:=AValue;
- FKeyDefs.TableName:=AValue;
- end;
- function TDDTableDef.GetPrimaryKeyName: String;
- var i : TDDIndexDef;
- begin
- if FPrimaryKeyName <> '' then
- Result := FPrimaryKeyName
- else
- begin
- I := GetPrimaryIndexDef;
- if assigned (I) then
- Result := I.IndexName
- else
- Result:=Tablename+'_PK';
- end;
- end;
- function TDDTableDef.GetPrimaryIndexDef: TDDIndexDef;
- var r : integer;
- begin
- r := Indexes.count;
- repeat
- dec (r);
- until (r < 0) or (ixPrimary in Indexes[r].Options);
- if r < 0 then
- result := nil
- else
- result := Indexes[r];
- end;
- function TDDTableDef.GetOnProgress: TDDProgressEvent;
- begin
- Result:=Nil;
- If (Collection Is TDDTableDefs) then
- Result:=(Collection As TDDTableDefs).OnProgress;
- end;
- function TDDTableDef.GetSectionName: String;
- begin
- Result:=FTableName;
- end;
- procedure TDDTableDef.SetSectionName(const Value: String);
- begin
- TableName:=Value;
- end;
- constructor TDDTableDef.Create(ACollection: TCollection);
- begin
- inherited Create(ACollection);
- FFieldDefs:=TDDFieldDefs.Create(Self);
- FIndexDefs:=TDDIndexDefs.Create(Self);
- FKeyDefs:=TDDForeignkeyDefs.Create('NewTable');
- end;
- destructor TDDTableDef.Destroy;
- begin
- FreeAndNil(FKeyDefs);
- FreeAndNil(FFieldDefs);
- FreeAndNil(FIndexDefs);
- inherited Destroy;
- end;
- function TDDTableDef.DataDictionary: TFPDataDictionary;
- begin
- If Assigned(TableDefs) then
- Result:=TableDefs.DataDictionary
- else
- Result:=Nil;
- end;
- function TDDTableDef.TableDefs: TDDTableDefs;
- begin
- Result:=TDDTableDefs(Collection);
- end;
- Function TDDTableDef.ImportFromDataset(Dataset: TDataSet; DoClear : Boolean = False; UpdateExisting : Boolean = True) : Integer;
- Var
- I : Integer;
- FD : TDDFieldDef;
- F : TField;
- FieldExists : Boolean;
-
- begin
- if DoClear then
- FFieldDefs.Clear;
- Result:=0;
- For I:=0 to Dataset.Fields.Count-1 do
- begin
- F:=Dataset.Fields[i];
- FD:=FFieldDefs.FindField(F.FieldName);
- If (FD=Nil) then
- begin
- FD:=FFieldDefs.AddField(F.FieldName);
- FieldExists := False;
- end
- else
- begin
- if not UpdateExisting then FD:=Nil;
- FieldExists := True;
- end;
- if (FD<>Nil) then
- begin
- Inc(Result);
- FD.ImportFromField(F,FieldExists);
- end;
- end;
- end;
- procedure TDDTableDef.ApplyToDataset(Dataset: TDataset);
- var
- I : integer;
- FD : TDDFieldDef;
- F : TField;
-
- begin
- For I:=0 to Dataset.FieldCount-1 do
- begin
- F:=Dataset.Fields[i];
- FD:=FFieldDefs.FieldByName(F.FieldName);
- If (FD<>Nil) then
- FD.ApplyToField(F);
- end;
- end;
- function TDDTableDef.AddField(const AFieldName: String): TDDFieldDef;
- begin
- Result:=Fields.AddField(AFieldName);
- end;
- procedure TDDTableDef.SaveToIni(Ini: TCustomInifile; ASection: String);
- begin
- With Ini do
- begin
- WriteString(ASection,KeyTableName,TableName);
- WriteString(ASection,KeyPrimaryKeyConstraint,FPRimaryKeyName);
- end;
- If Assigned(OnProgress) then
- OnProgress(Self,Format(SSavingFieldsFrom,[TableName]));
- FFieldDefs.SaveToIni(Ini,ASection+SFieldSuffix);
- FIndexDefs.SaveToIni(Ini,ASection+SIndexSuffix);
- FKeyDefs.SaveToIni(Ini,ASection+SKeySuffix);
- end;
- procedure TDDTableDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
- begin
- With Ini do
- begin
- TableName:=ReadString(ASection,KeyTableName,TableName);
- FPrimaryKeyName:=ReadString(ASection,KeyPrimaryKeyConstraint,'');
- end;
- If Assigned(OnProgress) then
- OnProgress(Self,Format(SLoadingFieldsFrom,[TableName]));
- FFieldDefs.LoadFromIni(Ini,ASection+SFieldSuffix);
- FIndexDefs.LoadFromIni(Ini,ASection+SIndexSuffix);
- FKeyDefs.LoadFromIni(Ini,ASection+SKeySuffix);
- end;
- procedure TDDTableDef.PrimaryIndexToFields;
- var I : TDDIndexDef;
- r : integer;
- l : TFPDDFieldList;
- begin
- I := GetPrimaryIndexDef;
- if assigned (I) then
- begin
- for r := 0 to Fields.count-1 do
- Fields[r].ProviderFlags := Fields[r].ProviderFlags - [pfInKey];
- l := TFPDDFieldList.create;
- try
- Fields.FillFieldList (I.Fields, l);
- for r := 0 to l.count-1 do
- l[r].ProviderFlags := l[r].ProviderFlags + [pfInKey];
- finally
- l.Free;
- end;
- end;
- end;
- procedure TDDTableDef.FieldsToPrimaryIndex;
- var I : TDDIndexDef;
- r : integer;
- s : string;
- begin
- I := GetPrimaryIndexDef;
- s := '';
- for r := 0 to fields.count-1 do
- if pfInKey in fields[r].ProviderFlags then
- s := s + ';' + fields[r].FieldName;
- if s = '' then
- begin
- if assigned (I) then
- I.Free;
- end
- else
- begin
- s := copy(s, 2, maxint);
- if assigned (I) then
- I.Fields := s
- else
- begin
- I := Indexes.AddIndex(GetPrimaryKeyName);
- I.Fields := s;
- I.Options := I.Options + [ixPrimary];
- end;
- end;
- end;
- { ---------------------------------------------------------------------
- TDDTableDefs
- ---------------------------------------------------------------------}
- function TDDTableDefs.GetTable(Index : Integer): TDDTableDef;
- begin
- Result:=TDDTableDef(Items[Index]);
- end;
- procedure TDDTableDefs.SetTable(Index : Integer; const AValue: TDDTableDef);
- begin
- Items[Index]:=AValue;
- end;
- function TDDTableDefs.AddTable(ATableName: String): TDDTableDef;
- Var
- I : Integer;
-
- begin
- If (ATableName<>'') and (IndexOfTable(ATableName)<>-1) then
- Raise EDataDict.CreateFmt(SErrDuplicateTableName,[ATableName]);
- If (ATableName='') then
- begin
- I:=0;
- Repeat
- Inc(I);
- ATAbleName:=SNewTable+IntToStr(i);
- Until (IndexOfTable(ATableName)=-1);
- end;
- Result:=Add as TDDTableDef;
- Result.TableName:=ATableName;
- end;
- function TDDTableDefs.IndexOfTable(const ATableName: String): Integer;
- begin
- Result:=Count-1;
- While (Result>=0) and (CompareText(GetTable(Result).TableName,ATableName)<>0) do
- Dec(Result)
- end;
- function TDDTableDefs.FindTable(const ATableName: String): TDDTableDef;
- Var
- I : integer;
- begin
- I:=IndexOfTable(ATableName);
- If (I=-1) then
- Result:=Nil
- else
- Result:=GetTable(I);
- end;
- function TDDTableDefs.TableByName(const ATableName: String): TDDTableDef;
- begin
- Result:=FindTable(ATableName);
- If Result=Nil then
- Raise EDatadict.CreateFmt(SErrTableNotFound,[ATableName]);
- end;
- { ---------------------------------------------------------------------
- TDatadictionary
- ---------------------------------------------------------------------}
- procedure TFPDataDictionary.SetOnProgress(const AValue: TDDProgressEvent);
- begin
- FOnProgress:=AValue;
- FTables.OnProgress:=FOnProgress;
- end;
- constructor TFPDataDictionary.Create;
- begin
- FTables:=TDDTableDefs.Create(TDDTableDef);
- FTables.FDataDictionary:=Self;
- FSequences:=TDDSequenceDefs.Create;
- FSequences.FDataDictionary:=Self;
- FDomains:=TDDDomainDefs.Create;
- FDomains.FDataDictionary:=Self;
- end;
- destructor TFPDataDictionary.Destroy;
- begin
- FreeAndNil(FDomains);
- FreeAndNil(FSequences);
- FreeAndNil(FTables);
- inherited Destroy;
- end;
- procedure TFPDataDictionary.SaveToFile(const AFileName: String; KeepBackup: Boolean = True);
- Var
- Ini : TMemIniFile;
- FN : String;
- begin
- FN:=aFileName;
- If (FN='') then
- FN:=FFileName;
- if (FN='') and (Name<>'') then
- FN:=Name+DefaultDDExt;
- if (FN='') then
- Raise EDataDict.Create(SErrNoFileName);
- If FileExists(FN) then
- If KeepBackup then
- RenameFile(FN,FN+'.bak')
- else
- DeleteFile(FN);
- Ini:=TMemIniFile.Create(FN);
- try
- SaveToIni(Ini,SDataDict);
- Ini.UpdateFile;
- FFileName:=FN;
- finally
- FreeAndNil(Ini);
- end;
- end;
- procedure TFPDataDictionary.SaveToIni(Ini: TCustomIniFile; ASection: String);
- begin
- Ini.WriteString(ASection,KeyDataDictName,Name);
- FDomains.SaveToIni(Ini,SDatadictDomains);
- FSequences.SaveToIni(Ini,SDatadictSequences);
- FTables.SaveToIni(Ini,SDatadictTables);
- end;
- procedure TFPDataDictionary.LoadFromFile(const AFileName: String);
- Var
- Ini : TMemInifile;
- begin
- if (AFileName='') then
- Raise EDataDict.Create(SErrNoFileName);
- Ini:=TMemIniFile.Create(AFileName);
- try
- LoadFromIni(Ini,SDataDict);
- FFileName:=AFileName;
- If (Name='') then
- Name:=ChangeFileExt(ExtractFileName(AFileName),'');
- finally
- FreeAndNil(Ini);
- end;
- end;
- procedure TFPDataDictionary.LoadFromIni(Ini: TCustomIniFile; ASection: String);
- begin
- FDDName:=Ini.ReadString(ASection,KeyDataDictName,'');
- FDomains.Clear;
- FDomains.LoadFromIni(Ini,SDataDictDomains);
- FSequences.Clear;
- FSequences.LoadFromIni(Ini,SDataDictSequences);
- FTables.Clear;
- FTables.LoadFromIni(Ini,SDataDictTables);
- end;
- procedure TFPDataDictionary.ApplyToDataset(ADataset: TDataset);
- begin
- ApplytoDataset(ADataset,FOnApplyDatadictEvent);
- end;
- procedure TFPDataDictionary.ApplyToDataset(ADataset: TDataset;
- OnApply: TOnApplyDataDictEvent);
- Var
- I : Integer;
- F : TField;
- FD : TDDFieldDef;
- FN,TN : String;
- Allow : Boolean;
-
- begin
- For I:=0 to ADataset.Fields.Count-1 do
- begin
- F:=ADataset.Fields[i];
- FN:=F.Origin;
- If (FN='') then
- FN:=F.FieldName;
- FD:=FindFieldDef(FN,TN);
- Allow:=(FD<>Nil);
- If Assigned(OnApply) then
- OnApply(Self,FD,F,Allow);
- If (FD<>Nil) and Allow then
- FD.ApplyToField(F);
- end;
- end;
- function TFPDataDictionary.CanonicalizeFieldName(const InFN: String; Out TableDef : TDDTableDef; Out FN: String): Boolean;
- Var
- TN : String;
- P : integer;
- begin
- Result:=False;
- FN:=InFN;
- TableDef:=Nil;
- // Improve to check for quotes
- P:=Pos('.',FN);
- If (P<>0) then
- begin
- TN:=Copy(FN,1,P-1);
- Delete(FN,1,P);
- TableDef:=Tables.FindTable(TN);
- end;
- Result:=TableDef<>Nil;
- end;
- Function TFPDataDictionary.CanonicalizeFieldName(Const InFN : String; Out TN,FN : String) : Boolean;
- Var
- TD : TDDTableDef;
- begin
- Result:=CanonicalizeFieldName(InFN,TD,FN);
- If Result then
- TN:=TD.TableName
- else
- TN:='';
- end;
- // To be good, we should make a hashlist with all tables.fields and search that...
- // For now, we cache the last matching table. This should work well for most common cases.
- function TFPDataDictionary.FindFieldDef(const FieldName: String; out TableName: String
- ): TDDFieldDef;
- Var
- TD : TDDTableDef;
- FN,TN : String;
- I : Integer;
-
- begin
- Result:=Nil;
- If CanonicalizeFieldName(FieldName,TD,FN) then
- begin
- Result:=TD.Fields.FieldByName(FN);
- If (Result<>Nil) then
- FLastMatchTableDef:=TD;
- end
- else
- begin
- If (FLastMatchTableDef<>Nil) then
- TD:=FLastMatchTableDef;
- If (TD<>Nil) then
- Result:=TD.Fields.FindField(FN);
- If Result=Nil then
- begin
- // Hard scan of all tables...
- I:=0;
- While (Result=Nil) and (I<Tables.Count) do
- begin
- TD:=Tables[i];
- Result:=TD.Fields.FindField(FN);
- If (Result<>Nil) then
- FLastMatchTableDef:=TD;
- Inc(I);
- end;
- end;
- end;
- If (Result<>Nil) then
- TableName:=FLastMatchTableDef.TableName;
- end;
- function TFPDataDictionary.FindFieldDef(const FieldName: String): TDDFieldDef;
- Var
- Dummy : String;
- begin
- Result:=FindFieldDef(FieldName,Dummy);
- end;
- { ---------------------------------------------------------------------
- TFPDDEngine
- ---------------------------------------------------------------------}
- procedure TFPDDEngine.DoProgress(const Msg: String);
- begin
- If Assigned(FOnProgress) then
- FOnProgress(Self,Msg);
- end;
- procedure TFPDDEngine.IndexDefsToDDIndexDefs(IDS: TIndexDefs; DDIDS: TDDindexDefs
- );
-
- Var
- D : TIndexDef;
- DD : TDDindexDef;
- I : Integer;
-
- begin
- DDIDS.Clear;
- For I:=0 to IDS.Count-1 do
- begin
- D:=IDS[I];
- DD:=DDIDS.AddDDIndexDef(D.Name);
- DD.Assign(D);
- end;
- end;
- destructor TFPDDEngine.Destroy;
- begin
- Disconnect;
- inherited Destroy;
- end;
- function TFPDDEngine.GetConnectString: String;
- Var
- CB : TGetConnectionEvent;
-
- begin
- CB:=GetEngineConnectionStringCallBack(Self.ClassName);
- if (CB=Nil) then
- Raise EDataDict.CreateFmt(SerrNoConnectionDialog,[Self.ClassName]);
- Result:='';
- CB(Self,Result);
- end;
- function TFPDDEngine.ImportTables(Tables: TDDTableDefs; List: TStrings; UpdateExisting : Boolean): Integer;
- Var
- I,J : Integer;
- TD : TDDTableDef;
- begin
- Result:=0;
- For I:=0 to List.Count-1 do
- begin
- TD:=Nil;
- j:=Tables.IndexOfTable(List[i]);
- If (J=-1) then
- TD:=Tables.AddTable(List[i])
- else if UpdateExisting then
- TD:=Tables[J];
- If (TD<>nil) then
- begin
- DoProgress(Format(SDDImportingTable,[TD.TableName]));
- ImportFields(TD);
- if ecTableIndexes in EngineCapabilities then
- ImportIndexes(TD);
- Inc(Result);
- end
- end;
- end;
- function TFPDDEngine.GetDomainList(List: TSTrings): integer;
- begin
- List.Clear;
- result := 0;
- end;
- function TFPDDEngine.CreateSQLEngine: TFPDDSQLEngine;
- begin
- Result:=TFPDDSQLEngine.Create;
- end;
- class function TFPDDEngine.EngineCapabilities: TFPDDEngineCapabilities;
- begin
- Result:=[];
- end;
- procedure TFPDDEngine.ImportDatadict(Adatadict: TFPDatadictionary;
- UpdateExisting: Boolean);
- var L : TStringList;
- r : integer;
- begin
- l := TStringlist.Create;
- try
- if ecDomains in EngineCapabilities then
- begin
- GetDomainList (L);
- if UpdateExisting then // Delete domains that don't exist anymore
- begin
- for r := ADatadict.Domains.count-1 downto 0 do
- if L.indexOf(ADatadict.Domains[r].DomainName) < 0 then
- ADatadict.Domains[r].Free;
- end;
- ImportDomains (ADatadict.Domains, L, UpdateExisting);
- end;
- L.Clear;
- GetTableList (L);
- if UpdateExisting then // delete tables that don't exist anymore
- begin
- for r := ADatadict.Tables.count-1 downto 0 do
- if L.indexOf(ADatadict.Tables[r].TableName) < 0 then
- ADatadict.Tables[r].Free;
- end;
- ImportTables (ADatadict.Tables, L, UpdateExisting);
- if ecSequences in EngineCapabilities then
- begin
- L.Clear;
- GetSequenceList (L);
- if UpdateExisting then // Delete sequences that don't exist anymore
- begin
- for r := ADatadict.Sequences.count-1 downto 0 do
- if L.indexOf(ADatadict.Sequences[r].SequenceName) < 0 then
- ADatadict.Sequences[r].Free;
- end;
- ImportSequences (ADatadict.Sequences, L, UpdateExisting);
- end;
- finally
- L.Free;
- end;
- end;
- function TFPDDEngine.ImportDomains(Domains: TDDDomainDefs; List : TStrings; UpdateExisting : boolean) : Integer;
- begin
- result := 0;
- end;
- function TFPDDEngine.GetSequenceList(List: TStrings): integer;
- begin
- List.Clear;
- result := 0;
- end;
- function TFPDDEngine.ImportSequences(Sequences: TDDSequenceDefs; List : TStrings; UpdateExisting : boolean) : Integer;
- begin
- result := 0;
- end;
- procedure TFPDDEngine.CreateTable(Table: TDDTableDef);
- begin
- Raise EDataDict.CreateFmt(SErrCreateTableNotSupported,[DBType]);
- end;
- function TFPDDEngine.ViewTable(Const TableName: String; DatasetOwner: TComponent
- ): TDataset;
- begin
- Raise EDataDict.CreateFmt(SErrViewTableNotSupported,[DBType]);
- end;
- function TFPDDEngine.RunQuery(SQL: String): Integer;
- begin
- Raise EDataDict.CreateFmt(SErrRunQueryNotSupported,[DBType]);
- end;
- function TFPDDEngine.CreateQuery(SQL: String; DatasetOwner : TComponent): TDataset;
- begin
- Raise EDataDict.CreateFmt(SErrOpenQueryNotSupported,[DBType]);
- end;
- procedure TFPDDEngine.SetQueryStatement(SQL: String; AQuery: TDataset);
- begin
- Raise EDataDict.CreateFmt(SErrSetQueryStatementNotSupported,[DBType]);
- end;
- function TFPDDEngine.GetTableIndexDefs(ATableName: String; Defs: TDDIndexDefs
- ): integer;
- begin
- Raise EDataDict.CreateFmt(SErrGetTableIndexDefsNotSupported,[DBType]);
- end;
- { ---------------------------------------------------------------------
- TFPDDSQLEngine
- ---------------------------------------------------------------------}
- { Utility functions }
- constructor TFPDDSQLEngine.Create;
- begin
- FTerminatorChar:=DefaultSQLTerminatorChar;
- FFieldQuoteChar:=DefaultSQLFieldQuoteChar;
- FOptions:=DefaultSQLEngineOptions;
- FMaxLineLength:=DefaultSQLEngineLineLength;
- FIndent:=DefaultSQLEngineIndent;
- end;
- procedure TFPDDSQLEngine.CheckTableDef;
- begin
- If (FTableDef=Nil) then
- Raise EDataDict.Create(SErrMissingTableDef);
- end;
- procedure TFPDDSQLEngine.NoIndent;
- begin
- FNoIndent:=True;
- end;
- procedure TFPDDSQLEngine.ResetLine;
- begin
- FLastLength:=0;
- NoIndent;
- end;
- procedure TFPDDSQLEngine.FixUpStatement(var Res: String; ForceTerminator : Boolean = False);
- Var
- L : Integer;
- begin
- Res:=Trim(Res);
- if (eoAddTerminator in Options) or ForceTerminator then
- begin
- L:=Length(Res);
- If (L=0) or (Res[L]<>FTerminatorChar) then
- Res:=Res+FTerminatorChar;
- end;
- end;
- procedure TFPDDSQLEngine.FixUpStatement(SQL: TStrings; ForceTerminator: Boolean = False);
- Var
- S : String;
- begin
- If (SQL.Count>0) then
- begin
- S:=SQL[SQL.Count-1];
- FixupStatement(S,ForceTerminator);
- SQL[SQL.Count-1]:=S;
- end;
- end;
- Procedure TFPDDSQLEngine.AddToStringLN(Var Res : String;const S : String);
- begin
- AddToString(Res,S);
- Res:=Res+LineEnding;
- FLastLength:=0;
- end;
- procedure TFPDDSQLEngine.AddToString(Var Res: String; S: String);
- begin
- If (FMaxLineLength>0) and (FLastLength+Length(S)+1>FMaxLineLength) then
- begin
- FLastLength:=0;
- Res:=Res+LineEnding;
- end
- else If (FLastLength<>0) and (S<>'') then
- S:=' '+S;
- If (FLastlength=0) then
- begin
- If not FNoIndent then
- begin
- Res:=Res+StringOfChar(' ',Indent);
- FLastlength:=FlastLength+Indent;
- end;
- end;
- FLastLength:=FLastLength+Length(S);
- FNoIndent:=False;
- Res:=Res+S;
- end;
- procedure TFPDDSQLEngine.AddFieldString(var Res: String; const S: String);
- begin
- If eoLineFeedAfterField in FOptions then
- AddToStringLn(Res,S)
- else
- AddToString(Res,S)
- end;
- function TFPDDSQLEngine.CreateAndTerm(FD: TDDFieldDef; UseOldParam: Boolean
- ): string;
- begin
- Result:=FieldNameString(FD)+' = '+FieldParamString(FD,UseOldParam);
- if (eoAndTermsInBrackets in FOptions) then
- Result:='('+Result+')';
- end;
- function TFPDDSQLEngine.CreateWhereSQL(var Res : String;FieldList: TFPDDFieldList; UseOldParam:Boolean): String;
- Var
- i : Integer;
- FD : TDDFieldDef;
- S : String;
- begin
- Result:='';
- If Assigned(FieldList) and (FieldList.Count>0) then
- begin
- For i:=0 to FieldList.Count-1 do
- begin
- FD:=FieldList[i];
- S:=CreateAndTerm(FD,UseOldParam);
- If (I>0) then
- S:=SAnd+' '+S;
- If eoLineFeedAfterAndTerm in Options then
- AddToStringLN(Res,S)
- else
- AddToString(Res,S);
- end;
- end;
- end;
- procedure TFPDDSQLEngine.AddWhereClause(var Res: String;
- FieldList: TFPDDFieldList; UseOldParam: Boolean);
- begin
- If Assigned(FieldList) and (FieldList.Count>0) then
- begin
- NoIndent;
- AddToStringLn(Res,SWhere);
- CreateWhereSQL(Res,FieldList,UseOldParam);
- end;
- end;
- { Functions with engine-specific strings in it. Can be overridden }
- function TFPDDSQLEngine.FieldNameString(FD: TDDFieldDef): string;
- begin
- Result:=FD.FieldName;
- if (eoQuoteFieldNames in FOptions) then
- Result:=FFieldQuoteChar+Result+FFieldQuoteChar;
- end;
- function TFPDDSQLEngine.TableNameString(TD: TDDTableDef): string;
- begin
- Result:=TD.TableName;
- end;
- function TFPDDSQLEngine.FieldParamString(FD: TDDFieldDef; UseOldParam: Boolean
- ): string;
- begin
- Result:=FD.FieldName;
- If UseOldParam then
- Result:=SOLD+Result;
- Result:=':'+Result;
- end;
- function TFPDDSQLEngine.FieldTypeString(FD : TDDFieldDef) : String;
- begin
- if FD.DomainName <> '' then
- Result := FD.DomainName
- else
- Result:=FieldTypeString(FD.FieldType,FD.Size,FD.Precision);
- end;
- Function TFPDDSQLEngine.FieldTypeString(FT : TFieldType; ASize,APrecision : Integer) : String;
- {
- ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
- ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
- ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
- ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar,
- ftWideString, ftLargeint, ftADT, ftArray, ftReference,
- ftDataSet, ftOraBlob, ftOraClob, ftVariant, ftInterface,
- ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd}
- begin
- Result:=SQLFieldTypes[FT];
- If (Result='') then
- Raise EDataDict.CreateFmt(SErrFieldTypeNotSupported,[GetEnumName(TypeInfo(TFieldType),Ord(FT))]);
- case FT of
- ftString,
- ftFixedChar,
- ftWideString :
- Result:=Result+Format('(%d)',[ASize]);
- ftBCD,
- ftFMTBCD :
- Result:=Result+Format('(%d,%d)',[APrecision,ASize]);
- end;
- end;
- function TFPDDSQLEngine.FieldDefaultString(FD : TDDFieldDef) : String;
- begin
- Result:=SDefault+' '+FD.DBDefault;
- end;
- function TFPDDSQLEngine.FieldCheckString(FD : TDDFieldDef) : String;
- begin
- Result:=Trim(FD.Constraint);
- If (Result<>'') then
- begin
- If (Result[1]<>'(') or (Result[Length(Result)]<>')') then
- Result:='('+Result+')';
- Result:=SCheck+' '+Result;
- end;
- end;
- function TFPDDSQLEngine.FieldDeclarationString(FD : TDDFieldDef) : String;
- var
- S : String;
- begin
- Result:=FieldNameString(FD)+' '+FieldTypeString(FD);
- If (FD.DBDefault<>'') then
- Result:=Result+' '+FieldDefaultString(FD);
- If FD.Required then
- Result:=Result+' '+SNotNull;
- S:=FieldCheckString(FD);
- If (S<>'') then
- Result:=Result+' '+S;
- end;
- { SQL Creation functions. Can be overridden if needed. }
-
- function TFPDDSQLEngine.CreateSelectSQL(FieldList, KeyFields: TFPDDFieldList
- ): String;
-
- Var
- i : Integer;
- FD : TDDFieldDef;
- S : String;
-
- begin
- CheckTableDef;
- Result:='';
- ResetLine;
- AddToStringLn(Result,SSelect);
- For i:=0 to FieldList.Count-1 do
- begin
- FD:=FieldList[i];
- S:=FieldNameString(FD);
- If (I<FieldList.Count-1) then
- S:=S+',';
- AddFieldString(Result,S);
- end;
- If Not (eoLineFeedAfterField in FOptions) then
- AddToStringLn(Result,'');
- NoIndent;
- AddToStringLn(Result,SFrom);
- AddToStringLn(Result,TableNameString(TableDef));
- AddWhereClause(Result,KeyFields,False);
- FixUpStatement(Result);
- end;
- function TFPDDSQLEngine.CreateInsertSQL(FieldList: TFPDDFieldList): String;
- Var
- i : Integer;
- FD : TDDFieldDef;
- S : String;
- begin
- CheckTableDef;
- Result:='';
- ResetLine;
- AddToString(Result,SInsertInto);
- AddToStringLn(Result,TableNameString(TableDef));
- For i:=0 to FieldList.Count-1 do
- begin
- FD:=FieldList[i];
- S:=FieldNameString(FD);
- If (I=0) then
- S:='('+S;
- If (I<FieldList.Count-1) then
- S:=S+','
- else
- S:=S+')';
- AddFieldString(Result,S);
- end;
- If Not (eoLineFeedAfterField in FOptions) then
- AddToStringLn(Result,'');
- NoIndent;
- AddToStringLn(Result,SValues);
- For i:=0 to FieldList.Count-1 do
- begin
- FD:=FieldList[i];
- S:=FieldParamString(FD,False);
- If (I=0) then
- S:='('+S;
- If (I<FieldList.Count-1) then
- S:=S+','
- else
- S:=S+')';
- AddFieldString(Result,S);
- end;
- FixUpStatement(Result);
- end;
- function TFPDDSQLEngine.CreateUpdateSQL(FieldList, KeyFields: TFPDDFieldList
- ): String;
- Var
- i : Integer;
- FD : TDDFieldDef;
- S : String;
- begin
- CheckTableDef;
- ResetLine;
- Result:='';
- AddToString(Result,SUPDATE);
- AddToStringLN(Result,TableNameString(TableDef));
- NoIndent;
- AddToStringLN(Result,SSET);
- If Assigned(FieldList) and (FieldList.Count>0) then
- begin
- For i:=0 to FieldList.Count-1 do
- begin
- FD:=FieldList[i];
- S:=FieldNameString(FD)+' = '+FieldParamString(FD,False);
- If (I<FieldList.Count-1) then
- S:=S+',';
- AddFieldString(Result,S);
- end;
- end;
- AddWhereClause(Result,KeyFields,eoUseOldInWhereParams in Options);
- FixUpStatement(Result);
- end;
- function TFPDDSQLEngine.CreateDeleteSQL(KeyFields: TFPDDFieldList): String;
- begin
- CheckTableDef;
- ResetLine;
- Result:='';
- AddToStringLN(Result,SDeleteFrom);
- AddToStringLN(Result,TableNameString(TableDef));
- AddWhereClause(Result,KeyFields,eoUseOldInWhereParams in Options);
- FixUpStatement(Result);
- end;
- function TFPDDSQLEngine.CreateCreateSQL(Fields, KeyFields: TFPDDFieldList
- ): String;
-
- Var
- S : String;
- I : integer;
-
- begin
- CheckTableDef;
- Result:='';
- ResetLine;
- AddToStringLn(Result,SCreateTable+' '+TableNameString(TableDef)+' (');
- For I:=0 to Fields.Count-1 do
- begin
- S:=FieldDeclarationString(Fields[i]);
- If (I<Fields.Count-1) or (Assigned(KeyFields) and (KeyFields.Count<>0)) then
- S:=S+',';
- AddToStringLn(Result,S);
- end;
- If (Assigned(KeyFields) and (KeyFields.Count<>0)) then
- begin
- S:=SCONSTRAINT+' '+TableDef.PrimaryKeyConstraintName+' '+SPrimaryKey+' (';
- For I:=0 to KeyFields.Count-1 do
- begin
- S:=S+FieldNameString(KeyFields[i]);
- If I<KeyFields.Count-1 then
- S:=S+','
- else
- S:=S+')'
- end;
- AddToStringLn(Result,S);
- end;
- NoIndent;
- AddToStringLn(Result,')');
- FixUpStatement(Result);
- end;
- function TFPDDSQLEngine.CreateCreateSQL(KeyFields: TFPDDFieldList): String;
- Var
- Fl : TFPDDFieldList;
- begin
- CheckTableDef;
- FL:=TFPDDfieldList.CreateFromTableDef(TableDef);
- try
- FL.OwnsObjects:=False;
- Result:=CreateCreateSQL(FL,KeyFields);
- finally
- FL.Free;
- end;
- end;
- function TFPDDSQLEngine.CreateIndexSQL(Index: TDDIndexDef): String;
- Var
- L : TFPDDFieldList;
- I : Integer;
-
- begin
- Result:='CREATE ';
- If ixUnique in Index.Options then
- Result:=Result+'UNIQUE ';
- If ixDescending in Index.Options then
- Result:=Result+'DESCENDING ';
- Result:=Result+'INDEX '+Index.IndexName;
- Result:=Result+' ON '+TableDef.TableName+' (';
- L:=TFPDDFieldList.Create;
- try
- L.OwnsObjects:=False;
- TableDef.Fields.FillFieldList(Index.Fields,L);
- For I:=0 to L.Count-1 do
- begin
- If (I>0) then
- Result:=Result+',';
- Result:=Result+L[I].FieldName;
- end;
- finally
- L.Free;
- end;
- Result:=Result+')';
- end;
- function TFPDDSQLEngine.CreateIndexesSQL(Indexes: TFPDDIndexList): String;
- Var
- SQL : TStringList;
- begin
- SQL:=TStringList.Create;
- try
- CreateIndexesSQLStrings(Indexes,SQL);
- Result:=SQL.Text;
- finally
- SQL.free;
- end;
- end;
- function TFPDDSQLEngine.CreateIndexesSQL(Indexes: TDDIndexDefs): String;
- Var
- IL : TFPDDIndexList;
- begin
- IL:=TFPDDIndexList.CreateFromIndexDefs(Indexes);
- try
- IL.OwnsObjects:=False;
- Result:=CreateIndexesSQL(IL);
- finally
- IL.Free;
- end;
- end;
- function TFPDDSQLEngine.CreateForeignKeySQL(ForeignKey: TDDForeignKeyDef
- ): String;
- begin
- Result:=Format('ALTER TABLE %s ADD CONSTRAINT %s',[TableDef.TableName,ForeignKey.KeyName]);
- Result:=Result+Format(' FOREIGN KEY (%s)',[ForeignKey.KeyFields]);
- Result:=Result+Format(' REFERENCES %s(%s)',[ForeignKey.ReferencesTable,ForeignKey.ReferencedFields])
- end;
- function TFPDDSQLEngine.CreateForeignKeysSQL(ForeignKeys: TDDForeignKeyDefs
- ): String;
- Var
- SQL : TStrings;
- begin
- SQL:=TStringList.Create;
- try
- CreateForeignKeysSQLStrings(ForeignKeys,SQL);
- Result:=SQL.Text;
- finally
- SQL.Free;
- end;
- end;
- function TFPDDSQLEngine.CreateSequenceSQL(Sequence: TDDSequenceDef): String;
- begin
- Result:='CREATE SEQUENCE '+Sequence.SequenceName;
- If (Sequence.StartValue<>0) then
- Result:=Result+' START WITH '+IntToStr(Sequence.StartValue);
- If (Sequence.Increment<>0) then
- Result:=Result+' INCREMENT BY '+IntToStr(Sequence.Increment);
- end;
- function TFPDDSQLEngine.CreateSequencesSQL(Sequences: TFPDDSequenceList): String;
- Var
- SQL : TStrings;
- begin
- SQL:=TStringList.Create;
- Try
- CreateSequencesSQLStrings(Sequences,SQL);
- Result:=SQL.Text;
- Finally
- SQL.Free;
- end;
- end;
- function TFPDDSQLEngine.CreateSequencesSQL(Sequences: TDDSequenceDefs): String;
- Var
- L : TFPDDSequenceList;
- begin
- L:=TFPDDSequenceList.CreateFromSequenceDefs(Sequences);
- try
- L.OwnsObjects:=False;
- Result:=CreateSequencesSQl(L);
- finally
- L.Free;
- end;
- end;
- function TFPDDSQLEngine.CreateDomainSQL(Domain: TDDDomainDef): String;
- begin
- Result:='CREATE DOMAIN '+Domain.DomainName+' ';
- Result:=Result+FieldTypeString(Domain.FieldType,Domain.Size,Domain.Precision);
- If Domain.Required then
- Result:=Result+' NOT NULL';
- If (Domain.CheckConstraint<>'') then
- Result:=Result+' CHECK ('+Domain.CheckConstraint+')';
- end;
- function TFPDDSQLEngine.CreateDomainsSQL(Domains: TFPDDDomainList): String;
- Var
- SQL : TStrings;
- begin
- SQL:=TStringList.Create;
- Try
- CreateDomainsSQLStrings(Domains,SQL);
- Result:=SQL.Text;
- Finally
- SQL.Free;
- end;
- end;
- function TFPDDSQLEngine.CreateDomainsSQL(Domains: TDDDomainDefs): String;
- Var
- L : TFPDDDomainList;
- begin
- L:=TFPDDDomainList.CreateFromDomainDefs(Domains);
- try
- L.OwnsObjects:=False;
- Result:=CreateDomainsSQl(L);
- finally
- L.Free;
- end;
- end;
- function TFPDDSQLEngine.CreateTableSQL: String;
- Var
- SQL : TStrings;
- begin
- SQL:=TStringList.Create;
- try
- CreateTableSQLStrings(SQL);
- Result:=SQL.Text;
- finally
- SQL.Free;
- end;
- end;
- procedure TFPDDSQLEngine.CreateTableSQLStrings(SQL: TStrings);
- Var
- L : TStrings;
- I : Integer;
- KF : TFPDDFieldlist;
- ID : TDDIndexDef;
- FD : TDDFieldDef;
- S : String;
- begin
- CheckTableDef;
- L:=TStringList.Create;
- try
- KF:=TFPDDFieldlist.Create(False);
- try
- KF.OwnsObjects:=False;
- if assigned (TableDef.PrimaryIndexDef) then
- TableDef.fields.FillFieldList(TableDef.PrimaryIndexDef.Fields, KF)
- else
- For I:=0 to TableDef.Fields.Count-1 do
- begin
- FD:=TableDef.Fields[I];
- If pfInKey in FD.ProviderFlags then
- KF.Add(FD);
- end;
- CreateCreateSQLStrings(KF,SQL);
- FixupStatement(SQL,True);
- L.Text:=CreateIndexesSQL(TableDef.Indexes);
- If (L.Count>0) then
- begin
- SQL.AddStrings(L);
- FixupStatement(SQL,True);
- end;
- L.Clear;
- If Not (eoSkipForeignKeys in Options) then
- L.Text:=CreateForeignKeysSQL(TableDef.ForeignKeys);
- SQL.AddStrings(L);
- finally
- KF.Free;
- end;
- finally
- L.Free;
- end;
- end;
- { TStrings versions of SQL creation statements. }
- procedure TFPDDSQLEngine.CreateSelectSQLStrings(FieldList,KeyFields: TFPDDFieldList; SQL: TStrings);
- begin
- SQL.Text:=CreateSelectSQL(FieldList,KeyFields);
- end;
- procedure TFPDDSQLEngine.CreateInsertSQLStrings(FieldList: TFPDDFieldList; SQL: TStrings);
- begin
- SQL.Text:=CreateInsertSQL(FieldList);
- end;
- procedure TFPDDSQLEngine.CreateUpdateSQLStrings(FieldList, KeyFields: TFPDDFieldList;
- SQL: TStrings);
- begin
- SQL.Text:=CreateUpdateSQL(FieldList,KeyFields);
- end;
- procedure TFPDDSQLEngine.CreateDeleteSQLStrings(KeyFields: TFPDDFieldList;
- SQL: TStrings);
- begin
- SQL.Text:=CreateDeleteSQL(KeyFields);
- end;
- procedure TFPDDSQLEngine.CreateCreateSQLStrings(Fields,
- KeyFields: TFPDDFieldList; SQL: TStrings);
- begin
- SQL.Text:=CreateCreateSQL(Fields,KeyFields);
- end;
- procedure TFPDDSQLEngine.CreateCreateSQLStrings(KeyFields: TFPDDFieldList;
- SQL: TStrings);
- begin
- SQL.Text:=CreateCreateSQL(KeyFields);
- end;
- procedure TFPDDSQLEngine.CreateIndexesSQLStrings(Indexes: TFPDDIndexList; SQL: TStrings);
- Var
- I : integer;
- begin
- For I:=0 to Indexes.Count-1 do
- if not (ixPrimary in Indexes[i].Options) then
- SQL.Add(CreateIndexSQL(Indexes[i])+TerminatorChar);
- end;
- procedure TFPDDSQLEngine.CreateForeignKeysSQLStrings(
- ForeignKeys: TDDForeignKeyDefs; SQL: TStrings);
- Var
- I : integer;
- begin
- For I:=0 to ForeignKeys.Count-1 do
- SQL.Add(CreateForeignKeySQL(ForeignKeys[i])+TerminatorChar);
- end;
- procedure TFPDDSQLEngine.CreateSequencesSQLStrings(Sequences: TFPDDSequenceList;
- SQL: TStrings);
- Var
- I : integer;
- begin
- For I:=0 to Sequences.Count-1 do
- SQL.Add(CreateSequenceSQL(Sequences[i])+TerminatorChar);
- end;
- procedure TFPDDSQLEngine.CreateDomainsSQLStrings(Domains: TFPDDDomainList;
- SQL: TStrings);
- Var
- I : integer;
- begin
- For I:=0 to Domains.Count-1 do
- SQL.Add(CreateDomainSQL(Domains[i])+TerminatorChar);
- end;
- { ---------------------------------------------------------------------
- TDDFieldList
- ---------------------------------------------------------------------}
- function TFPDDFieldList.GetFieldDef(Index : Integer): TDDFieldDef;
- begin
- Result:=TDDFieldDef(Items[Index]);
- end;
- procedure TFPDDFieldList.SetFieldDef(Index : Integer; const AValue: TDDFieldDef);
- begin
- Items[Index]:=AValue;
- end;
- constructor TFPDDFieldList.CreateFromTableDef(TD: TDDTableDef);
- begin
- CreateFromFieldDefs(TD.Fields);
- end;
- constructor TFPDDFieldList.CreateFromFieldDefs(FD: TDDFieldDefs);
- Var
- I : Integer;
- begin
- Inherited Create;
- Capacity:=FD.Count;
- For I:=0 to FD.Count-1 do
- Add(FD[i]);
- end;
- function TFPDDIndexList.GetIndexDef(AIndex: Integer): TDDIndexDef;
- begin
- Result:=TDDIndexDef(Items[AIndex]);
- end;
- procedure TFPDDIndexList.SetIndexDef(AIndex: Integer; const AValue: TDDIndexDef
- );
- begin
- Items[AIndex]:=AValue
- end;
- constructor TFPDDIndexList.CreateFromIndexDefs(FD: TDDIndexDefs);
- var
- I : Integer;
- begin
- Inherited Create;
- For I:=0 to FD.Count-1 do
- Add(FD[I]);
- end;
- { TDDIndexDef }
- function TDDIndexDef.GetSectionName: String;
- begin
- Result:=IndexName;
- end;
- procedure TDDIndexDef.SetSectionName(const Value: String);
- begin
- IndexName:=Value;
- end;
- procedure TDDIndexDef.Assign(ASource: TPersistent);
- Var
- DD : TDDIndexDef;
- D : TIndexDef;
- begin
- If ASource is TDDIndexDef then
- begin
- DD:=ASource as TDDIndexDef;
- IndexName:=DD.IndexName;
- Expression:=DD.Expression;
- Fields:=DD.Expression;
- CaseInsFields:=DD.CaseInsFields;
- DescFields:=DD.DescFields;
- Options:=DD.Options;
- Source:=DD.Source;
- end
- else if ASource is TIndexDef then
- begin
- D:=ASource as TIndexDef;
- IndexName:=D.Name;
- Expression:=D.Expression;
- Fields:=D.Fields;
- CaseInsFields:=D.CaseInsFields;
- DescFields:=D.DescFields;
- Options:=D.Options;
- Source:=D.Source;
- end
- else
- inherited Assign(ASource);
- end;
- procedure TDDIndexDef.SaveToIni(Ini: TCustomInifile; ASection: String);
- Var
- O : Integer;
- T : PTypeInfo;
-
- begin
- With Ini do
- begin
- WriteString(ASection,KeyExpression,Expression);
- WriteString(ASection,KeyFields,Fields);
- WriteString(ASection,KeyCaseInsFields,CaseInsFields);
- WriteString(ASection,KeyDescFields,DescFields);
- WriteString(ASection,KeySource,Source);
- O:=Integer(self.Options);
- T:=TypeInfo(TIndexOptions);
- WriteString(ASection,KeyOptions,SetToString(T,O,False));
- end;
- end;
- procedure TDDIndexDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
- Var
- O : Integer;
- OP : TIndexOptions;
- T : PTypeInfo;
- S : String;
- begin
- With Ini do
- begin
- Expression:=ReadString(ASection,KeyExpression,'');
- Fields:=ReadString(ASection,KeyFields,'');
- CaseInsFields:=ReadString(ASection,KeyCaseInsFields,'');
- DescFields:=ReadString(ASection,KeyDescFields,'');
- Source:=ReadString(ASection,KeySource,'');
- S:=ReadString(ASection,KeyOptions,'');
- T:=TypeInfo(TIndexOptions);
- O:=StringToSet(T,S);
- OP:=TIndexOptions(O);
- Self.Options:=OP;
- end;
- end;
- { TDDIndexDefs }
- function TDDIndexDefs.GetIndex(Index : Integer): TDDIndexDef;
- begin
- Result:=Items[Index] as TDDIndexDef;
- end;
- procedure TDDIndexDefs.SetIndex(Index : Integer; const AValue: TDDIndexDef);
- begin
- Items[Index]:=AValue;
- end;
- procedure TDDIndexDefs.SetTableName(const AValue: String);
- begin
- Inherited;
- FSectionPrefix:=AValue;
- GlobalSection:=AValue+SIndexSuffix;
- end;
- constructor TDDIndexDefs.Create(ATableDef: TDDTableDef);
- begin
- FTableDef:=ATableDef;
- If Assigned(FTableDef) then
- Create(FTableDef.TableName)
- else
- Create('')
- end;
- constructor TDDIndexDefs.Create(const ATableName: String);
- begin
- FPrefix:='Index';
- TableName:=ATableName;
- Inherited Create(TDDIndexDef);
- end;
- function TDDIndexDefs.AddDDIndexDef(AName: String): TDDIndexDef;
- begin
- result := AddIndex (AName);
- end;
- function TDDIndexDefs.AddIndex(const AName: String): TDDIndexDef;
- begin
- Result:=Add as TDDIndexDef;
- Result.IndexName:=AName;
- end;
- { TDDForeignKeyDef }
- procedure TDDForeignKeyDef.SetKeyName(const AValue: String);
- begin
- if FKeyName=AValue then exit;
- FKeyName:=AValue;
- end;
- function TDDForeignKeyDef.GetSectionName: String;
- begin
- Result:=FKeyName;
- end;
- procedure TDDForeignKeyDef.SetSectionName(const Value: String);
- begin
- FkeyName:=Value;
- end;
- procedure TDDForeignKeyDef.Assign(ASource: TPersistent);
- Var
- K : TDDForeignKeyDef;
- begin
- if ASource is TDDForeignKeyDef then
- begin
- K:=ASource as TDDForeignKeyDef;
- FKeyFields:=K.KeyFields;
- FKeyName:=K.KeyName;
- FReferencedFields:=K.ReferencedFields;
- FTableName:=K.FTableName;
- end
- else
- inherited Assign(ASource);
- end;
- procedure TDDForeignKeyDef.SaveToIni(Ini: TCustomInifile; ASection: String);
- begin
- With Ini Do
- begin
- WriteString(ASection,KeyKeyFields,KeyFields);
- WriteString(ASection,KeyKeyName,KeyName);
- WriteString(ASection,KeyReferencesTable,ReferencesTable);
- WriteString(ASection,KeyReferencedFields,ReferencedFields);
- end;
- end;
- procedure TDDForeignKeyDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
- begin
- With Ini Do
- begin
- KeyFields:=ReadString(ASection,KeyKeyFields,'');
- KeyName:=ReadString(ASection,KeyKeyName,'');
- ReferencesTable:=ReadString(ASection,KeyReferencesTable,'');
- ReferencedFields:=ReadString(ASection,KeyReferencedFields,'');
- end;
- end;
- { TDDForeignKeyDefs }
- function TDDForeignKeyDefs.GetKey(AIndex : Integer): TDDForeignKeyDef;
- begin
- Result:=TDDForeignKeyDef(Items[AIndex]);
- end;
- procedure TDDForeignKeyDefs.SetKey(AIndex : Integer; const AValue: TDDForeignKeyDef
- );
- begin
- Items[AIndex]:=AValue
- end;
- procedure TDDForeignKeyDefs.SetTableName(const AValue: String);
- begin
- if FTableName=AValue then exit;
- FSectionPrefix:=AValue;
- GlobalSection:=AValue+SKeySuffix;
- end;
- constructor TDDForeignKeyDefs.Create(const ATableName: String);
- begin
- Inherited Create(TDDForeignKeyDef);
- FPrefix:='Key';
- SetTableName(ATAbleName);
- end;
- function TDDForeignKeyDefs.AddForeignKeyDef(const AName: String): TDDForeignKeyDef;
- begin
- Result:=Add as TDDForeignKeyDef;
- Result.KeyName:=AName;
- end;
- function TDDIndexDefs.IndexOfIndex(const AIndexName: String): Integer;
- begin
- Result:=Count-1;
- While (Result>=0) and (CompareText(GetIndex(Result).IndexName,AIndexName)<>0) do
- Dec(Result)
- end;
- function TDDIndexDefs.FindIndex(const AIndexName: String): TDDIndexDef;
- Var
- I : integer;
- begin
- I:=IndexOfIndex(AIndexName);
- If (I=-1) then
- Result:=Nil
- else
- Result:=GetIndex(I);
- end;
- function TDDIndexDefs.IndexByName(const AIndexName: String): TDDIndexDef;
- begin
- Result:=FindIndex(AIndexName);
- If Result=Nil then
- Raise EDatadict.CreateFmt(SErrIndexNotFound,[TableName,AIndexName]);
- end;
- { TDDDomainDefs }
- function TDDDomainDefs.GetDomain(Index: Integer): TDDDomainDef;
- begin
- Result:=TDDDomainDef(Items[Index]);
- end;
- procedure TDDDomainDefs.SetDomain(Index: Integer;
- const AValue: TDDDomainDef);
- begin
- Items[Index]:=AValue;
- end;
- constructor TDDDomainDefs.Create;
- begin
- FPrefix:='Domain';
- FSectionPrefix:='Domain';
- GlobalSection:='Domains';
- inherited Create(TDDDomainDef);
- end;
- function TDDDomainDefs.AddDomain(const ADomainName: String): TDDDomainDef;
- begin
- Result:=Add as TDDDomainDef;
- Result.DomainName:=ADomainName;
- end;
- function TDDDomainDefs.IndexOfDomain(const ADomainName: String): Integer;
- begin
- Result := Count;
- repeat
- Dec(Result);
- until (Result < 0) or (CompareText(GetDomain(Result).DomainName,ADomainName) = 0);
- end;
- function TDDDomainDefs.FindDomain(const ADomainName: String): TDDDomainDef;
- Var
- I : Integer;
- begin
- I:=IndexOfDomain(ADomainName);
- If (I=-1) then
- Result:=Nil
- else
- Result:=GetDomain(I);
- end;
- function TDDDomainDefs.DomainByName(const ADomainName: String): TDDDomainDef;
- begin
- Result:=FindDomain(ADomainName);
- If (Result=Nil) then
- Raise EDatadict.CreateFmt(SErrDomainNotFound,[ADomainName]);
- end;
- { TDDDomainDef }
- procedure TDDDomainDef.SetDomainName(const AValue: String);
- begin
- if FDomainName=AValue then exit;
- If Assigned(Collection) and
- ((Collection as TDDDomainDefs).FindDomain(AValue)<>Nil) then
- EDataDict.CreateFmt(SErrDuplicateDomain,[AValue]);
- FDomainName:=AValue;
- end;
- function TDDDomainDef.GetSectionName: String;
- begin
- Result:=FDomainName;
- end;
- procedure TDDDomainDef.SetSectionName(const Value: String);
- begin
- FDomainName:=Value;
- end;
- procedure TDDDomainDef.Assign(ASource: TPersistent);
- Var
- D : TDDDomainDef;
- begin
- if (ASource is TDDDomainDef) then
- begin
- D:=(ASource as TDDDomainDef);
- FDomainName:=D.DomainName;
- FFieldType:=D.FieldType;
- FCheckconstraint:=D.Checkconstraint;
- FSize:=D.Size;
- FPrecision:=D.Precision;
- end
- else
- inherited Assign(ASource);
- end;
- procedure TDDDomainDef.SaveToIni(Ini: TCustomInifile; ASection: String);
- begin
- With Ini do
- begin
- WriteInteger(ASection,KeyFieldType,Ord(Fieldtype));
- WriteBool(ASection,KeyRequired,Required);
- WriteString(ASection,KeyCheckConstraint,CheckConstraint);
- WriteInteger(ASection,KeySize,Size);
- WriteInteger(ASection,KeyPrecision,Precision);
- end;
- end;
- procedure TDDDomainDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
- begin
- With Ini do
- begin
- FieldType:=TFieldType(ReadInteger(ASection,KeyFieldType,Ord(Fieldtype)));
- Required:=ReadBool(ASection,KeyRequired,Required);
- CheckConstraint:=ReadString(ASection,KeyCheckConstraint,CheckConstraint);
- Size:=ReadInteger(ASection,KeySize,Size);
- Precision:=ReadInteger(ASection,KeyPrecision,Precision);
- end;
- end;
- { TFPDDDomainList }
- function TFPDDDomainList.GetDomainDef(AIndex: Integer): TDDDomainDef;
- begin
- Result:=TDDDomainDef(Items[AIndex]);
- end;
- procedure TFPDDDomainList.SetDomainDef(AIndex: Integer;
- const AValue: TDDDomainDef);
- begin
- Items[AIndex]:=AValue;
- end;
- constructor TFPDDDomainList.CreateFromDomainDefs(DD: TDDDomainDefs);
- Var
- I : Integer;
- begin
- Inherited Create;
- For I:=0 to DD.Count-1 do
- Add(DD[I]);
- end;
- { TDDSequenceDef }
- procedure TDDSequenceDef.SetSequenceName(const AValue: String);
- begin
- if FSequenceName=AValue then exit;
- If Assigned(Collection) and
- ((Collection as TDDSequenceDefs).FindSequence(AValue)<>Nil) then
- EDataDict.CreateFmt(SErrDuplicateSequence,[AValue]);
- FSequenceName:=AValue;
- end;
- function TDDSequenceDef.GetSectionName: String;
- begin
- Result:=SequenceName;
- end;
- procedure TDDSequenceDef.SetSectionName(const Value: String);
- begin
- SequenceName:=Value;
- end;
- procedure TDDSequenceDef.Assign(ASource: TPersistent);
- Var
- S : TDDSequenceDef;
- begin
- If ASource is TDDSequenceDef then
- begin
- S:=ASource as TDDSequenceDef;
- FSequenceName:=S.SequenceName;
- FStartvalue:=S.Startvalue;
- FIncrement:=S.Increment;
- end
- else
- inherited Assign(ASource);
- end;
- procedure TDDSequenceDef.SaveToIni(Ini: TCustomInifile; ASection: String);
- begin
- With Ini do
- begin
- WriteInteger(ASection,KeyStartValue,StartValue);
- WriteInteger(ASection,KeyIncrement,StartValue);
- end;
- end;
- procedure TDDSequenceDef.LoadFromIni(Ini: TCustomInifile; ASection: String);
- begin
- With Ini do
- begin
- StartValue:=ReadInteger(ASection,KeyStartValue,0);
- Increment:=ReadInteger(ASection,KeyIncrement,0);
- end;
- end;
- { TDDSequenceDefs }
- function TDDSequenceDefs.GetSequence(Index: Integer): TDDSequenceDef;
- begin
- Result:=TDDSequenceDef(Items[Index]);
- end;
- procedure TDDSequenceDefs.SetSequence(Index: Integer; const AValue: TDDSequenceDef);
- begin
- Items[Index]:=AValue;
- end;
- constructor TDDSequenceDefs.Create;
- begin
- FPrefix:='Sequence';
- FSectionPrefix:='Sequence';
- GlobalSection:='Sequences';
- Inherited Create(TDDSequenceDef);
- end;
- function TDDSequenceDefs.AddSequence(const ASequenceName: String): TDDSequenceDef;
- begin
- Result:=Add as TDDSequenceDef;
- Result.SequenceName:=ASequenceName;
- end;
- function TDDSequenceDefs.IndexOfSequence(const ASequenceName: String): Integer;
- begin
- result := count;
- repeat
- Dec(Result);
- until (Result<0) or (CompareText(GetSequence(Result).SequenceName,ASequenceName)=0);
- end;
- function TDDSequenceDefs.FindSequence(const ASequenceName: String): TDDSequenceDef;
- Var
- I : Integer;
- begin
- I:=IndexOfSequence(ASequenceName);
- If (I=-1) then
- Result:=Nil
- else
- Result:=GetSequence(I);
- end;
- function TDDSequenceDefs.SequenceByName(const ASequenceName: String): TDDSequenceDef;
- begin
- Result:=FindSequence(ASequenceName);
- If (Result=Nil) then
- Raise EDatadict.CreateFmt(SErrSequenceNotFound,[ASequenceName]);
- end;
- { TFPDDSequenceList }
- function TFPDDSequenceList.GetSequenceDef(AIndex: Integer): TDDSequenceDef;
- begin
- Result:=TDDSequenceDef(Items[AIndex]);
- end;
- procedure TFPDDSequenceList.SetSequenceDef(AIndex: Integer;
- const AValue: TDDSequenceDef);
- begin
- Items[AIndex]:=AValue;
- end;
- constructor TFPDDSequenceList.CreateFromSequenceDefs(SD: TDDSequenceDefs);
- Var
- I : Integer;
- begin
- Inherited Create;
- For I:=0 to SD.Count-1 do
- Add(SD[I]);
- end;
- { TDDTableCollection }
- function TDDTableCollection.GetTableName: String;
- begin
- If Assigned(FTableDef) then
- Result:=FTableDef.TableName
- else
- Result:=FTableName;
- end;
- procedure TDDTableCollection.SetTableDef(ATableDef: TDDTableDef);
- begin
- FTableDef:=ATableDef;
- If Assigned(FTableDef) then
- TableName:=FTableDef.TableName;
- end;
- procedure TDDTableCollection.SetTableName(const AValue: String);
- begin
- FTableName:=AValue;
- end;
- function TDDTableCollection.DataDictionary: TFPDataDictionary;
- begin
- If Assigned(FTableDef) then
- Result:=FTableDef.DataDictionary
- else
- Result:=Nil;
- end;
- initialization
- finalization
- if assigned(DDEngines) then FreeAndNil(DDEngines);
- end.
|