sqldb.pp 114 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080
  1. {
  2. Copyright (c) 2004-2014 by Joost van der Sluis, FPC contributors
  3. SQL database & dataset
  4. See the file COPYING.FPC, included in this distribution,
  5. for details about the copyright.
  6. This program is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  9. **********************************************************************}
  10. unit SQLDB;
  11. {$mode objfpc}
  12. {$H+}
  13. {$M+} // ### remove this!!!
  14. interface
  15. uses SysUtils, Classes, DB, bufdataset, sqlscript, sqltypes;
  16. type
  17. TSchemaType = sqltypes.TSchemaType;
  18. TStatementType = sqltypes.TStatementType;
  19. TDBEventType = sqltypes.TDBEventType;
  20. TDBEventTypes = sqltypes.TDBEventTypes;
  21. TQuoteChars = sqltypes.TQuoteChars;
  22. const
  23. StatementTokens : Array[TStatementType] of string = ('(unknown)', 'select',
  24. 'insert', 'update', 'delete',
  25. 'create', 'get', 'put', 'execute',
  26. 'start','commit','rollback', '?'
  27. );
  28. TSchemaObjectNames: array[TSchemaType] of String = ('???', 'table_name',
  29. '???', 'procedure_name', 'column_name', 'param_name',
  30. 'index_name', 'package_name', 'schema_name','sequence');
  31. SingleQuotes : TQuoteChars = ('''','''');
  32. DoubleQuotes : TQuoteChars = ('"','"');
  33. LogAllEvents = [detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack];
  34. LogAllEventsExtra = [detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack, detParamValue,detActualSQL];
  35. // Backwards compatibility alias constants.
  36. stNoSchema = sqltypes.stNoSchema;
  37. stTables = sqltypes.stTables;
  38. stSysTables = sqltypes.stSysTables;
  39. stProcedures = sqltypes.stProcedures;
  40. stColumns = sqltypes.stColumns;
  41. stProcedureParams = sqltypes.stProcedureParams;
  42. stIndexes = sqltypes.stIndexes;
  43. stPackages = sqltypes.stPackages;
  44. stSchemata = sqltypes.stSchemata;
  45. stSequences = sqltypes.stSequences;
  46. stUnknown = sqltypes.stUnknown;
  47. stSelect = sqltypes.stSelect;
  48. stInsert = sqltypes.stInsert;
  49. stUpdate = sqltypes.stUpdate;
  50. stDelete = sqltypes.stDelete;
  51. stDDL = sqltypes.stDDL;
  52. stGetSegment = sqltypes.stGetSegment;
  53. stPutSegment = sqltypes.stPutSegment;
  54. stExecProcedure = sqltypes.stExecProcedure;
  55. stStartTrans = sqltypes.stStartTrans;
  56. stCommit = sqltypes.stCommit;
  57. stRollback = sqltypes.stRollback;
  58. stSelectForUpd = sqltypes.stSelectForUpd;
  59. detCustom = sqltypes.detCustom;
  60. detPrepare = sqltypes.detPrepare;
  61. detExecute = sqltypes.detExecute;
  62. detFetch = sqltypes.detFetch;
  63. detCommit = sqltypes.detCommit;
  64. detRollBack = sqltypes.detRollBack;
  65. detParamValue = sqltypes.detParamValue;
  66. detActualSQL = sqltypes.detActualSQL;
  67. DefaultMacroChar = '%';
  68. Type
  69. TRowsCount = LargeInt;
  70. TSQLStatementInfo = Record
  71. StatementType : TStatementType;
  72. TableName : String;
  73. Updateable : Boolean;
  74. WhereStartPos ,
  75. WhereStopPos : integer;
  76. end;
  77. TSQLConnection = class;
  78. TSQLTransaction = class;
  79. TCustomSQLQuery = class;
  80. TCustomSQLStatement = Class;
  81. TSQLQuery = class;
  82. TSQLScript = class;
  83. TSQLHandle = Class(TObject)
  84. end;
  85. { TSQLCursor }
  86. TSQLCursor = Class(TSQLHandle)
  87. public
  88. FDirect : Boolean;
  89. FPrepared : Boolean;
  90. FSelectable : Boolean;
  91. FInitFieldDef : Boolean;
  92. FStatementType : TStatementType;
  93. FSchemaType : TSchemaType;
  94. end;
  95. { ESQLDatabaseError}
  96. ESQLDatabaseError = class(EDatabaseError)
  97. public
  98. ErrorCode: integer;
  99. SQLState : string;
  100. constructor CreateFmt(const Fmt: string; const Args: array of const;
  101. Comp : TComponent; AErrorCode: integer; const ASQLState: string); overload;
  102. end;
  103. { TSQLDBFieldDef }
  104. TSQLDBFieldDef = Class(TFieldDef)
  105. private
  106. FData: Pointer;
  107. Public
  108. Property SQLDBData : Pointer Read FData Write FData;
  109. end;
  110. { TSQLDBFieldDefs }
  111. TSQLDBFieldDefs = Class(TFieldDefs)
  112. Protected
  113. Class Function FieldDefClass : TFieldDefClass; override;
  114. end;
  115. { TSQLDBParam }
  116. TSQLDBParam = Class(TParam)
  117. private
  118. FFieldDef: TFieldDef;
  119. FData : Pointer;
  120. Public
  121. Property FieldDef : TFieldDef Read FFieldDef Write FFieldDef;
  122. Property SQLDBData : Pointer Read FData Write FData;
  123. end;
  124. { TSQLDBParams }
  125. TSQLDBParams = Class(TParams)
  126. Protected
  127. Class Function ParamClass : TParamClass; override;
  128. end;
  129. type
  130. { TServerIndexDefs }
  131. TServerIndexDefs = class(TIndexDefs)
  132. Private
  133. public
  134. constructor Create(ADataSet: TDataSet); override;
  135. procedure Update; override;
  136. end;
  137. type
  138. { TSQLConnection }
  139. TDBLogNotifyEvent = Procedure (Sender : TSQLConnection; EventType : TDBEventType; Const Msg : String) of object;
  140. TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning,sqSequences);
  141. TConnOptions= set of TConnOption;
  142. TSQLConnectionOption = (scoExplicitConnect, scoApplyUpdatesChecksRowsAffected);
  143. TSQLConnectionOptions = Set of TSQLConnectionOption;
  144. TConnInfoType=(citAll=-1, citServerType, citServerVersion, citServerVersionString, citClientName, citClientVersion);
  145. TSQLConnection = class (TDatabase)
  146. private
  147. FFieldNameQuoteChars : TQuoteChars;
  148. FOptions : TSQLConnectionOptions;
  149. FPassword : string;
  150. FTransaction : TSQLTransaction;
  151. FUserName : string;
  152. FHostName : string;
  153. FCharSet : string;
  154. FCodePage : TSystemCodePage;
  155. FRole : String;
  156. FStatements : TThreadList;
  157. FLogEvents: TDBEventTypes;
  158. FOnLog: TDBLogNotifyEvent;
  159. function GetPort: cardinal;
  160. procedure SetOptions(AValue: TSQLConnectionOptions);
  161. procedure SetPort(const AValue: cardinal);
  162. function AttemptCommit(trans : TSQLHandle) : boolean;
  163. function AttemptRollBack(trans : TSQLHandle) : boolean;
  164. protected
  165. FConnOptions : TConnOptions;
  166. FSQLFormatSettings : TFormatSettings;
  167. // Updating of DB records is moved out of TSQLQuery.
  168. // It is done here, so descendents can override it and implement DB-specific.
  169. // One day, this may be factored out to a TSQLResolver class.
  170. // The following allow construction of update queries. They can be adapted as needed by descendents to fit the DB engine.
  171. procedure AddFieldToUpdateWherePart(var sql_where: string; UpdateMode : TUpdateMode; F: TField); virtual;
  172. function ConstructInsertSQL(Query: TCustomSQLQuery; Var ReturningClause : Boolean): string; virtual;
  173. function ConstructUpdateSQL(Query: TCustomSQLQuery; Var ReturningClause : Boolean): string; virtual;
  174. function ConstructDeleteSQL(Query: TCustomSQLQuery): string; virtual;
  175. function ConstructRefreshSQL(Query: TCustomSQLQuery; UpdateKind : TUpdateKind): string; virtual;
  176. // factory function used to create custom statements
  177. function CreateCustomQuery(aOwner: TComponent): TCustomSQLQuery; virtual;
  178. function InitialiseUpdateStatement(Query: TCustomSQLQuery; var qry: TCustomSQLQuery): TCustomSQLQuery;
  179. procedure ApplyFieldUpdate(C : TSQLCursor; P: TSQLDBParam; F: TField; UseOldValue: Boolean); virtual;
  180. // This is the call that updates a record, it used to be in TSQLQuery.
  181. procedure ApplyRecUpdate(Query : TCustomSQLQuery; UpdateKind : TUpdateKind); virtual;
  182. function RefreshLastInsertID(Query : TCustomSQLQuery; Field : TField): Boolean; virtual;
  183. procedure GetDBInfo(const ASchemaType : TSchemaType; const ASchemaObjectName, AReturnField : string; AList: TStrings);
  184. function PortParamName: string; virtual;
  185. function GetConnectionCharSet: string; virtual;
  186. procedure SetTransaction(Value : TSQLTransaction); virtual;
  187. procedure DoConnect; override;
  188. procedure DoInternalConnect; override;
  189. procedure DoInternalDisconnect; override;
  190. function GetAsString(Param: TParam): RawByteString;
  191. function GetAsSQLText(Field : TField) : string; overload; virtual;
  192. function GetAsSQLText(Param : TParam) : string; overload; virtual;
  193. function GetHandle : pointer; virtual;
  194. Function LogEvent(EventType : TDBEventType) : Boolean;
  195. Procedure LogParams(Const AParams : TParams); virtual;
  196. Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
  197. Procedure RegisterStatement(S : TCustomSQLStatement);
  198. Procedure UnRegisterStatement(S : TCustomSQLStatement);
  199. Function AllocateCursorHandle : TSQLCursor; virtual; abstract;
  200. Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); virtual; abstract;
  201. function StrToStatementType(s : string) : TStatementType; virtual;
  202. procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); virtual; abstract;
  203. procedure UnPrepareStatement(cursor : TSQLCursor); virtual; abstract;
  204. procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); virtual; abstract;
  205. function RowsAffected(cursor: TSQLCursor): TRowsCount; virtual;
  206. function Fetch(cursor : TSQLCursor) : boolean; virtual; abstract;
  207. procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TFieldDefs); virtual; abstract;
  208. function AddFieldDef(AFieldDefs: TFieldDefs; AFieldNo: Longint; const AName: string; ADataType: TFieldType; ASize, APrecision: Integer; AByteSize, ARequired, AReadOnly: Boolean): TFieldDef;
  209. function LoadField(cursor : TSQLCursor; FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean; virtual; abstract;
  210. procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); virtual; abstract;
  211. procedure FreeFldBuffers(cursor : TSQLCursor); virtual;
  212. Function AllocateTransactionHandle : TSQLHandle; virtual; abstract;
  213. function GetTransactionHandle(trans : TSQLHandle): pointer; virtual; abstract;
  214. function Commit(trans : TSQLHandle) : boolean; virtual; abstract;
  215. function RollBack(trans : TSQLHandle) : boolean; virtual; abstract;
  216. function StartImplicitTransaction(trans : TSQLHandle; aParams : string) : boolean; virtual;
  217. function StartDBTransaction(trans : TSQLHandle; aParams : string) : boolean; virtual; abstract;
  218. procedure CommitRetaining(trans : TSQLHandle); virtual; abstract;
  219. procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract;
  220. procedure UpdateIndexDefs(IndexDefs : TIndexDefs; TableName : string); virtual;
  221. function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
  222. function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; virtual;
  223. Procedure MaybeConnect;
  224. Property Statements : TThreadList Read FStatements;
  225. property Port: cardinal read GetPort write SetPort;
  226. property CodePage: TSystemCodePage read FCodePage;
  227. public
  228. constructor Create(AOwner: TComponent); override;
  229. destructor Destroy; override;
  230. procedure StartTransaction; override;
  231. procedure EndTransaction; override;
  232. procedure ExecuteDirect(SQL : String); overload; virtual;
  233. procedure ExecuteDirect(SQL : String; ATransaction : TSQLTransaction); overload; virtual;
  234. // Unified version
  235. function GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual;
  236. // Older versions.
  237. procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); virtual;
  238. procedure GetProcedureNames(List : TStrings); virtual;
  239. procedure GetFieldNames(const TableName : string; List : TStrings); virtual;
  240. procedure GetSchemaNames(List: TStrings); virtual;
  241. procedure GetSequenceNames(List: TStrings); virtual;
  242. function GetConnectionInfo(InfoType:TConnInfoType): string; virtual;
  243. function GetStatementInfo(const ASQL: string): TSQLStatementInfo; virtual;
  244. procedure CreateDB; virtual;
  245. procedure DropDB; virtual;
  246. function GetNextValue(const SequenceName: string; IncrementBy: integer=1): Int64; virtual;
  247. property ConnOptions: TConnOptions read FConnOptions;
  248. property Handle: Pointer read GetHandle;
  249. property FieldNameQuoteChars: TQuoteChars read FFieldNameQuoteChars write FFieldNameQuoteChars;
  250. published
  251. property Password : string read FPassword write FPassword;
  252. property Transaction : TSQLTransaction read FTransaction write SetTransaction;
  253. property UserName : string read FUserName write FUserName;
  254. property CharSet : string read FCharSet write FCharSet;
  255. property HostName : string Read FHostName Write FHostName;
  256. Property OnLog : TDBLogNotifyEvent Read FOnLog Write FOnLog;
  257. Property LogEvents : TDBEventTypes Read FLogEvents Write FLogEvents Default LogAllEvents;
  258. Property Options : TSQLConnectionOptions Read FOptions Write SetOptions default [];
  259. Property Role : String read FRole write FRole;
  260. property Connected;
  261. property DatabaseName;
  262. property KeepConnection;
  263. property LoginPrompt;
  264. property Params;
  265. property OnLogin;
  266. end;
  267. { TSQLTransaction }
  268. TCommitRollbackAction = (caNone, caCommit, caCommitRetaining, caRollback,
  269. caRollbackRetaining);
  270. TSQLTransactionOption = (stoUseImplicit, stoExplicitStart);
  271. TSQLTransactionOptions = Set of TSQLTransactionOption;
  272. TSQLTransaction = class (TDBTransaction)
  273. private
  274. FOptions : TSQLTransactionOptions;
  275. FTrans : TSQLHandle;
  276. FAction : TCommitRollbackAction;
  277. FParams : TStringList;
  278. function GetSQLConnection: TSQLConnection;
  279. procedure SetOptions(AValue: TSQLTransactionOptions);
  280. procedure SetParams(const AValue: TStringList);
  281. procedure SetSQLConnection(AValue: TSQLConnection);
  282. protected
  283. Procedure MaybeStartTransaction;
  284. Function AllowClose(DS: TDBDataset): Boolean; override;
  285. function GetHandle : Pointer; virtual;
  286. Procedure SetDatabase (Value : TDatabase); override;
  287. Function LogEvent(EventType : TDBEventType) : Boolean;
  288. Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
  289. public
  290. constructor Create(AOwner : TComponent); override;
  291. destructor Destroy; override;
  292. procedure Commit; override;
  293. procedure CommitRetaining; override;
  294. procedure Rollback; override;
  295. procedure RollbackRetaining; override;
  296. procedure StartTransaction; override;
  297. procedure EndTransaction; override;
  298. property Handle: Pointer read GetHandle;
  299. Property SQLConnection : TSQLConnection Read GetSQLConnection Write SetSQLConnection;
  300. published
  301. property Action : TCommitRollbackAction read FAction write FAction Default caRollBack;
  302. property Database;
  303. property Params : TStringList read FParams write SetParams;
  304. Property Options : TSQLTransactionOptions Read FOptions Write SetOptions default [];
  305. end;
  306. { TCustomSQLStatement }
  307. TCustomSQLStatement = Class(TComponent)
  308. Private
  309. FCursor : TSQLCursor;
  310. FDatabase: TSQLConnection;
  311. FParamCheck: Boolean;
  312. FParams: TParams;
  313. FMacroCheck: Boolean;
  314. FMacroChar: Char;
  315. FMacros: TParams;
  316. FSQL: TStrings;
  317. FOrigSQL : String;
  318. FServerSQL : String;
  319. FTransaction: TSQLTransaction;
  320. FParseSQL: Boolean;
  321. FDoUnPrepare : Boolean;
  322. FDataLink : TDataLink;
  323. FRowsAffected : TRowsCount;
  324. function ExpandMacros(const OrigSQL: String): String;
  325. procedure SetDatabase(AValue: TSQLConnection);
  326. procedure SetMacroChar(AValue: Char);
  327. procedure SetMacroCheck(AValue: Boolean);
  328. procedure SetParams(AValue: TParams);
  329. procedure SetMacros(AValue: TParams);
  330. procedure SetSQL(AValue: TStrings);
  331. procedure SetTransaction(AValue: TSQLTransaction);
  332. procedure RecreateMacros;
  333. Function GetPrepared : Boolean;
  334. Procedure CheckUnprepare;
  335. Procedure CheckPrepare;
  336. Function HasParams : Boolean;
  337. Function HasMacros : Boolean;
  338. Protected
  339. Function CreateDataLink : TDataLink; virtual;
  340. procedure OnChangeSQL(Sender : TObject); virtual;
  341. function GetDataSource: TDataSource; Virtual;
  342. procedure SetDataSource(AValue: TDataSource); virtual;
  343. Procedure CopyParamsFromMaster(CopyBound : Boolean); virtual;
  344. procedure AllocateCursor;
  345. procedure DeAllocateCursor;
  346. Function GetSchemaType : TSchemaType; virtual;
  347. Function GetSchemaObjectName : String; virtual;
  348. Function GetSchemaPattern: String; virtual;
  349. Function IsSelectable : Boolean ; virtual;
  350. procedure GetStatementInfo(var ASQL: String; out Info: TSQLStatementInfo); virtual;
  351. Procedure DoExecute; virtual;
  352. procedure DoPrepare; virtual;
  353. procedure DoUnPrepare; virtual;
  354. Function CreateParams : TSQLDBParams; virtual;
  355. Function LogEvent(EventType : TDBEventType) : Boolean;
  356. Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
  357. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  358. Property Cursor : TSQLCursor read FCursor;
  359. Property Database : TSQLConnection Read FDatabase Write SetDatabase;
  360. Property Transaction : TSQLTransaction Read FTransaction Write SetTransaction;
  361. Property SQL : TStrings Read FSQL Write SetSQL;
  362. Property Params : TParams Read FParams Write SetParams stored HasParams;
  363. Property Macros : TParams Read FMacros Write SetMacros stored HasMacros;
  364. property MacroChar: Char read FMacroChar write SetMacroChar default DefaultMacroChar;
  365. Property DataSource : TDataSource Read GetDataSource Write SetDataSource;
  366. Property ParseSQL : Boolean Read FParseSQL Write FParseSQL;
  367. Property ParamCheck : Boolean Read FParamCheck Write FParamCheck default true;
  368. Property MacroCheck : Boolean Read FMacroCheck Write SetMacroCheck default false;
  369. Public
  370. constructor Create(AOwner : TComponent); override;
  371. destructor Destroy; override;
  372. Procedure Prepare;
  373. Procedure Execute;
  374. Procedure Unprepare;
  375. function ParamByName(Const AParamName : String) : TParam;
  376. function RowsAffected: TRowsCount; virtual;
  377. Property Prepared : boolean read GetPrepared;
  378. end;
  379. TSQLStatement = Class(TCustomSQLStatement)
  380. Published
  381. Property Database;
  382. Property DataSource;
  383. Property ParamCheck;
  384. Property Params;
  385. Property MacroCheck;
  386. Property Macros;
  387. Property ParseSQL;
  388. Property SQL;
  389. Property Transaction;
  390. end;
  391. { TSQLSequence }
  392. TSQLSequenceApplyEvent = (saeOnNewRecord, saeOnPost);
  393. TSQLSequence = class(TPersistent)
  394. private
  395. FQuery: TCustomSQLQuery;
  396. FFieldName: String;
  397. FSequenceName: String;
  398. FIncrementBy: Integer;
  399. FApplyEvent: TSQLSequenceApplyEvent;
  400. public
  401. constructor Create(AQuery: TCustomSQLQuery);
  402. procedure Assign(Source: TPersistent); override;
  403. procedure Apply;
  404. function GetNextValue: Int64;
  405. published
  406. property FieldName: String read FFieldName write FFieldName;
  407. property SequenceName: String read FSequenceName write FSequenceName;
  408. property IncrementBy: Integer read FIncrementBy write FIncrementBy default 1;
  409. property ApplyEvent: TSQLSequenceApplyEvent read FApplyEvent write FApplyEvent default saeOnNewRecord;
  410. end;
  411. { TCustomSQLQuery }
  412. TSQLQueryOption = (sqoKeepOpenOnCommit, sqoAutoApplyUpdates, sqoAutoCommit, sqoCancelUpdatesOnRefresh, sqoRefreshUsingSelect);
  413. TSQLQueryOptions = Set of TSQLQueryOption;
  414. TCustomSQLQuery = class (TCustomBufDataset)
  415. private
  416. FOptions : TSQLQueryOptions;
  417. FSchemaType : TSchemaType;
  418. FUpdateable : boolean;
  419. FTableName : string;
  420. FStatement : TCustomSQLStatement;
  421. FInsertSQL,
  422. FUpdateSQL,
  423. FDeleteSQL,
  424. FRefreshSQL : TStringList;
  425. FIsEOF : boolean;
  426. FLoadingFieldDefs : boolean;
  427. FUpdateMode : TUpdateMode;
  428. FDoUnprepare : Boolean;
  429. FusePrimaryKeyAsKey : Boolean;
  430. FWhereStartPos : integer;
  431. FWhereStopPos : integer;
  432. FServerFilterText : string;
  433. FServerFiltered : Boolean;
  434. FServerIndexDefs : TServerIndexDefs;
  435. // Used by SetSchemaType
  436. FSchemaObjectName : string;
  437. FSchemaPattern : string;
  438. FInsertQry,
  439. FUpdateQry,
  440. FDeleteQry : TCustomSQLQuery;
  441. FSequence : TSQLSequence;
  442. procedure CheckPrepare;
  443. procedure CheckUnPrepare;
  444. procedure FreeFldBuffers;
  445. function GetMacroChar: Char;
  446. function GetParamCheck: Boolean;
  447. function GetParams: TParams;
  448. function GetMacroCheck: Boolean;
  449. function GetMacros: TParams;
  450. function GetParseSQL: Boolean;
  451. function GetServerIndexDefs: TServerIndexDefs;
  452. function GetSQL: TStringList;
  453. function GetSQLConnection: TSQLConnection;
  454. function GetSQLTransaction: TSQLTransaction;
  455. function GetStatementType : TStatementType;
  456. function HasMacros: Boolean;
  457. Function HasParams : Boolean;
  458. Function NeedLastInsertID: TField;
  459. procedure SetMacroChar(AValue: Char);
  460. procedure SetOptions(AValue: TSQLQueryOptions);
  461. procedure SetParamCheck(AValue: Boolean);
  462. procedure SetMacroCheck(AValue: Boolean);
  463. procedure SetSQLConnection(AValue: TSQLConnection);
  464. procedure SetSQLTransaction(AValue: TSQLTransaction);
  465. procedure SetInsertSQL(const AValue: TStringList);
  466. procedure SetUpdateSQL(const AValue: TStringList);
  467. procedure SetDeleteSQL(const AValue: TStringList);
  468. procedure SetRefreshSQL(const AValue: TStringList);
  469. procedure SetParams(AValue: TParams);
  470. procedure SetMacros(AValue: TParams);
  471. procedure SetParseSQL(AValue : Boolean);
  472. procedure SetSQL(const AValue: TStringList);
  473. procedure SetUsePrimaryKeyAsKey(AValue : Boolean);
  474. procedure SetUpdateMode(AValue : TUpdateMode);
  475. procedure OnChangeModifySQL(Sender : TObject);
  476. procedure Execute;
  477. procedure ApplyFilter;
  478. Function AddFilter(const SQLstr : string) : string;
  479. protected
  480. procedure OpenCursor(InfoQuery: Boolean); override;
  481. function CreateSQLStatement(aOwner: TComponent): TCustomSQLStatement; virtual;
  482. Function CreateParams: TSQLDBParams; virtual;
  483. Function RefreshLastInsertID(Field: TField): Boolean; virtual;
  484. Function NeedRefreshRecord (UpdateKind: TUpdateKind): Boolean; virtual;
  485. Function RefreshRecord (UpdateKind: TUpdateKind) : Boolean; virtual;
  486. Procedure ApplyReturningResult(Q : TCustomSQLQuery; UpdateKind : TUpdateKind);
  487. Function Cursor : TSQLCursor;
  488. Function LogEvent(EventType : TDBEventType) : Boolean;
  489. Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
  490. // abstract & virtual methods of TBufDataset
  491. function Fetch : boolean; override;
  492. function LoadField(FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean; override;
  493. procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField); override;
  494. procedure ApplyRecUpdate(UpdateKind : TUpdateKind); override;
  495. procedure SetPacketRecords(aValue : integer); override;
  496. // abstract & virtual methods of TDataset
  497. procedure UpdateServerIndexDefs; virtual;
  498. procedure SetDatabase(Value : TDatabase); override;
  499. Procedure SetTransaction(Value : TDBTransaction); override;
  500. procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override;
  501. procedure InternalClose; override;
  502. procedure InternalInitFieldDefs; override;
  503. procedure InternalOpen; override;
  504. Procedure InternalRefresh; override;
  505. function GetCanModify: Boolean; override;
  506. Function IsPrepared : Boolean; virtual;
  507. procedure SetServerFiltered(Value: Boolean); virtual;
  508. procedure SetServerFilterText(const Value: string); virtual;
  509. Function GetDataSource : TDataSource; override;
  510. Procedure SetDataSource(AValue : TDataSource);
  511. procedure BeforeRefreshOpenCursor; override;
  512. procedure SetReadOnly(AValue : Boolean); override;
  513. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  514. procedure DoOnNewRecord; override;
  515. procedure DoBeforePost; override;
  516. class function FieldDefsClass : TFieldDefsClass; override;
  517. // IProviderSupport methods
  518. function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; override;
  519. function PSGetTableName: string; override;
  520. Property TableName : String Read FTableName Write FTableName; // alternative: procedure DoGetTableName
  521. public
  522. constructor Create(AOwner : TComponent); override;
  523. destructor Destroy; override;
  524. procedure Prepare; virtual;
  525. procedure UnPrepare; virtual;
  526. procedure ExecSQL; virtual;
  527. procedure SetSchemaInfo( ASchemaType : TSchemaType; ASchemaObjectName, ASchemaPattern : string); virtual;
  528. function RowsAffected: TRowsCount; virtual;
  529. function ParamByName(Const AParamName : String) : TParam;
  530. function MacroByName(Const AParamName : String) : TParam;
  531. Property Prepared : boolean read IsPrepared;
  532. Property SQLConnection : TSQLConnection Read GetSQLConnection Write SetSQLConnection;
  533. Property SQLTransaction: TSQLTransaction Read GetSQLTransaction Write SetSQLTransaction;
  534. // overriden TBufDataSet methods
  535. Procedure ApplyUpdates(MaxErrors: Integer); override; overload;
  536. // overriden TDataSet methods
  537. Procedure Post; override;
  538. Procedure Delete; override;
  539. protected
  540. // redeclared TDataSet properties
  541. property Active;
  542. property Filter;
  543. property Filtered;
  544. property BeforeOpen;
  545. property AfterOpen;
  546. property BeforeClose;
  547. property AfterClose;
  548. property BeforeInsert;
  549. property AfterInsert;
  550. property BeforeEdit;
  551. property AfterEdit;
  552. property BeforePost;
  553. property AfterPost;
  554. property BeforeCancel;
  555. property AfterCancel;
  556. property BeforeDelete;
  557. property AfterDelete;
  558. property BeforeRefresh;
  559. property AfterRefresh;
  560. property BeforeScroll;
  561. property AfterScroll;
  562. property OnCalcFields;
  563. property OnDeleteError;
  564. property OnEditError;
  565. property OnFilterRecord;
  566. property OnNewRecord;
  567. property OnPostError;
  568. property AutoCalcFields;
  569. // protected
  570. property Database;
  571. property Transaction;
  572. property SchemaType : TSchemaType read FSchemaType default stNoSchema;
  573. property SQL : TStringlist read GetSQL write SetSQL;
  574. property InsertSQL : TStringList read FInsertSQL write SetInsertSQL;
  575. property UpdateSQL : TStringList read FUpdateSQL write SetUpdateSQL;
  576. property DeleteSQL : TStringList read FDeleteSQL write SetDeleteSQL;
  577. property RefreshSQL : TStringList read FRefreshSQL write SetRefreshSQL;
  578. Property Options : TSQLQueryOptions Read FOptions Write SetOptions default [];
  579. property Params : TParams read GetParams Write SetParams stored HasParams;
  580. Property ParamCheck : Boolean Read GetParamCheck Write SetParamCheck default true;
  581. property Macros : TParams read GetMacros Write SetMacros stored HasMacros;
  582. Property MacroCheck : Boolean Read GetMacroCheck Write SetMacroCheck default false;
  583. Property MacroChar : Char Read GetMacroChar Write SetMacroChar default DefaultMacroChar;
  584. property ParseSQL : Boolean read GetParseSQL write SetParseSQL default true;
  585. property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode default upWhereKeyOnly;
  586. property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey default true;
  587. property StatementType : TStatementType read GetStatementType;
  588. Property DataSource : TDataSource Read GetDataSource Write SetDataSource;
  589. property Sequence: TSQLSequence read FSequence write FSequence;
  590. property ServerFilter: string read FServerFilterText write SetServerFilterText;
  591. property ServerFiltered: Boolean read FServerFiltered write SetServerFiltered default False;
  592. property ServerIndexDefs : TServerIndexDefs read GetServerIndexDefs;
  593. end;
  594. { TSQLQuery }
  595. TSQLQuery = Class(TCustomSQLQuery)
  596. public
  597. property SchemaType;
  598. Property StatementType;
  599. Published
  600. property MaxIndexesCount;
  601. // TDataset stuff
  602. property FieldDefs;
  603. Property Active;
  604. Property AutoCalcFields;
  605. Property Filter;
  606. Property Filtered;
  607. Property AfterCancel;
  608. Property AfterClose;
  609. Property AfterDelete;
  610. Property AfterEdit;
  611. Property AfterInsert;
  612. Property AfterOpen;
  613. Property AfterPost;
  614. Property AfterRefresh;
  615. Property AfterScroll;
  616. Property BeforeCancel;
  617. Property BeforeClose;
  618. Property BeforeDelete;
  619. Property BeforeEdit;
  620. Property BeforeInsert;
  621. Property BeforeOpen;
  622. Property BeforePost;
  623. Property BeforeRefresh;
  624. Property BeforeScroll;
  625. Property OnCalcFields;
  626. Property OnDeleteError;
  627. Property OnEditError;
  628. Property OnFilterRecord;
  629. Property OnNewRecord;
  630. Property OnPostError;
  631. // property SchemaInfo default stNoSchema;
  632. property Database;
  633. property Transaction;
  634. property ReadOnly;
  635. property SQL;
  636. property InsertSQL;
  637. property UpdateSQL;
  638. property DeleteSQL;
  639. property RefreshSQL;
  640. property IndexDefs;
  641. Property Options;
  642. property Params;
  643. Property ParamCheck;
  644. property Macros;
  645. Property MacroCheck;
  646. Property MacroChar;
  647. property ParseSQL;
  648. property UpdateMode;
  649. property UsePrimaryKeyAsKey;
  650. Property DataSource;
  651. property Sequence;
  652. property ServerFilter;
  653. property ServerFiltered;
  654. property ServerIndexDefs;
  655. end;
  656. { TSQLScript }
  657. TSQLScript = class (TCustomSQLscript)
  658. private
  659. FOnDirective: TSQLScriptDirectiveEvent;
  660. FQuery : TCustomSQLQuery;
  661. FDatabase : TDatabase;
  662. FTransaction : TDBTransaction;
  663. protected
  664. procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override;
  665. procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override;
  666. procedure ExecuteCommit(CommitRetaining: boolean=true); override;
  667. Procedure SetDatabase (Value : TDatabase); virtual;
  668. Procedure SetTransaction(Value : TDBTransaction); virtual;
  669. Procedure CheckDatabase;
  670. function CreateQuery: TCustomSQLQuery; virtual;
  671. public
  672. constructor Create(AOwner : TComponent); override;
  673. destructor Destroy; override;
  674. procedure Execute; override;
  675. procedure ExecuteScript;
  676. Property Aborted;
  677. Property Line;
  678. published
  679. Property DataBase : TDatabase Read FDatabase Write SetDatabase;
  680. Property Transaction : TDBTransaction Read FTransaction Write SetTransaction;
  681. property OnDirective: TSQLScriptDirectiveEvent read FOnDirective write FOnDirective;
  682. Property AutoCommit;
  683. Property UseDollarString;
  684. Property DollarStrings;
  685. property Directives;
  686. property Defines;
  687. property Script;
  688. property Terminator;
  689. property CommentsinSQL;
  690. property UseSetTerm;
  691. property UseCommit;
  692. property UseDefines;
  693. property OnException;
  694. end;
  695. { TSQLConnector }
  696. TSQLConnector = Class(TSQLConnection)
  697. private
  698. FProxy : TSQLConnection;
  699. FConnectorType: String;
  700. procedure SetConnectorType(const AValue: String);
  701. protected
  702. procedure SetForcedClose(AValue: Boolean); override;
  703. procedure SetTransaction(Value : TSQLTransaction);override;
  704. procedure DoInternalConnect; override;
  705. procedure DoInternalDisconnect; override;
  706. Procedure CheckProxy;
  707. Procedure CreateProxy; virtual;
  708. Procedure FreeProxy; virtual;
  709. function StrToStatementType(s : string) : TStatementType; override;
  710. function GetAsSQLText(Field : TField) : string; overload; override;
  711. function GetAsSQLText(Param : TParam) : string; overload; override;
  712. function GetHandle : pointer; override;
  713. Function AllocateCursorHandle : TSQLCursor; override;
  714. Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
  715. Function AllocateTransactionHandle : TSQLHandle; override;
  716. procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); override;
  717. procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction; AParams : TParams); override;
  718. function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
  719. function Fetch(cursor : TSQLCursor) : boolean; override;
  720. procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); override;
  721. procedure UnPrepareStatement(cursor : TSQLCursor); override;
  722. function LoadField(cursor : TSQLCursor; FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean; override;
  723. procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction : TSQLTransaction); override;
  724. procedure FreeFldBuffers(cursor : TSQLCursor); override;
  725. function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; override;
  726. function GetTransactionHandle(trans : TSQLHandle): pointer; override;
  727. function Commit(trans : TSQLHandle) : boolean; override;
  728. function RollBack(trans : TSQLHandle) : boolean; override;
  729. function StartDBTransaction(trans : TSQLHandle; aParams : string) : boolean; override;
  730. procedure CommitRetaining(trans : TSQLHandle); override;
  731. procedure RollBackRetaining(trans : TSQLHandle); override;
  732. procedure UpdateIndexDefs(IndexDefs : TIndexDefs; TableName : string); override;
  733. function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
  734. Property Proxy : TSQLConnection Read FProxy;
  735. Published
  736. Property ConnectorType : String Read FConnectorType Write SetConnectorType;
  737. Property Port;
  738. end;
  739. TSQLConnectionClass = Class of TSQLConnection;
  740. { TConnectionDef }
  741. TLibraryLoadFunction = Function (Const S : AnsiString) : Integer;
  742. TLibraryUnLoadFunction = Procedure;
  743. TConnectionDef = Class(TPersistent)
  744. Class Function TypeName : String; virtual;
  745. Class Function ConnectionClass : TSQLConnectionClass; virtual;
  746. Class Function Description : String; virtual;
  747. Class Function DefaultLibraryName : String; virtual;
  748. Class Function LoadFunction : TLibraryLoadFunction; virtual;
  749. Class Function UnLoadFunction : TLibraryUnLoadFunction; virtual;
  750. Class Function LoadedLibraryName : string; virtual;
  751. Procedure ApplyParams(Params : TStrings; AConnection : TSQLConnection); virtual;
  752. end;
  753. TConnectionDefClass = class of TConnectionDef;
  754. Var
  755. GlobalDBLogHook : TDBLogNotifyEvent;
  756. Procedure RegisterConnection(Def : TConnectionDefClass);
  757. Procedure UnRegisterConnection(Def : TConnectionDefClass);
  758. Procedure UnRegisterConnection(const ConnectionName : String);
  759. Function GetConnectionDef(const ConnectorName : String) : TConnectionDef;
  760. Procedure GetConnectionList(List : TSTrings);
  761. const DefaultSQLFormatSettings : TFormatSettings = (
  762. CurrencyFormat: 1;
  763. NegCurrFormat: 5;
  764. ThousandSeparator: #0;
  765. DecimalSeparator: '.';
  766. CurrencyDecimals: 2;
  767. DateSeparator: '-';
  768. TimeSeparator: ':';
  769. ListSeparator: ' ';
  770. CurrencyString: '$';
  771. ShortDateFormat: 'yyyy-mm-dd';
  772. LongDateFormat: '';
  773. TimeAMString: '';
  774. TimePMString: '';
  775. ShortTimeFormat: 'hh:nn:ss';
  776. LongTimeFormat: 'hh:nn:ss.zzz';
  777. ShortMonthNames: ('','','','','','','','','','','','');
  778. LongMonthNames: ('','','','','','','','','','','','');
  779. ShortDayNames: ('','','','','','','');
  780. LongDayNames: ('','','','','','','');
  781. TwoDigitYearCenturyWindow: 50;
  782. );
  783. implementation
  784. uses dbconst, strutils;
  785. Const
  786. // Flags to check which fields must be refreshed.
  787. RefreshFlags : Array [ukModify..ukInsert] of TProviderFlag = (pfRefreshOnUpdate,pfRefreshOnInsert);
  788. function TimeIntervalToString(Time: TDateTime): string;
  789. var
  790. millisecond: word;
  791. second : word;
  792. minute : word;
  793. hour : word;
  794. begin
  795. DecodeTime(Time,hour,minute,second,millisecond);
  796. hour := hour + trunc(Time)*24;
  797. Result := Format('%.2d:%.2d:%.2d.%.3d',[hour,minute,second,millisecond]);
  798. end;
  799. { TSQLDBFieldDefs }
  800. class function TSQLDBFieldDefs.FieldDefClass: TFieldDefClass;
  801. begin
  802. Result:=TSQLDBFieldDef;
  803. end;
  804. { TSQLDBParams }
  805. class function TSQLDBParams.ParamClass: TParamClass;
  806. begin
  807. Result:=TSQLDBParam;
  808. end;
  809. { ESQLDatabaseError }
  810. constructor ESQLDatabaseError.CreateFmt(const Fmt: string; const Args: array of const;
  811. Comp: TComponent; AErrorCode: integer; const ASQLState: string);
  812. const CompNameFmt='%s : %s';
  813. var Msg: string;
  814. begin
  815. if not assigned(Comp) then
  816. Msg := Fmt
  817. else if Comp.Name = '' then
  818. Msg := Format(CompNameFmt, [Comp.ClassName,Fmt])
  819. else
  820. Msg := Format(CompNameFmt, [Comp.Name,Fmt]);
  821. if Length(Args) = 0 then
  822. inherited Create(Msg)
  823. else
  824. inherited CreateFmt(Msg, Args);
  825. ErrorCode := AErrorCode;
  826. SQLState := ASQLState;
  827. end;
  828. { TCustomSQLStatement }
  829. procedure TCustomSQLStatement.OnChangeSQL(Sender: TObject);
  830. var
  831. ConnOptions : TConnOptions;
  832. NewParams: TSQLDBParams;
  833. begin
  834. UnPrepare;
  835. RecreateMacros;
  836. if not ParamCheck then
  837. exit;
  838. if assigned(DataBase) then
  839. ConnOptions:=DataBase.ConnOptions
  840. else
  841. ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
  842. NewParams := CreateParams;
  843. try
  844. NewParams.ParseSQL(FSQL.Text, True, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions, psInterbase);
  845. NewParams.AssignValues(FParams);
  846. FParams.Assign(NewParams);
  847. finally
  848. NewParams.Free;
  849. end;
  850. end;
  851. procedure TCustomSQLStatement.SetDatabase(AValue: TSQLConnection);
  852. begin
  853. if FDatabase=AValue then Exit;
  854. UnPrepare;
  855. If Assigned(FDatabase) then
  856. begin
  857. FDatabase.UnregisterStatement(Self);
  858. FDatabase.RemoveFreeNotification(Self);
  859. end;
  860. FDatabase:=AValue;
  861. If Assigned(FDatabase) then
  862. begin
  863. FDatabase.FreeNotification(Self);
  864. FDatabase.RegisterStatement(Self);
  865. if Assigned(Database.Transaction) and (not Assigned(Transaction) or (Transaction.DataBase <> Database)) then
  866. Transaction := Database.Transaction;
  867. OnChangeSQL(Self);
  868. end;
  869. end;
  870. procedure TCustomSQLStatement.SetMacroChar(AValue: Char);
  871. begin
  872. if FMacroChar=AValue then Exit;
  873. FMacroChar:=AValue;
  874. RecreateMacros;
  875. end;
  876. procedure TCustomSQLStatement.SetMacroCheck(AValue: Boolean);
  877. begin
  878. if FMacroCheck=AValue then Exit;
  879. FMacroCheck:=AValue;
  880. RecreateMacros;
  881. end;
  882. procedure TCustomSQLStatement.SetTransaction(AValue: TSQLTransaction);
  883. begin
  884. if FTransaction=AValue then Exit;
  885. UnPrepare;
  886. if Assigned(FTransaction) then
  887. FTransaction.RemoveFreeNotification(Self);
  888. FTransaction:=AValue;
  889. if Assigned(FTransaction) then
  890. begin
  891. FTransaction.FreeNotification(Self);
  892. if Assigned(Transaction.DataBase) and (Database <> Transaction.DataBase) then
  893. Database := Transaction.DataBase as TSQLConnection;
  894. end;
  895. end;
  896. procedure TCustomSQLStatement.RecreateMacros;
  897. var
  898. NewParams: TSQLDBParams;
  899. ConnOptions: TConnOptions;
  900. PO : TSQLParseOptions;
  901. PB : TParamBinding;
  902. RS : String;
  903. begin
  904. if MacroCheck then begin
  905. if assigned(DataBase) then
  906. ConnOptions:=DataBase.ConnOptions
  907. else
  908. ConnOptions := [sqEscapeRepeat,sqEscapeSlash];
  909. NewParams := CreateParams;
  910. try
  911. PO:=[spoCreate,spoUseMacro];
  912. if sqEscapeSlash in ConnOptions then
  913. Include(PO,spoEscapeSlash);
  914. if sqEscapeRepeat in ConnOptions then
  915. Include(PO,spoEscapeRepeat);
  916. NewParams.ParseSQL(FSQL.Text, PO, psInterbase, PB, MacroChar,RS);
  917. NewParams.AssignValues(FMacros);
  918. FMacros.Assign(NewParams);
  919. finally
  920. NewParams.Free;
  921. end;
  922. end;
  923. end;
  924. procedure TCustomSQLStatement.SetDataSource(AValue: TDataSource);
  925. begin
  926. if GetDataSource=AValue then Exit;
  927. if (FDataLink=Nil) then
  928. FDataLink:=CreateDataLink;
  929. FDataLink.DataSource:=AValue;
  930. end;
  931. procedure TCustomSQLStatement.CopyParamsFromMaster(CopyBound: Boolean);
  932. begin
  933. if Assigned(DataSource) and Assigned(DataSource.Dataset) then
  934. FParams.CopyParamValuesFromDataset(DataSource.Dataset,CopyBound);
  935. end;
  936. procedure TCustomSQLStatement.SetParams(AValue: TParams);
  937. begin
  938. if FParams=AValue then Exit;
  939. FParams.Assign(AValue);
  940. end;
  941. procedure TCustomSQLStatement.SetMacros(AValue: TParams);
  942. begin
  943. if FMacros=AValue then Exit;
  944. FMacros.Assign(AValue);
  945. end;
  946. procedure TCustomSQLStatement.SetSQL(AValue: TStrings);
  947. begin
  948. if FSQL=AValue then Exit;
  949. FSQL.Assign(AValue);
  950. RecreateMacros;
  951. end;
  952. procedure TCustomSQLStatement.DoExecute;
  953. begin
  954. FRowsAffected:=-1;
  955. If (FParams.Count>0) and Assigned(DataSource) then
  956. CopyParamsFromMaster(False);
  957. If LogEvent(detExecute) then
  958. Log(detExecute,FServerSQL);
  959. Database.Execute(FCursor,Transaction, FParams);
  960. end;
  961. function TCustomSQLStatement.GetPrepared: Boolean;
  962. begin
  963. Result := Assigned(FCursor) and (FCursor.FPrepared or FCursor.FDirect);
  964. end;
  965. procedure TCustomSQLStatement.CheckUnprepare;
  966. begin
  967. if FDoUnPrepare then
  968. begin
  969. UnPrepare;
  970. FDoUnPrepare:=False;
  971. end;
  972. end;
  973. procedure TCustomSQLStatement.CheckPrepare;
  974. begin
  975. if Not Prepared then
  976. begin
  977. FDoUnprepare:=True;
  978. Prepare;
  979. end;
  980. end;
  981. function TCustomSQLStatement.CreateDataLink: TDataLink;
  982. begin
  983. Result:=TDataLink.Create;
  984. end;
  985. function TCustomSQLStatement.CreateParams: TSQLDBParams;
  986. begin
  987. Result:=TSQLDBParams.Create(Nil);
  988. end;
  989. Function TCustomSQLStatement.HasParams : Boolean;
  990. begin
  991. Result:=Params.Count>0;
  992. end;
  993. Function TCustomSQLStatement.HasMacros : Boolean;
  994. begin
  995. Result:=Macros.Count>0;
  996. end;
  997. function TCustomSQLStatement.LogEvent(EventType: TDBEventType): Boolean;
  998. begin
  999. Result:=Assigned(Database) and Database.LogEvent(EventType);
  1000. end;
  1001. procedure TCustomSQLStatement.Log(EventType: TDBEventType; const Msg: String);
  1002. Var
  1003. M : String;
  1004. begin
  1005. If LogEvent(EventType) then
  1006. begin
  1007. If (Name<>'') then
  1008. M:=Name
  1009. else
  1010. M:=ClassName;
  1011. Database.Log(EventType,M+' : '+Msg);
  1012. end;
  1013. end;
  1014. procedure TCustomSQLStatement.Notification(AComponent: TComponent;
  1015. Operation: TOperation);
  1016. begin
  1017. inherited Notification(AComponent, Operation);
  1018. if (operation=opRemove) then
  1019. If (AComponent=FTransaction) then
  1020. FTransaction:=Nil
  1021. else if (AComponent=FDatabase) then
  1022. begin
  1023. UnPrepare;
  1024. FDatabase:=Nil;
  1025. end;
  1026. end;
  1027. constructor TCustomSQLStatement.Create(AOwner: TComponent);
  1028. begin
  1029. inherited Create(AOwner);
  1030. FSQL:=TStringList.Create;
  1031. TStringList(FSQL).OnChange:=@OnChangeSQL;
  1032. FParams:=CreateParams;
  1033. FParamCheck:=True;
  1034. FMacros:=CreateParams;
  1035. FMacroChar:=DefaultMacroChar;
  1036. FMacroCheck:=False;
  1037. FParseSQL:=True;
  1038. FRowsAffected:=-1;
  1039. end;
  1040. destructor TCustomSQLStatement.Destroy;
  1041. begin
  1042. UnPrepare;
  1043. Transaction:=Nil;
  1044. Database:=Nil;
  1045. DataSource:=Nil;
  1046. FreeAndNil(FDataLink);
  1047. FreeAndNil(FParams);
  1048. FreeAndNil(FMacros);
  1049. FreeAndNil(FSQL);
  1050. inherited Destroy;
  1051. end;
  1052. function TCustomSQLStatement.GetSchemaType: TSchemaType;
  1053. begin
  1054. Result:=stNoSchema
  1055. end;
  1056. function TCustomSQLStatement.GetSchemaObjectName: String;
  1057. begin
  1058. Result:='';
  1059. end;
  1060. function TCustomSQLStatement.GetSchemaPattern: String;
  1061. begin
  1062. Result:='';
  1063. end;
  1064. function TCustomSQLStatement.IsSelectable: Boolean;
  1065. begin
  1066. Result:=False;
  1067. end;
  1068. procedure TCustomSQLStatement.GetStatementInfo(var ASQL: String; out Info: TSQLStatementInfo);
  1069. begin
  1070. Info:=Database.GetStatementInfo(ASQL);
  1071. end;
  1072. procedure TCustomSQLStatement.AllocateCursor;
  1073. begin
  1074. if not assigned(FCursor) then
  1075. // Do this as late as possible.
  1076. FCursor:=Database.AllocateCursorHandle;
  1077. end;
  1078. procedure TCustomSQLStatement.DeAllocateCursor;
  1079. begin
  1080. if Assigned(FCursor) then
  1081. begin
  1082. if Assigned(Database) then
  1083. DataBase.DeAllocateCursorHandle(FCursor);
  1084. FreeAndNil(FCursor);
  1085. end;
  1086. end;
  1087. function TCustomSQLStatement.ExpandMacros(const OrigSQL : String ) : String;
  1088. Const
  1089. Terminators = SQLDelimiterCharacters+
  1090. [ #0,'=','+','-','*','\','/','[',']','|' ];
  1091. var
  1092. I: Integer;
  1093. Ch : Char;
  1094. TermArr : Set of Char;
  1095. TempStr, TempMacroName : String;
  1096. MacroFlag : Boolean;
  1097. Procedure SubstituteMacro;
  1098. var
  1099. Param: TParam;
  1100. begin
  1101. Param := Macros.FindParam( TempMacroName );
  1102. if Assigned( Param ) then
  1103. Result := Result + Param.AsString
  1104. else
  1105. Result := Result + MacroChar + TempMacroName;
  1106. TempMacroName:='';
  1107. end;
  1108. begin
  1109. Result := OrigSQL;
  1110. if not MacroCheck then
  1111. Exit;
  1112. TermArr := Terminators +[MacroChar];
  1113. Result := '';
  1114. MacroFlag := False;
  1115. for Ch in OrigSQL do
  1116. begin
  1117. if not MacroFlag and (Ch=MacroChar) then
  1118. begin
  1119. MacroFlag := True;
  1120. TempMacroName := '';
  1121. end
  1122. else if MacroFlag then
  1123. begin
  1124. if not (Ch In TermArr) then
  1125. TempMacroName := TempMacroName + Ch
  1126. else
  1127. begin
  1128. SubstituteMacro;
  1129. if Ch <> MacroChar then
  1130. MacroFlag := False;
  1131. TempMacroName := '';
  1132. end
  1133. end;
  1134. if not MacroFlag then
  1135. Result := Result + Ch;
  1136. end;
  1137. if (TempMacroName<>'') then
  1138. SubstituteMacro;
  1139. end;
  1140. procedure TCustomSQLStatement.DoPrepare;
  1141. var
  1142. StmInfo: TSQLStatementInfo;
  1143. begin
  1144. if GetSchemaType=stNoSchema then
  1145. FOrigSQL := TrimRight(FSQL.Text)
  1146. else
  1147. FOrigSQL := Database.GetSchemaInfoSQL(GetSchemaType, GetSchemaObjectName, GetSchemaPattern);
  1148. if (FOrigSQL='') then
  1149. DatabaseError(SErrNoStatement);
  1150. FServerSQL:=ExpandMacros( FOrigSQL );
  1151. GetStatementInfo(FServerSQL,StmInfo);
  1152. AllocateCursor;
  1153. FCursor.FSelectable:=True; // let PrepareStatement and/or Execute alter it
  1154. FCursor.FStatementType:=StmInfo.StatementType;
  1155. FCursor.FSchemaType:=GetSchemaType;
  1156. If LogEvent(detPrepare) then
  1157. Log(detPrepare,FServerSQL);
  1158. Database.PrepareStatement(FCursor,Transaction,FServerSQL,FParams);
  1159. // Update
  1160. FCursor.FInitFieldDef:=FCursor.FSelectable;
  1161. end;
  1162. procedure TCustomSQLStatement.Prepare;
  1163. begin
  1164. if Prepared then
  1165. exit;
  1166. if not assigned(Database) then
  1167. DatabaseError(SErrDatabasenAssigned);
  1168. if not assigned(Transaction) then
  1169. DatabaseError(SErrTransactionnSet);
  1170. Database.MaybeConnect;
  1171. if not Transaction.Active then
  1172. Transaction.MaybeStartTransaction;
  1173. try
  1174. DoPrepare;
  1175. except
  1176. DeAllocateCursor;
  1177. Raise;
  1178. end;
  1179. end;
  1180. procedure TCustomSQLStatement.Execute;
  1181. begin
  1182. CheckPrepare;
  1183. try
  1184. DoExecute;
  1185. finally
  1186. CheckUnPrepare;
  1187. end;
  1188. end;
  1189. procedure TCustomSQLStatement.DoUnPrepare;
  1190. begin
  1191. If Assigned(FCursor) then
  1192. If Assigned(Database) then
  1193. begin
  1194. DataBase.UnPrepareStatement(FCursor);
  1195. DeAllocateCursor;
  1196. end
  1197. else // this should never happen. It means a cursor handle leaks in the DB itself.
  1198. FreeAndNil(FCursor);
  1199. end;
  1200. function TCustomSQLStatement.GetDataSource: TDataSource;
  1201. begin
  1202. if Assigned(FDataLink) then
  1203. Result:=FDataLink.DataSource
  1204. else
  1205. Result:=Nil;
  1206. end;
  1207. procedure TCustomSQLStatement.Unprepare;
  1208. begin
  1209. // Some SQLConnections does not support statement [un]preparation, but they have allocated local cursor(s)
  1210. // so let them do cleanup f.e. cancel pending queries and/or free resultset
  1211. // and also do UnRegisterStatement!
  1212. if assigned(FCursor) then
  1213. DoUnprepare;
  1214. end;
  1215. function TCustomSQLStatement.ParamByName(const AParamName: String): TParam;
  1216. begin
  1217. Result:=FParams.ParamByName(AParamName);
  1218. end;
  1219. function TCustomSQLStatement.RowsAffected: TRowsCount;
  1220. begin
  1221. if FRowsAffected=-1 then
  1222. begin
  1223. if Assigned(Database) then
  1224. FRowsAffected:=Database.RowsAffected(FCursor);
  1225. end;
  1226. Result:=FRowsAffected;
  1227. end;
  1228. { TSQLConnection }
  1229. constructor TSQLConnection.Create(AOwner: TComponent);
  1230. begin
  1231. inherited Create(AOwner);
  1232. FSQLFormatSettings:=DefaultSQLFormatSettings;
  1233. FFieldNameQuoteChars:=DoubleQuotes;
  1234. FLogEvents:=LogAllEvents; //match Property LogEvents...Default LogAllEvents
  1235. FStatements:=TThreadList.Create;
  1236. FStatements.Duplicates:=dupIgnore;
  1237. end;
  1238. destructor TSQLConnection.Destroy;
  1239. begin
  1240. try
  1241. CloseForDestroy; // needed because we want to de-allocate statements
  1242. Finally
  1243. FreeAndNil(FStatements);
  1244. inherited Destroy;
  1245. end;
  1246. end;
  1247. function TSQLConnection.StrToStatementType(s : string) : TStatementType;
  1248. var
  1249. T : TStatementType;
  1250. LS : String;
  1251. begin
  1252. LS:=Lowercase(s);
  1253. for T:=stSelect to stRollback do
  1254. if (LS=StatementTokens[T]) then
  1255. Exit(T);
  1256. Result:=stUnknown;
  1257. end;
  1258. procedure TSQLConnection.SetTransaction(Value : TSQLTransaction);
  1259. begin
  1260. if FTransaction<>value then
  1261. begin
  1262. if Assigned(FTransaction) and FTransaction.Active then
  1263. DatabaseError(SErrAssTransaction);
  1264. if Assigned(Value) then
  1265. Value.Database := Self;
  1266. FTransaction := Value;
  1267. If Assigned(FTransaction) and (FTransaction.Database=Nil) then
  1268. FTransaction.Database:=Self;
  1269. end;
  1270. end;
  1271. procedure TSQLConnection.UpdateIndexDefs(IndexDefs : TIndexDefs; TableName : string);
  1272. begin
  1273. // Empty abstract
  1274. end;
  1275. procedure TSQLConnection.DoConnect;
  1276. var ConnectionCharSet: string;
  1277. begin
  1278. inherited;
  1279. // map connection CharSet to corresponding local CodePage
  1280. // do not set FCodePage to CP_ACP if FCodePage = DefaultSystemCodePage
  1281. // aliases listed here are commonly used, but not recognized by CodePageNameToCodePage()
  1282. ConnectionCharSet := LowerCase(GetConnectionCharSet);
  1283. case ConnectionCharSet of
  1284. 'utf8','utf-8','utf8mb4':
  1285. FCodePage := CP_UTF8;
  1286. 'win1250','cp1250':
  1287. FCodePage := 1250;
  1288. 'win1251','cp1251':
  1289. FCodePage := 1251;
  1290. 'win1252','cp1252','latin1','iso8859_1':
  1291. FCodePage := 1252;
  1292. else
  1293. begin
  1294. FCodePage := CodePageNameToCodePage(ConnectionCharSet);
  1295. if FCodePage = CP_NONE then
  1296. FCodePage := CP_ACP;
  1297. end;
  1298. end;
  1299. end;
  1300. procedure TSQLConnection.DoInternalConnect;
  1301. begin
  1302. if (DatabaseName = '') and not(sqSupportEmptyDatabaseName in FConnOptions) then
  1303. DatabaseError(SErrNoDatabaseName,Self);
  1304. end;
  1305. procedure TSQLConnection.DoInternalDisconnect;
  1306. Var
  1307. I : integer;
  1308. L : TList;
  1309. begin
  1310. L:=FStatements.LockList;
  1311. try
  1312. For I:=0 to L.Count-1 do
  1313. TCustomSQLStatement(L[i]).Unprepare;
  1314. L.Clear;
  1315. finally
  1316. FStatements.UnlockList;
  1317. end;
  1318. end;
  1319. procedure TSQLConnection.StartTransaction;
  1320. begin
  1321. if not assigned(Transaction) then
  1322. DatabaseError(SErrConnTransactionnSet)
  1323. else
  1324. Transaction.StartTransaction;
  1325. end;
  1326. procedure TSQLConnection.EndTransaction;
  1327. begin
  1328. if not assigned(Transaction) then
  1329. DatabaseError(SErrConnTransactionnSet)
  1330. else
  1331. Transaction.EndTransaction;
  1332. end;
  1333. procedure TSQLConnection.ExecuteDirect(SQL: String);
  1334. begin
  1335. ExecuteDirect(SQL,FTransaction);
  1336. end;
  1337. procedure TSQLConnection.ExecuteDirect(SQL: String;
  1338. ATransaction: TSQLTransaction);
  1339. var Cursor : TSQLCursor;
  1340. begin
  1341. if not assigned(ATransaction) then
  1342. DatabaseError(SErrTransactionnSet);
  1343. if not Connected then Open;
  1344. if not ATransaction.Active then
  1345. ATransaction.MaybeStartTransaction;
  1346. SQL := TrimRight(SQL);
  1347. if SQL = '' then
  1348. DatabaseError(SErrNoStatement);
  1349. try
  1350. Cursor := AllocateCursorHandle;
  1351. Cursor.FStatementType := stUnknown;
  1352. If LogEvent(detPrepare) then
  1353. Log(detPrepare,SQL);
  1354. PrepareStatement(Cursor,ATransaction,SQL,Nil);
  1355. try
  1356. If LogEvent(detExecute) then
  1357. Log(detExecute,SQL);
  1358. Execute(Cursor,ATransaction, Nil);
  1359. finally
  1360. UnPrepareStatement(Cursor);
  1361. end;
  1362. finally;
  1363. DeAllocateCursorHandle(Cursor);
  1364. FreeAndNil(Cursor);
  1365. end;
  1366. end;
  1367. function TSQLConnection.GetPort: cardinal;
  1368. begin
  1369. result := StrToIntDef(Params.Values[PortParamName],0);
  1370. end;
  1371. procedure TSQLConnection.SetOptions(AValue: TSQLConnectionOptions);
  1372. begin
  1373. if FOptions=AValue then Exit;
  1374. FOptions:=AValue;
  1375. end;
  1376. procedure TSQLConnection.SetPort(const AValue: cardinal);
  1377. begin
  1378. if AValue<>0 then
  1379. Params.Values[PortParamName]:=IntToStr(AValue)
  1380. else with params do if IndexOfName(PortParamName) > -1 then
  1381. Delete(IndexOfName(PortParamName));
  1382. end;
  1383. function TSQLConnection.AttemptCommit(trans: TSQLHandle): boolean;
  1384. begin
  1385. try
  1386. Result:=Commit(trans);
  1387. except
  1388. if ForcedClose then
  1389. Result:=True
  1390. else
  1391. Raise;
  1392. end;
  1393. end;
  1394. function TSQLConnection.AttemptRollBack(trans: TSQLHandle): boolean;
  1395. begin
  1396. try
  1397. Result:=Rollback(trans);
  1398. except
  1399. if ForcedClose then
  1400. Result:=True
  1401. else
  1402. Raise;
  1403. end;
  1404. end;
  1405. procedure TSQLConnection.GetDBInfo(const ASchemaType : TSchemaType; const ASchemaObjectName, AReturnField : string; AList: TStrings);
  1406. var qry : TCustomSQLQuery;
  1407. begin
  1408. if not assigned(Transaction) then
  1409. DatabaseError(SErrConnTransactionnSet);
  1410. qry := TCustomSQLQuery.Create(nil);
  1411. try
  1412. qry.transaction := Transaction;
  1413. qry.database := Self;
  1414. with qry do
  1415. begin
  1416. ParseSQL := False;
  1417. SetSchemaInfo(ASchemaType,ASchemaObjectName,'');
  1418. open;
  1419. AList.Clear;
  1420. while not eof do
  1421. begin
  1422. AList.Append(trim(fieldbyname(AReturnField).asstring));
  1423. Next;
  1424. end;
  1425. end;
  1426. finally
  1427. qry.free;
  1428. end;
  1429. end;
  1430. function TSQLConnection.GetConnectionCharSet: string;
  1431. begin
  1432. // default implementation returns user supplied FCharSet
  1433. // (can be overriden by descendants, which are able retrieve current connection charset using client API)
  1434. Result := LowerCase(FCharSet);
  1435. end;
  1436. function TSQLConnection.RowsAffected(cursor: TSQLCursor): TRowsCount;
  1437. begin
  1438. Result := -1;
  1439. end;
  1440. function TSQLConnection.AddFieldDef(AFieldDefs: TFieldDefs; AFieldNo: Longint;
  1441. const AName: string; ADataType: TFieldType; ASize, APrecision: Integer;
  1442. AByteSize, ARequired, AReadOnly: Boolean): TFieldDef;
  1443. var
  1444. ACodePage: TSystemCodePage;
  1445. begin
  1446. // helper function used by descendants
  1447. if ADataType in [ftString, ftFixedChar, ftMemo] then
  1448. begin
  1449. ACodePage := FCodePage;
  1450. // if ASize of character data is passed as "byte length",
  1451. // translate it to "character length" as expected by TFieldDef
  1452. if AByteSize and (ACodePage = CP_UTF8) then
  1453. ASize := ASize div 4;
  1454. end
  1455. else
  1456. ACodePage := 0;
  1457. Result := AFieldDefs.Add(AName, ADataType, ASize, APrecision, ARequired, AReadOnly, AFieldNo, ACodePage);
  1458. end;
  1459. procedure TSQLConnection.GetTableNames(List: TStrings; SystemTables: Boolean);
  1460. begin
  1461. if not SystemTables then
  1462. GetDBInfo(stTables,'','table_name',List)
  1463. else
  1464. GetDBInfo(stSysTables,'','table_name',List);
  1465. end;
  1466. procedure TSQLConnection.GetProcedureNames(List: TStrings);
  1467. begin
  1468. GetDBInfo(stProcedures,'','procedure_name',List);
  1469. end;
  1470. procedure TSQLConnection.GetFieldNames(const TableName: string; List: TStrings);
  1471. begin
  1472. GetDBInfo(stColumns,TableName,'column_name',List);
  1473. end;
  1474. procedure TSQLConnection.GetSchemaNames(List: TStrings);
  1475. begin
  1476. GetDBInfo(stSchemata,'','SCHEMA_NAME',List);
  1477. end;
  1478. procedure TSQLConnection.GetSequenceNames(List: TStrings);
  1479. begin
  1480. GetDBInfo(stSequences,'','SEQUENCE_NAME',List);
  1481. end;
  1482. {
  1483. See if we can integrate/merge this with GetDBInfo. They are virtually identical
  1484. }
  1485. Function TSQLConnection.GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList) : Integer;
  1486. var
  1487. qry : TCustomSQLQuery;
  1488. vSchemaName, vObjectName: String;
  1489. f: TField;
  1490. begin
  1491. Result:=0;
  1492. if not assigned(Transaction) then
  1493. DatabaseError(SErrConnTransactionnSet);
  1494. qry := TCustomSQLQuery.Create(nil);
  1495. try
  1496. qry.transaction := Transaction;
  1497. qry.database := Self;
  1498. with qry do
  1499. begin
  1500. ParseSQL := False;
  1501. SetSchemaInfo(ASchemaType,TSchemaObjectNames[ASchemaType],'');
  1502. open;
  1503. f:=FindField(TSchemaObjectNames[stSchemata]);
  1504. while not eof do
  1505. begin
  1506. vSchemaName:='';
  1507. if Assigned(f) then
  1508. vSchemaName:=f.AsString;
  1509. vObjectName:=FieldByName(FSchemaObjectName).AsString;
  1510. AList.AddIdentifier(vObjectName, vSchemaName);
  1511. Next;
  1512. Inc(Result);
  1513. end;
  1514. end;
  1515. finally
  1516. qry.free;
  1517. end;
  1518. end;
  1519. function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
  1520. var i: TConnInfoType;
  1521. begin
  1522. Result:='';
  1523. if InfoType = citAll then
  1524. for i:=citServerType to citClientVersion do
  1525. begin
  1526. if Result<>'' then Result:=Result+',';
  1527. Result:=Result+'"'+GetConnectionInfo(i)+'"';
  1528. end;
  1529. end;
  1530. function TSQLConnection.GetStatementInfo(const ASQL: string): TSQLStatementInfo;
  1531. type
  1532. TParsePart = (ppStart,ppWith,ppSelect,ppTableName,ppFrom,ppWhere,ppGroup,ppOrder,ppBogus);
  1533. TPhraseSeparator = (sepNone, sepWhiteSpace, sepComma, sepComment, sepParentheses, sepDoubleQuote, sepEnd);
  1534. TKeyword = (kwWITH, kwSELECT, kwINSERT, kwUPDATE, kwDELETE, kwFROM, kwJOIN, kwWHERE, kwGROUP, kwORDER, kwUNION, kwROWS, kwLIMIT, kwUnknown);
  1535. const
  1536. KeywordNames: array[TKeyword] of string =
  1537. ('WITH', 'SELECT', 'INSERT', 'UPDATE', 'DELETE', 'FROM', 'JOIN', 'WHERE', 'GROUP', 'ORDER', 'UNION', 'ROWS', 'LIMIT', '');
  1538. var
  1539. PSQL, CurrentP, SavedP,
  1540. PhraseP, PStatementPart : pchar;
  1541. S : string;
  1542. ParsePart : TParsePart;
  1543. BracketCount : Integer;
  1544. Separator : TPhraseSeparator;
  1545. Keyword, K : TKeyword;
  1546. begin
  1547. PSQL:=PChar(ASQL);
  1548. ParsePart := ppStart;
  1549. CurrentP := PSQL-1;
  1550. PhraseP := PSQL;
  1551. Result.TableName := '';
  1552. Result.Updateable := False;
  1553. Result.WhereStartPos := 0;
  1554. Result.WhereStopPos := 0;
  1555. repeat
  1556. inc(CurrentP);
  1557. SavedP := CurrentP;
  1558. case CurrentP^ of
  1559. ' ', #9..#13:
  1560. Separator := sepWhiteSpace;
  1561. ',':
  1562. Separator := sepComma;
  1563. #0, ';':
  1564. Separator := sepEnd;
  1565. '(':
  1566. begin
  1567. Separator := sepParentheses;
  1568. // skip everything between brackets, since it could be a sub-select, and
  1569. // further nothing between brackets could be interesting for the parser.
  1570. BracketCount := 1;
  1571. repeat
  1572. inc(CurrentP);
  1573. if CurrentP^ = '(' then inc(BracketCount)
  1574. else if CurrentP^ = ')' then dec(BracketCount);
  1575. until (CurrentP^ = #0) or (BracketCount = 0);
  1576. if CurrentP^ <> #0 then inc(CurrentP);
  1577. end;
  1578. '"','`':
  1579. if SkipComments(CurrentP, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions) then
  1580. Separator := sepDoubleQuote;
  1581. else
  1582. if SkipComments(CurrentP, sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions) then
  1583. Separator := sepComment
  1584. else
  1585. Separator := sepNone;
  1586. end;
  1587. if Separator <> sepNone then
  1588. begin
  1589. if (CurrentP > SavedP) and (SavedP > PhraseP) then
  1590. CurrentP := SavedP; // there is something before comment or left parenthesis or double quote
  1591. if (Separator in [sepWhitespace,sepComment]) and (SavedP = PhraseP) then
  1592. PhraseP := CurrentP; // skip comments (but not parentheses) and white spaces
  1593. if (CurrentP-PhraseP > 0) or (Separator = sepEnd) then
  1594. begin
  1595. SetString(s, PhraseP, CurrentP-PhraseP);
  1596. Keyword := kwUnknown;
  1597. for K in TKeyword do
  1598. if SameText(s, KeywordNames[K]) then
  1599. begin
  1600. Keyword := K;
  1601. break;
  1602. end;
  1603. case ParsePart of
  1604. ppStart : begin
  1605. Result.StatementType := StrToStatementType(s);
  1606. case Keyword of
  1607. kwWITH : ParsePart := ppWith;
  1608. kwSELECT: ParsePart := ppSelect;
  1609. else break;
  1610. end;
  1611. end;
  1612. ppWith : begin
  1613. // WITH [RECURSIVE] CTE_name [ ( column_names ) ] AS ( CTE_query_definition ) [, ...]
  1614. // { SELECT | INSERT | UPDATE | DELETE } ...
  1615. case Keyword of
  1616. kwSELECT: Result.StatementType := stSelect;
  1617. kwINSERT: Result.StatementType := stInsert;
  1618. kwUPDATE: Result.StatementType := stUpdate;
  1619. kwDELETE: Result.StatementType := stDelete;
  1620. end;
  1621. if Result.StatementType <> stUnknown then break;
  1622. end;
  1623. ppSelect : begin
  1624. if Keyword = kwFROM then
  1625. ParsePart := ppTableName;
  1626. end;
  1627. ppTableName:
  1628. begin
  1629. // Meta-data requests are never updateable
  1630. // and select statements from more than one table
  1631. // and/or derived tables are also not updateable
  1632. if Separator in [sepWhitespace, sepComment, sepDoubleQuote, sepEnd] then
  1633. begin
  1634. Result.TableName := Result.TableName + s;
  1635. Result.Updateable := True;
  1636. end;
  1637. // compound delimited classifier like: "schema name"."table name"
  1638. if not (CurrentP^ in ['.','"']) then
  1639. ParsePart := ppFrom;
  1640. end;
  1641. ppFrom : begin
  1642. if (Keyword in [kwWHERE, kwGROUP, kwORDER, kwLIMIT, kwROWS]) or
  1643. (Separator = sepEnd) then
  1644. begin
  1645. case Keyword of
  1646. kwWHERE: ParsePart := ppWhere;
  1647. kwGROUP: ParsePart := ppGroup;
  1648. kwORDER: ParsePart := ppOrder;
  1649. else ParsePart := ppBogus;
  1650. end;
  1651. Result.WhereStartPos := PhraseP-PSQL+1;
  1652. PStatementPart := CurrentP;
  1653. end
  1654. else
  1655. // joined table or user_defined_function (...)
  1656. if (Keyword = kwJOIN) or (Separator in [sepComma, sepParentheses]) then
  1657. begin
  1658. Result.TableName := '';
  1659. Result.Updateable := False;
  1660. end;
  1661. end;
  1662. ppWhere : begin
  1663. if (Keyword in [kwGROUP, kwORDER, kwLIMIT, kwROWS]) or
  1664. (Separator = sepEnd) then
  1665. begin
  1666. ParsePart := ppBogus;
  1667. Result.WhereStartPos := PStatementPart-PSQL;
  1668. if (Separator = sepEnd) then
  1669. Result.WhereStopPos := CurrentP-PSQL+1
  1670. else
  1671. Result.WhereStopPos := PhraseP-PSQL+1;
  1672. end
  1673. else if (Keyword = kwUNION) then
  1674. begin
  1675. ParsePart := ppBogus;
  1676. Result.Updateable := False;
  1677. end;
  1678. end;
  1679. end; {case}
  1680. end;
  1681. if Separator in [sepComment, sepParentheses, sepDoubleQuote] then
  1682. dec(CurrentP);
  1683. PhraseP := CurrentP+1;
  1684. end
  1685. until CurrentP^=#0;
  1686. end;
  1687. function TSQLConnection.GetAsString(Param: TParam): RawByteString;
  1688. begin
  1689. // converts parameter value to connection charset
  1690. if FCodePage = CP_UTF8 then
  1691. Result := Param.AsUTF8String
  1692. else if (FCodePage = DefaultSystemCodePage) or
  1693. (FCodePage = CP_ACP) or (FCodePage = CP_NONE) then
  1694. Result := Param.AsAnsiString
  1695. else
  1696. begin
  1697. Result := Param.AsAnsiString;
  1698. SetCodePage(Result, FCodePage, True);
  1699. end;
  1700. end;
  1701. function TSQLConnection.GetAsSQLText(Field : TField) : string;
  1702. begin
  1703. if (not assigned(Field)) or Field.IsNull then Result := 'Null'
  1704. else case Field.DataType of
  1705. ftString : Result := QuotedStr(Field.AsString);
  1706. ftDate : Result := '''' + FormatDateTime('yyyy-mm-dd',Field.AsDateTime,FSQLFormatSettings) + '''';
  1707. ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Field.AsDateTime,FSQLFormatSettings) + '''';
  1708. ftTime : Result := '''' + TimeIntervalToString(Field.AsDateTime) + '''';
  1709. else
  1710. Result := Field.AsString;
  1711. end; {case}
  1712. end;
  1713. function TSQLConnection.GetAsSQLText(Param: TParam) : string;
  1714. begin
  1715. if (not assigned(Param)) or Param.IsNull then Result := 'Null'
  1716. else case Param.DataType of
  1717. ftGuid,
  1718. ftMemo,
  1719. ftFixedChar,
  1720. ftString : Result := QuotedStr(GetAsString(Param));
  1721. ftDate : Result := '''' + FormatDateTime('yyyy-mm-dd', Param.AsDateTime, FSQLFormatSettings) + '''';
  1722. ftTime : Result := '''' + TimeIntervalToString(Param.AsDateTime) + '''';
  1723. ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', Param.AsDateTime, FSQLFormatSettings) + '''';
  1724. ftCurrency,
  1725. ftBcd : Result := CurrToStr(Param.AsCurrency, FSQLFormatSettings);
  1726. ftFloat : Result := FloatToStr(Param.AsFloat, FSQLFormatSettings);
  1727. ftFMTBcd : Result := StringReplace(Param.AsString, DefaultFormatSettings.DecimalSeparator, FSQLFormatSettings.DecimalSeparator, []);
  1728. ftSingle : Result := FloatToStr(Param.AsSingle, FSQLFormatSettings);
  1729. else
  1730. Result := Param.AsString;
  1731. end; {case}
  1732. end;
  1733. function TSQLConnection.GetHandle: pointer;
  1734. begin
  1735. Result := nil;
  1736. end;
  1737. function TSQLConnection.LogEvent(EventType: TDBEventType): Boolean;
  1738. begin
  1739. Result:=(Assigned(FOnLog) or Assigned(GlobalDBLogHook)) and (EventType in LogEvents);
  1740. end;
  1741. procedure TSQLConnection.LogParams(const AParams: TParams);
  1742. Var
  1743. S : String;
  1744. P : TParam;
  1745. begin
  1746. if not LogEvent(detParamValue) or not Assigned(AParams) then
  1747. Exit;
  1748. For P in AParams do
  1749. begin
  1750. if P.IsNull then
  1751. S:='<NULL>'
  1752. else if (P.DataType in ftBlobTypes) and not (P.DataType in [ftMemo, ftFmtMemo,ftWideMemo]) then
  1753. S:='<BLOB>'
  1754. else
  1755. S:=P.AsString;
  1756. Log(detParamValue,Format(SLogParamValue,[P.Name,S]));
  1757. end;
  1758. end;
  1759. procedure TSQLConnection.Log(EventType: TDBEventType; const Msg: String);
  1760. Var
  1761. M : String;
  1762. begin
  1763. If LogEvent(EventType) then
  1764. begin
  1765. If Assigned(FonLog) then
  1766. FOnLog(Self,EventType,Msg);
  1767. If Assigned(GlobalDBLogHook) then
  1768. begin
  1769. If (Name<>'') then
  1770. M:=Name+' : '+Msg
  1771. else
  1772. M:=ClassName+' : '+Msg;
  1773. GlobalDBLogHook(Self,EventType,M);
  1774. end;
  1775. end;
  1776. end;
  1777. procedure TSQLConnection.RegisterStatement(S: TCustomSQLStatement);
  1778. begin
  1779. FStatements.Add(S);
  1780. end;
  1781. procedure TSQLConnection.UnRegisterStatement(S: TCustomSQLStatement);
  1782. begin
  1783. if Assigned(FStatements) then // Can be nil, when we are destroying and datasets are uncoupled.
  1784. FStatements.Remove(S);
  1785. end;
  1786. function TSQLConnection.CreateCustomQuery(aOwner : TComponent) : TCustomSQLQuery;
  1787. begin
  1788. Result:=TCustomSQLQuery.Create(AOwner);
  1789. end;
  1790. function TSQLConnection.InitialiseUpdateStatement(Query : TCustomSQLQuery; var qry : TCustomSQLQuery): TCustomSQLQuery;
  1791. begin
  1792. if not assigned(qry) then
  1793. begin
  1794. qry := TCustomSQLQuery(TComponentClass(Query.ClassType).Create(Nil));
  1795. qry.ParseSQL := False;
  1796. qry.DataBase := Self;
  1797. qry.Transaction := Query.SQLTransaction;
  1798. qry.Unidirectional:=True;
  1799. qry.UsePrimaryKeyAsKey:=False;
  1800. qry.PacketRecords:=1;
  1801. end;
  1802. Result:=qry;
  1803. end;
  1804. procedure TSQLConnection.AddFieldToUpdateWherePart(var sql_where : string;UpdateMode : TUpdateMode; F : TField);
  1805. begin
  1806. if (pfInKey in F.ProviderFlags)
  1807. or ((UpdateMode = upWhereAll) and (pfInWhere in F.ProviderFlags))
  1808. or ((UpdateMode = UpWhereChanged) and (pfInWhere in F.ProviderFlags) and (F.Value <> F.OldValue)) then
  1809. begin
  1810. if (sql_where<>'') then
  1811. sql_where:=sql_where + ' and ';
  1812. sql_where:= sql_where + '(' + FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1];
  1813. // primary key normally cannot be null
  1814. if Assigned(F.Dataset) and F.Dataset.Active and (F.OldValue = NULL) then
  1815. sql_where := sql_where + ' is null '
  1816. else
  1817. sql_where := sql_where +'= :"' + 'OLD_' + F.FieldName + '"';
  1818. sql_where:=sql_where+') ';
  1819. end;
  1820. end;
  1821. function TSQLConnection.ConstructInsertSQL(Query: TCustomSQLQuery;
  1822. var ReturningClause: Boolean): string;
  1823. var x : integer;
  1824. sql_fields : string;
  1825. sql_values : string;
  1826. returning_fields : String;
  1827. F : TField;
  1828. begin
  1829. sql_fields := '';
  1830. sql_values := '';
  1831. returning_fields := '';
  1832. for x := 0 to Query.Fields.Count -1 do
  1833. begin
  1834. F:=Query.Fields[x];
  1835. if (not F.IsNull) and (pfInUpdate in F.ProviderFlags) and (not F.ReadOnly) then
  1836. begin
  1837. sql_fields := sql_fields + FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
  1838. sql_values := sql_values + ':"' + F.FieldName + '",';
  1839. end;
  1840. if ReturningClause and (pfRefreshOnInsert in F.ProviderFlags) then
  1841. returning_fields := returning_fields + FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
  1842. end;
  1843. if length(sql_fields) = 0 then
  1844. DatabaseErrorFmt(sNoUpdateFields,['insert'],self);
  1845. setlength(sql_fields,length(sql_fields)-1);
  1846. setlength(sql_values,length(sql_values)-1);
  1847. result := 'insert into ' + Query.FTableName + ' (' + sql_fields + ') values (' + sql_values + ')';
  1848. if ReturningClause then
  1849. begin
  1850. ReturningClause:=length(returning_fields) <> 0 ;
  1851. if ReturningClause then
  1852. begin
  1853. setlength(returning_fields,length(returning_fields)-1);
  1854. Result := Result + ' returning ' + returning_fields;
  1855. end;
  1856. end;
  1857. end;
  1858. function TSQLConnection.ConstructUpdateSQL(Query: TCustomSQLQuery;
  1859. var ReturningClause: Boolean): string;
  1860. var x : integer;
  1861. F : TField;
  1862. sql_set : string;
  1863. sql_where : string;
  1864. returning_fields : String;
  1865. begin
  1866. sql_set := '';
  1867. sql_where := '';
  1868. returning_fields := '';
  1869. for x := 0 to Query.Fields.Count -1 do
  1870. begin
  1871. F:=Query.Fields[x];
  1872. AddFieldToUpdateWherePart(sql_where,Query.UpdateMode,F);
  1873. if (pfInUpdate in F.ProviderFlags) and (not F.ReadOnly) then
  1874. sql_set := sql_set +FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] +'=:"' + F.FieldName + '",';
  1875. if ReturningClause and (pfRefreshOnUpdate in F.ProviderFlags) then
  1876. returning_fields := returning_fields + FieldNameQuoteChars[0] + F.FieldName + FieldNameQuoteChars[1] + ',';
  1877. end;
  1878. if length(sql_set) = 0 then DatabaseErrorFmt(sNoUpdateFields,['update'],self);
  1879. setlength(sql_set,length(sql_set)-1);
  1880. if length(sql_where) = 0 then DatabaseErrorFmt(sNoWhereFields,['update'],self);
  1881. result := 'update ' + Query.FTableName + ' set ' + sql_set + ' where ' + sql_where;
  1882. if ReturningClause then
  1883. begin
  1884. ReturningClause:=length(returning_fields) <> 0 ;
  1885. if ReturningClause then
  1886. begin
  1887. setlength(returning_fields,length(returning_fields)-1);
  1888. Result := Result + ' returning ' + returning_fields;
  1889. end;
  1890. end;
  1891. end;
  1892. function TSQLConnection.ConstructDeleteSQL(Query : TCustomSQLQuery) : string;
  1893. var
  1894. x : integer;
  1895. sql_where : string;
  1896. begin
  1897. sql_where := '';
  1898. for x := 0 to Query.Fields.Count -1 do
  1899. AddFieldToUpdateWherePart(sql_where,Query.UpdateMode, Query.Fields[x]);
  1900. if length(sql_where) = 0 then
  1901. DatabaseErrorFmt(sNoWhereFields,['delete'],self);
  1902. result := 'delete from ' + Query.FTableName + ' where ' + sql_where;
  1903. end;
  1904. function TSQLConnection.ConstructRefreshSQL(Query: TCustomSQLQuery; UpdateKind: TUpdateKind): string;
  1905. Var
  1906. F : TField;
  1907. PF : TProviderFlag;
  1908. Where : String;
  1909. begin
  1910. Result:=Trim(Query.RefreshSQL.Text);
  1911. if (Result='') then
  1912. begin
  1913. Where:='';
  1914. PF:=RefreshFlags[UpdateKind];
  1915. For F in Query.Fields do
  1916. begin
  1917. if PF in F.ProviderFlags then
  1918. begin
  1919. if (Result<>'') then
  1920. Result:=Result+', ';
  1921. if (F.Origin<>'') and (F.Origin<>F.FieldName) then
  1922. Result:=Result+F.Origin+' AS '+F.FieldName
  1923. else
  1924. Result:=Result+FieldNameQuoteChars[0]+F.FieldName+FieldNameQuoteChars[1]
  1925. end;
  1926. if pfInkey in F.ProviderFlags then
  1927. begin
  1928. if (Where<>'') then
  1929. Where:=Where+' AND ';
  1930. Where:=Where+'('+FieldNameQuoteChars[0]+F.FieldName+FieldNameQuoteChars[1]+' = :'+F.FieldName+')';
  1931. end;
  1932. end;
  1933. if (Where='') then
  1934. DatabaseError(SErrNoKeyFieldForRefreshClause,Query);
  1935. Result:='SELECT '+Result+' FROM '+Query.FTableName+' WHERE '+Where;
  1936. end;
  1937. end;
  1938. procedure TSQLConnection.ApplyFieldUpdate(C : TSQLCursor; P : TSQLDBParam; F : TField; UseOldValue : Boolean);
  1939. begin
  1940. if UseOldValue then
  1941. P.AssignFieldValue(F,F.OldValue)
  1942. else
  1943. P.AssignFieldValue(F,F.Value);
  1944. P.FFieldDef:=F.FieldDef;
  1945. end;
  1946. procedure TSQLConnection.ApplyRecUpdate(Query: TCustomSQLQuery; UpdateKind: TUpdateKind);
  1947. var
  1948. qry : TCustomSQLQuery;
  1949. s : string;
  1950. x : integer;
  1951. Fld : TField;
  1952. Par, P : TParam;
  1953. UseOldValue, HasReturningClause : Boolean;
  1954. begin
  1955. qry:=Nil;
  1956. HasReturningClause:=(sqSupportReturning in ConnOptions) and not (sqoRefreshUsingSelect in Query.Options) and (Trim(Query.RefreshSQL.Text)='');
  1957. case UpdateKind of
  1958. ukInsert : begin
  1959. s := Trim(Query.FInsertSQL.Text);
  1960. if s = '' then
  1961. s := ConstructInsertSQL(Query, HasReturningClause)
  1962. else
  1963. HasReturningClause := False;
  1964. qry := InitialiseUpdateStatement(Query, Query.FInsertQry);
  1965. end;
  1966. ukModify : begin
  1967. s := Trim(Query.FUpdateSQL.Text);
  1968. if s = '' then begin
  1969. //if not assigned(Query.FUpdateQry) or (Query.UpdateMode<>upWhereKeyOnly) then // first time or dynamic where part
  1970. s := ConstructUpdateSQL(Query, HasReturningClause);
  1971. end
  1972. else
  1973. HasReturningClause := False;
  1974. qry := InitialiseUpdateStatement(Query, Query.FUpdateQry);
  1975. end;
  1976. ukDelete : begin
  1977. s := Trim(Query.FDeleteSQL.Text);
  1978. if (s='') and (not assigned(Query.FDeleteQry) or (Query.UpdateMode<>upWhereKeyOnly)) then
  1979. s := ConstructDeleteSQL(Query);
  1980. HasReturningClause := False;
  1981. qry := InitialiseUpdateStatement(Query, Query.FDeleteQry);
  1982. end;
  1983. end;
  1984. if (s<>'') and (qry.SQL.Text<>s) then
  1985. qry.SQL.Text:=s; //assign only when changed, to avoid UnPrepare/Prepare
  1986. Assert(qry.SQL.Text<>'');
  1987. for x:=0 to Qry.Params.Count-1 do
  1988. begin
  1989. P:=Qry.Params[x];
  1990. S:=P.Name;
  1991. UseOldValue:=SameText(Copy(S,1,4),'OLD_');
  1992. if UseOldValue then
  1993. begin
  1994. Delete(S,1,4);
  1995. Fld:=Query.FieldByName(S);
  1996. end
  1997. else
  1998. Fld:=Query.FindField(S);
  1999. if Assigned(Fld) then
  2000. ApplyFieldUpdate(Query.Cursor, P as TSQLDBParam, Fld, UseOldValue)
  2001. else
  2002. begin
  2003. // if does not exists field with given name, try look for param
  2004. Par:=Query.Params.FindParam(S);
  2005. if Assigned(Par) then
  2006. P.Assign(Par)
  2007. else
  2008. DatabaseErrorFmt(SFieldNotFound,[S],Query); // same error as raised by FieldByName()
  2009. end;
  2010. end;
  2011. if HasReturningClause then
  2012. begin
  2013. Qry.Close;
  2014. Qry.Open
  2015. end
  2016. else
  2017. Qry.ExecSQL;
  2018. if (scoApplyUpdatesChecksRowsAffected in Options) and (Qry.RowsAffected<>1) then
  2019. begin
  2020. Qry.Close;
  2021. DatabaseErrorFmt(SErrFailedToUpdateRecord, [Qry.RowsAffected], Query);
  2022. end;
  2023. if HasReturningClause then
  2024. Query.ApplyReturningResult(Qry,UpdateKind);
  2025. end;
  2026. function TSQLConnection.RefreshLastInsertID(Query: TCustomSQLQuery; Field: TField): Boolean;
  2027. begin
  2028. Result:=False;
  2029. end;
  2030. procedure TSQLConnection.FreeFldBuffers(cursor: TSQLCursor);
  2031. begin
  2032. // empty
  2033. end;
  2034. function TSQLConnection.StartImplicitTransaction(trans: TSQLHandle; aParams: string): boolean;
  2035. begin
  2036. Result:=False;
  2037. end;
  2038. function TSQLConnection.GetSchemaInfoSQL( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string;
  2039. begin
  2040. case SchemaType of
  2041. stTables : Result := 'SELECT * FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_TYPE=''BASE TABLE''';
  2042. stColumns : Result := 'SELECT * FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_NAME='+QuotedStr(SchemaObjectName);
  2043. stProcedures: Result := 'SELECT *, ROUTINE_NAME AS PROCEDURE_NAME FROM INFORMATION_SCHEMA.ROUTINES';
  2044. stSchemata : Result := 'SELECT * FROM INFORMATION_SCHEMA.SCHEMATA';
  2045. stSequences : Result := 'SELECT * FROM INFORMATION_SCHEMA.SEQUENCES';
  2046. else DatabaseError(SMetadataUnavailable);
  2047. end;
  2048. end;
  2049. function TSQLConnection.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
  2050. begin
  2051. Result := 'SELECT NEXT VALUE FOR ' + SequenceName;
  2052. end;
  2053. function TSQLConnection.GetNextValue(const SequenceName: string; IncrementBy: integer): Int64;
  2054. var
  2055. Q: TCustomSQLQuery;
  2056. begin
  2057. Result := 0;
  2058. Q := TCustomSQLQuery.Create(nil);
  2059. try
  2060. Q.DataBase := Self;
  2061. Q.Transaction := Transaction;
  2062. Q.SQL.Text := GetNextValueSQL(SequenceName, IncrementBy);
  2063. Q.Open;
  2064. if not Q.Eof then
  2065. Result := Q.Fields[0].AsLargeInt;
  2066. Q.Close;
  2067. finally
  2068. FreeAndNil(Q);
  2069. end;
  2070. end;
  2071. procedure TSQLConnection.MaybeConnect;
  2072. begin
  2073. If Not Connected then
  2074. begin
  2075. If (scoExplicitConnect in Options) then
  2076. DatabaseErrorFmt(SErrImplicitConnect,[Name]);
  2077. Connected:=True;
  2078. end;
  2079. end;
  2080. function TSQLConnection.PortParamName: string;
  2081. begin
  2082. Result := 'Port';
  2083. end;
  2084. procedure TSQLConnection.CreateDB;
  2085. begin
  2086. DatabaseError(SNotSupported);
  2087. end;
  2088. procedure TSQLConnection.DropDB;
  2089. begin
  2090. DatabaseError(SNotSupported);
  2091. end;
  2092. { TSQLTransaction }
  2093. constructor TSQLTransaction.Create(AOwner : TComponent);
  2094. begin
  2095. inherited Create(AOwner);
  2096. FParams := TStringList.Create;
  2097. Action := caRollBack;
  2098. end;
  2099. destructor TSQLTransaction.Destroy;
  2100. begin
  2101. EndTransaction;
  2102. FreeAndNil(FTrans);
  2103. FreeAndNil(FParams);
  2104. inherited Destroy;
  2105. end;
  2106. procedure TSQLTransaction.EndTransaction;
  2107. begin
  2108. Case Action of
  2109. caCommit, caCommitRetaining :
  2110. Commit;
  2111. caNone,
  2112. caRollback, caRollbackRetaining :
  2113. if not (stoUseImplicit in Options) then
  2114. RollBack
  2115. else
  2116. CloseTrans;
  2117. end;
  2118. end;
  2119. procedure TSQLTransaction.SetParams(const AValue: TStringList);
  2120. begin
  2121. FParams.Assign(AValue);
  2122. end;
  2123. function TSQLTransaction.GetSQLConnection: TSQLConnection;
  2124. begin
  2125. Result:=Database as TSQLConnection;
  2126. end;
  2127. procedure TSQLTransaction.SetOptions(AValue: TSQLTransactionOptions);
  2128. begin
  2129. if FOptions=AValue then Exit;
  2130. if (stoUseImplicit in Avalue) and Assigned(SQLConnection) And Not (sqImplicitTransaction in SQLConnection.ConnOptions) then
  2131. DatabaseErrorFmt(SErrNoImplicitTransaction, [SQLConnection.ClassName]);
  2132. FOptions:=AValue;
  2133. end;
  2134. procedure TSQLTransaction.SetSQLConnection(AValue: TSQLConnection);
  2135. begin
  2136. Database:=AValue;
  2137. end;
  2138. Procedure TSQLTransaction.MaybeStartTransaction;
  2139. begin
  2140. if not Active then
  2141. begin
  2142. if (stoExplicitStart in Options) then
  2143. DatabaseErrorFmt(SErrImplictTransactionStart, [Database.Name,Name]);
  2144. StartTransaction;
  2145. end;
  2146. end;
  2147. function TSQLTransaction.GetHandle: Pointer;
  2148. begin
  2149. Result := SQLConnection.GetTransactionHandle(FTrans);
  2150. end;
  2151. Function TSQLTransaction.AllowClose(DS: TDBDataset): Boolean;
  2152. begin
  2153. if (DS is TSQLQuery) then
  2154. Result:=not (sqoKeepOpenOnCommit in TSQLQuery(DS).Options)
  2155. else
  2156. Result:=Inherited AllowClose(DS);
  2157. end;
  2158. procedure TSQLTransaction.Commit;
  2159. begin
  2160. if Active then
  2161. begin
  2162. CloseDataSets;
  2163. If LogEvent(detCommit) then
  2164. Log(detCommit,SCommitting);
  2165. // The inherited closetrans must always be called.
  2166. // So the last (FTrans=Nil) is for the case of forced close. (Bug IDs 35246 and 33737)
  2167. // Order is important:
  2168. // some connections do not have FTrans, but they must still go through AttemptCommit.
  2169. if (stoUseImplicit in Options) or SQLConnection.AttemptCommit(FTrans) or (FTrans=Nil) then
  2170. begin
  2171. CloseTrans;
  2172. FreeAndNil(FTrans);
  2173. end;
  2174. end;
  2175. end;
  2176. procedure TSQLTransaction.CommitRetaining;
  2177. begin
  2178. if Active then
  2179. begin
  2180. If LogEvent(detCommit) then
  2181. Log(detCommit,SCommitRetaining);
  2182. SQLConnection.CommitRetaining(FTrans);
  2183. end;
  2184. end;
  2185. procedure TSQLTransaction.Rollback;
  2186. begin
  2187. if Active then
  2188. begin
  2189. if (stoUseImplicit in Options) then
  2190. DatabaseError(SErrImplicitNoRollBack);
  2191. CloseDataSets;
  2192. If LogEvent(detRollback) then
  2193. Log(detRollback,SRollingBack);
  2194. // The inherited closetrans must always be called.
  2195. // So the last (FTrans=Nil) is for the case of forced close. (Bug IDs 35246 and 33737)
  2196. // Order is important:
  2197. // some connections do not have FTrans, but they must still go through AttemptCommit.
  2198. // FTrans=Nil for the case of forced close.
  2199. if SQLConnection.AttemptRollBack(FTrans) or (FTrans=Nil) then
  2200. begin
  2201. CloseTrans;
  2202. FreeAndNil(FTrans);
  2203. end;
  2204. end;
  2205. end;
  2206. procedure TSQLTransaction.RollbackRetaining;
  2207. begin
  2208. if Active then
  2209. begin
  2210. if (stoUseImplicit in Options) then
  2211. DatabaseError(SErrImplicitNoRollBack);
  2212. If LogEvent(detRollback) then
  2213. Log(detRollback,SRollBackRetaining);
  2214. SQLConnection.RollBackRetaining(FTrans);
  2215. end;
  2216. end;
  2217. procedure TSQLTransaction.StartTransaction;
  2218. var db : TSQLConnection;
  2219. begin
  2220. if Active then
  2221. DatabaseError(SErrTransAlreadyActive);
  2222. db := SQLConnection;
  2223. if Db = nil then
  2224. DatabaseError(SErrDatabasenAssigned);
  2225. Db.MaybeConnect;
  2226. if not assigned(FTrans) then FTrans := Db.AllocateTransactionHandle;
  2227. if (stoUseImplicit in Options) then
  2228. begin
  2229. if Db.StartImplicitTransaction(FTrans,FParams.CommaText) then
  2230. OpenTrans
  2231. end
  2232. else
  2233. begin
  2234. if Db.StartDBTransaction(FTrans,FParams.CommaText) then
  2235. OpenTrans
  2236. end;
  2237. end;
  2238. Procedure TSQLTransaction.SetDatabase(Value: TDatabase);
  2239. begin
  2240. If Value<>Database then
  2241. begin
  2242. if Assigned(Value) and not (Value is TSQLConnection) then
  2243. DatabaseErrorFmt(SErrNotASQLConnection, [Value.Name], Self);
  2244. CheckInactive;
  2245. if (stoUseImplicit in Options) and Assigned(Value) and Not (sqImplicitTransaction in TSQLConnection(Value).ConnOptions) then
  2246. DatabaseErrorFmt(SErrNoImplicitTransaction, [Value.ClassName]);
  2247. If Assigned(Database) then
  2248. if SQLConnection.Transaction = Self then SQLConnection.Transaction := nil;
  2249. inherited;
  2250. If Assigned(Database) and not (csLoading in ComponentState) then
  2251. If SQLConnection.Transaction = Nil then SQLConnection.Transaction := Self;
  2252. end;
  2253. end;
  2254. Function TSQLTransaction.LogEvent(EventType: TDBEventType): Boolean;
  2255. begin
  2256. Result:=Assigned(Database) and SQLConnection.LogEvent(EventType);
  2257. end;
  2258. Procedure TSQLTransaction.Log(EventType: TDBEventType; Const Msg: String);
  2259. Var
  2260. M : String;
  2261. begin
  2262. If LogEvent(EventType) then
  2263. begin
  2264. If (Name<>'') then
  2265. M:=Name+' : '+Msg
  2266. else
  2267. M:=Msg;
  2268. SQLConnection.Log(EventType,M);
  2269. end;
  2270. end;
  2271. { TSQLSequence }
  2272. constructor TSQLSequence.Create(AQuery: TCustomSQLQuery);
  2273. begin
  2274. inherited Create;
  2275. FQuery := AQuery;
  2276. FApplyEvent := saeOnNewRecord;
  2277. FIncrementBy := 1;
  2278. end;
  2279. procedure TSQLSequence.Assign(Source: TPersistent);
  2280. var SourceSequence: TSQLSequence;
  2281. begin
  2282. if Source is TSQLSequence then
  2283. begin
  2284. SourceSequence := TSQLSequence(Source);
  2285. FFieldName := SourceSequence.FieldName;
  2286. FSequenceName := SourceSequence.SequenceName;
  2287. FIncrementBy := SourceSequence.IncrementBy;
  2288. FApplyEvent := SourceSequence.ApplyEvent;
  2289. end
  2290. else
  2291. inherited;
  2292. end;
  2293. procedure TSQLSequence.Apply;
  2294. var Field: TField;
  2295. begin
  2296. if Assigned(FQuery) and (FSequenceName<>'') and (FFieldName<>'') then
  2297. begin
  2298. Field := FQuery.FindField(FFieldName);
  2299. if Assigned(Field) and Field.IsNull then
  2300. Field.AsLargeInt := GetNextValue;
  2301. end;
  2302. end;
  2303. function TSQLSequence.GetNextValue: Int64;
  2304. begin
  2305. if (FQuery=Nil) or (FQuery.SQLConnection=Nil) then
  2306. DatabaseError(SErrDatabasenAssigned);
  2307. Result := FQuery.SQLConnection.GetNextValue(FSequenceName, FIncrementBy);
  2308. end;
  2309. Type
  2310. { TQuerySQLStatement }
  2311. TQuerySQLStatement = Class(TCustomSQLStatement)
  2312. protected
  2313. FQuery : TCustomSQLQuery;
  2314. function CreateParams: TSQLDBParams; override;
  2315. Function CreateDataLink : TDataLink; override;
  2316. Function GetSchemaType : TSchemaType; override;
  2317. Function GetSchemaObjectName : String; override;
  2318. Function GetSchemaPattern: String; override;
  2319. procedure GetStatementInfo(var ASQL: String; out Info: TSQLStatementInfo); override;
  2320. procedure OnChangeSQL(Sender : TObject); override;
  2321. public
  2322. constructor Create(AOwner: TComponent); override;
  2323. end;
  2324. { TQuerySQLStatement }
  2325. constructor TQuerySQLStatement.Create(AOwner: TComponent);
  2326. begin
  2327. FQuery:=TCustomSQLQuery(AOwner);
  2328. inherited Create(AOwner);
  2329. end;
  2330. function TQuerySQLStatement.CreateDataLink: TDataLink;
  2331. begin
  2332. Result:=TMasterParamsDataLink.Create(FQuery);
  2333. end;
  2334. function TQuerySQLStatement.CreateParams: TSQLDBParams;
  2335. begin
  2336. Result:=FQuery.CreateParams;
  2337. end;
  2338. function TQuerySQLStatement.GetSchemaType: TSchemaType;
  2339. begin
  2340. if Assigned(FQuery) then
  2341. Result:=FQuery.FSchemaType
  2342. else
  2343. Result:=stNoSchema;
  2344. end;
  2345. function TQuerySQLStatement.GetSchemaObjectName: String;
  2346. begin
  2347. if Assigned(FQuery) then
  2348. Result:=FQuery.FSchemaObjectname
  2349. else
  2350. Result:=inherited GetSchemaObjectName;
  2351. end;
  2352. function TQuerySQLStatement.GetSchemaPattern: String;
  2353. begin
  2354. if Assigned(FQuery) then
  2355. Result:=FQuery.FSchemaPattern
  2356. else
  2357. Result:=inherited GetSchemaPattern;
  2358. end;
  2359. procedure TQuerySQLStatement.GetStatementInfo(var ASQL: String; out Info: TSQLStatementInfo);
  2360. begin
  2361. inherited GetStatementInfo(ASQL, Info);
  2362. If Assigned(FQuery) then
  2363. // Note: practical side effect of switch off ParseSQL is that UpdateServerIndexDefs is bypassed
  2364. // which is used as performance tuning option
  2365. if (FQuery.FSchemaType = stNoSchema) and FParseSQL then
  2366. begin
  2367. FQuery.FUpdateable:=Info.Updateable;
  2368. FQuery.FTableName:=Info.TableName;
  2369. FQuery.FWhereStartPos:=Info.WhereStartPos;
  2370. FQuery.FWhereStopPos:=Info.WhereStopPos;
  2371. if FQuery.ServerFiltered then
  2372. ASQL:=FQuery.AddFilter(ASQL);
  2373. end
  2374. else
  2375. begin
  2376. FQuery.FUpdateable:=false;
  2377. FQuery.FTableName:='';
  2378. FQuery.FWhereStartPos:=0;
  2379. FQuery.FWhereStopPos:=0;
  2380. end;
  2381. end;
  2382. procedure TQuerySQLStatement.OnChangeSQL(Sender: TObject);
  2383. begin
  2384. UnPrepare;
  2385. inherited OnChangeSQL(Sender);
  2386. If ParamCheck and Assigned(FDataLink) then
  2387. (FDataLink as TMasterParamsDataLink).RefreshParamNames;
  2388. FQuery.ServerIndexDefs.Updated:=false;
  2389. end;
  2390. { TCustomSQLQuery }
  2391. function TCustomSQLQuery.CreateSQLStatement(aOwner: TComponent
  2392. ): TCustomSQLStatement;
  2393. begin
  2394. Result:=TQuerySQLStatement.Create(Self);
  2395. end;
  2396. constructor TCustomSQLQuery.Create(AOwner : TComponent);
  2397. begin
  2398. inherited Create(AOwner);
  2399. FStatement:=CreateSQLStatement(Self);
  2400. FInsertSQL := TStringList.Create;
  2401. FInsertSQL.OnChange := @OnChangeModifySQL;
  2402. FUpdateSQL := TStringList.Create;
  2403. FUpdateSQL.OnChange := @OnChangeModifySQL;
  2404. FDeleteSQL := TStringList.Create;
  2405. FDeleteSQL.OnChange := @OnChangeModifySQL;
  2406. FRefreshSQL := TStringList.Create;
  2407. FRefreshSQL.OnChange := @OnChangeModifySQL;
  2408. FSequence := TSQLSequence.Create(Self);
  2409. FServerIndexDefs := TServerIndexDefs.Create(Self);
  2410. FServerFiltered := False;
  2411. FServerFilterText := '';
  2412. FSchemaType:=stNoSchema;
  2413. FSchemaObjectName:='';
  2414. FSchemaPattern:='';
  2415. // Delphi has upWhereAll as default, but since strings and oldvalue's don't work yet
  2416. // (variants) set it to upWhereKeyOnly
  2417. FUpdateMode := upWhereKeyOnly;
  2418. FUsePrimaryKeyAsKey := True;
  2419. end;
  2420. destructor TCustomSQLQuery.Destroy;
  2421. begin
  2422. if Active then Close;
  2423. UnPrepare;
  2424. FreeAndNil(FStatement);
  2425. FreeAndNil(FInsertSQL);
  2426. FreeAndNil(FUpdateSQL);
  2427. FreeAndNil(FDeleteSQL);
  2428. FreeAndNil(FRefreshSQL);
  2429. FreeAndNil(FSequence);
  2430. FreeAndNil(FServerIndexDefs);
  2431. inherited Destroy;
  2432. end;
  2433. function TCustomSQLQuery.ParamByName(const AParamName: String): TParam;
  2434. begin
  2435. Result:=Params.ParamByName(AParamName);
  2436. end;
  2437. function TCustomSQLQuery.MacroByName(const AParamName: String): TParam;
  2438. begin
  2439. Result:=Macros.ParamByName(AParamName);
  2440. end;
  2441. procedure TCustomSQLQuery.OnChangeModifySQL(Sender : TObject);
  2442. begin
  2443. CheckInactive;
  2444. end;
  2445. procedure TCustomSQLQuery.SetDatabase(Value : TDatabase);
  2446. var DB : TSQLConnection;
  2447. begin
  2448. if Database = Value then Exit;
  2449. if Assigned(Value) and not (Value is TSQLConnection) then
  2450. DatabaseErrorFmt(SErrNotASQLConnection, [Value.Name], Self);
  2451. UnPrepare;
  2452. DB := TSQLConnection(Value);
  2453. If Assigned(FStatement) then
  2454. FStatement.Database := DB;
  2455. inherited;
  2456. if Assigned(DB) and Assigned(DB.Transaction) and (not Assigned(Transaction) or (Transaction.DataBase<>Database)) then
  2457. Transaction := DB.Transaction;
  2458. end;
  2459. procedure TCustomSQLQuery.SetTransaction(Value: TDBTransaction);
  2460. begin
  2461. if Transaction = Value then Exit;
  2462. UnPrepare;
  2463. inherited;
  2464. If Assigned(FStatement) then
  2465. FStatement.Transaction := TSQLTransaction(Value);
  2466. If Assigned(Transaction) and Assigned(Transaction.DataBase) and (Database<>Transaction.DataBase) then
  2467. Database := Transaction.Database;
  2468. end;
  2469. function TCustomSQLQuery.IsPrepared: Boolean;
  2470. begin
  2471. if Assigned(Fstatement) then
  2472. Result := FStatement.Prepared
  2473. else
  2474. Result := False;
  2475. end;
  2476. function TCustomSQLQuery.AddFilter(const SQLstr: string): string;
  2477. Var
  2478. Res : String;
  2479. begin
  2480. Res:=SQLStr;
  2481. if (FWhereStartPos > 0) and (FWhereStopPos > 0) then
  2482. begin
  2483. system.insert('(',Res,FWhereStartPos+1);
  2484. system.insert(')',Res,FWhereStopPos+1);
  2485. end;
  2486. if FWhereStartPos = 0 then
  2487. Res := Res + ' where (' + ServerFilter + ')'
  2488. else if FWhereStopPos > 0 then
  2489. system.insert(' and ('+ServerFilter+') ',res,FWhereStopPos+2)
  2490. else
  2491. system.insert(' where ('+ServerFilter+') ',res,FWhereStartPos);
  2492. Result := res;
  2493. end;
  2494. procedure TCustomSQLQuery.OpenCursor(InfoQuery: Boolean);
  2495. begin
  2496. if InfoQuery then
  2497. CheckPrepare;
  2498. try
  2499. inherited OpenCursor(InfoQuery);
  2500. finally
  2501. if InfoQuery then
  2502. CheckUnPrepare;
  2503. end;
  2504. end;
  2505. function TCustomSQLQuery.NeedRefreshRecord(UpdateKind: TUpdateKind): Boolean;
  2506. Var
  2507. PF : TProviderFlag;
  2508. I : Integer;
  2509. DoReturning : Boolean;
  2510. begin
  2511. Result:=(Trim(FRefreshSQL.Text)<>'');
  2512. DoReturning:=(sqSupportReturning in SQLConnection.ConnOptions) and not (sqoRefreshUsingSelect in Options);
  2513. if Not (Result or DoReturning) then
  2514. begin
  2515. PF:=RefreshFlags[UpdateKind];
  2516. I:=0;
  2517. While (Not Result) and (I<Fields.Count) do
  2518. begin
  2519. Result:=PF in Fields[i].ProviderFlags;
  2520. Inc(I);
  2521. end;
  2522. end;
  2523. end;
  2524. function TCustomSQLQuery.RefreshRecord(UpdateKind: TUpdateKind): Boolean;
  2525. Var
  2526. Q : TCustomSQLQuery;
  2527. P : TParam;
  2528. F,FD : TField;
  2529. N : String;
  2530. begin
  2531. Result:=False;
  2532. Q:=TCustomSQLQuery.Create(Nil);
  2533. try
  2534. Q.Database:=Self.Database;
  2535. Q.Transaction:=Self.Transaction;
  2536. Q.SQL.Text:=SQLConnection.ConstructRefreshSQL(Self,UpdateKind);
  2537. For P in Q.Params do
  2538. begin
  2539. N:=P.Name;
  2540. If CompareText(Copy(N,1,4),'OLD_')=0 then
  2541. system.Delete(N,1,4);
  2542. F:=Fields.FindField(N);
  2543. if Assigned(F) then
  2544. P.AssignField(F);
  2545. end;
  2546. Q.Open;
  2547. try
  2548. if (Q.EOF and Q.BOF) then
  2549. DatabaseError(SErrRefreshEmptyResult,Self)
  2550. else
  2551. begin
  2552. if Q.RecordCount<>1 then
  2553. DatabaseErrorFmt(SErrRefreshNotSingleton,[Q.RecordCount],Self);
  2554. For F in Q.Fields do
  2555. begin
  2556. FD:=Fields.FindField(F.FieldName);
  2557. if Assigned(FD) then
  2558. begin
  2559. FD.Assign(F);
  2560. Result:=True; // We could check if the new value differs from the old, but we won't.
  2561. end;
  2562. end;
  2563. end
  2564. finally
  2565. Q.Close;
  2566. end;
  2567. finally
  2568. Q.Free;
  2569. end;
  2570. end;
  2571. procedure TCustomSQLQuery.ApplyReturningResult(Q: TCustomSQLQuery; UpdateKind : TUpdateKind);
  2572. Var
  2573. S : TDataSetState;
  2574. refreshFlag : TProviderFlag;
  2575. F : TField;
  2576. begin
  2577. RefreshFlag:=RefreshFlags[UpdateKind];
  2578. S:=SetTempState(dsRefreshFields);
  2579. try
  2580. For F in Fields do
  2581. if RefreshFlag in F.ProviderFlags then
  2582. F.Assign(Q.FieldByName(F.FieldName));
  2583. finally
  2584. RestoreState(S);
  2585. end;
  2586. end;
  2587. procedure TCustomSQLQuery.ApplyFilter;
  2588. begin
  2589. if Prepared then
  2590. FStatement.Unprepare;
  2591. InternalRefresh;
  2592. First;
  2593. end;
  2594. procedure TCustomSQLQuery.SetServerFiltered(Value: Boolean);
  2595. begin
  2596. if Value and not ParseSQL then
  2597. DatabaseErrorFmt(SNoParseSQL,['Filtering ']);
  2598. if (ServerFiltered <> Value) then
  2599. begin
  2600. FServerFiltered := Value;
  2601. if Active then ApplyFilter;
  2602. end;
  2603. end;
  2604. procedure TCustomSQLQuery.SetServerFilterText(const Value: string);
  2605. begin
  2606. if Value <> ServerFilter then
  2607. begin
  2608. FServerFilterText := Value;
  2609. if Active then ApplyFilter;
  2610. end;
  2611. end;
  2612. procedure TCustomSQLQuery.Prepare;
  2613. begin
  2614. FStatement.Prepare;
  2615. end;
  2616. procedure TCustomSQLQuery.UnPrepare;
  2617. begin
  2618. if Not Refreshing then
  2619. CheckInactive;
  2620. If Assigned(FStatement) then
  2621. FStatement.Unprepare;
  2622. end;
  2623. procedure TCustomSQLQuery.FreeFldBuffers;
  2624. begin
  2625. if assigned(Cursor) then
  2626. SQLConnection.FreeFldBuffers(Cursor);
  2627. end;
  2628. function TCustomSQLQuery.GetMacroChar: Char;
  2629. begin
  2630. Result := FStatement.MacroChar;
  2631. end;
  2632. function TCustomSQLQuery.GetParamCheck: Boolean;
  2633. begin
  2634. Result:=FStatement.ParamCheck;
  2635. end;
  2636. function TCustomSQLQuery.GetParams: TParams;
  2637. begin
  2638. Result:=FStatement.Params;
  2639. end;
  2640. function TCustomSQLQuery.GetMacroCheck: Boolean;
  2641. begin
  2642. Result:=FStatement.MacroCheck;
  2643. end;
  2644. function TCustomSQLQuery.GetMacros: TParams;
  2645. begin
  2646. Result:=FStatement.Macros;
  2647. end;
  2648. function TCustomSQLQuery.GetParseSQL: Boolean;
  2649. begin
  2650. Result:=FStatement.ParseSQL;
  2651. end;
  2652. function TCustomSQLQuery.GetServerIndexDefs: TServerIndexDefs;
  2653. begin
  2654. Result := FServerIndexDefs;
  2655. end;
  2656. function TCustomSQLQuery.GetSQL: TStringList;
  2657. begin
  2658. Result:=TStringList(Fstatement.SQL);
  2659. end;
  2660. function TCustomSQLQuery.GetSQLConnection: TSQLConnection;
  2661. begin
  2662. Result:=Database as TSQLConnection;
  2663. end;
  2664. function TCustomSQLQuery.GetSQLTransaction: TSQLTransaction;
  2665. begin
  2666. Result:=Transaction as TSQLTransaction;
  2667. end;
  2668. function TCustomSQLQuery.Cursor: TSQLCursor;
  2669. begin
  2670. Result:=FStatement.Cursor;
  2671. end;
  2672. function TCustomSQLQuery.Fetch : boolean;
  2673. begin
  2674. if Not Assigned(Cursor) then
  2675. Exit;
  2676. if not Cursor.FSelectable then
  2677. Exit;
  2678. If LogEvent(detFetch) then
  2679. Log(detFetch,FStatement.FServerSQL);
  2680. if not FIsEof then FIsEOF := not SQLConnection.Fetch(Cursor);
  2681. Result := not FIsEOF;
  2682. end;
  2683. procedure TCustomSQLQuery.Execute;
  2684. begin
  2685. FStatement.DoExecute;
  2686. end;
  2687. function TCustomSQLQuery.RowsAffected: TRowsCount;
  2688. begin
  2689. Result:=FStatement.RowsAffected;
  2690. end;
  2691. function TCustomSQLQuery.LoadField(FieldDef : TFieldDef; buffer : pointer; out CreateBlob : boolean) : boolean;
  2692. begin
  2693. Result := SQLConnection.LoadField(Cursor, FieldDef, buffer, CreateBlob);
  2694. // disable deferred blob loading for "disconnected" datasets
  2695. if Result and (FieldDef.DataType in ftBlobTypes) and (sqoKeepOpenOnCommit in Options) then
  2696. CreateBlob:=True
  2697. end;
  2698. procedure TCustomSQLQuery.LoadBlobIntoBuffer(FieldDef: TFieldDef;
  2699. ABlobBuf: PBufBlobField);
  2700. begin
  2701. SQLConnection.LoadBlobIntoBuffer(FieldDef, ABlobBuf, Cursor,SQLTransaction);
  2702. end;
  2703. procedure TCustomSQLQuery.InternalAddRecord(Buffer: Pointer; AAppend: Boolean);
  2704. begin
  2705. // not implemented - sql dataset
  2706. end;
  2707. procedure TCustomSQLQuery.InternalClose;
  2708. begin
  2709. if assigned(Cursor) then
  2710. begin
  2711. if Cursor.FSelectable then
  2712. FreeFldBuffers;
  2713. CheckUnPrepare;
  2714. // Some SQLConnections does not support statement [un]preparation,
  2715. // so let them do cleanup f.e. cancel pending queries and/or free resultset
  2716. // if not Prepared then
  2717. // FStatement.DoUnprepare;
  2718. end;
  2719. if DefaultFields then
  2720. DestroyFields;
  2721. FIsEOF := False;
  2722. if assigned(FUpdateQry) then FreeAndNil(FUpdateQry);
  2723. if assigned(FInsertQry) then FreeAndNil(FInsertQry);
  2724. if assigned(FDeleteQry) then FreeAndNil(FDeleteQry);
  2725. // FRecordSize := 0;
  2726. inherited InternalClose;
  2727. end;
  2728. procedure TCustomSQLQuery.InternalInitFieldDefs;
  2729. begin
  2730. if FLoadingFieldDefs then
  2731. Exit;
  2732. FLoadingFieldDefs := True;
  2733. try
  2734. FieldDefs.Clear;
  2735. SQLConnection.AddFieldDefs(Cursor,FieldDefs);
  2736. finally
  2737. FLoadingFieldDefs := False;
  2738. if assigned(Cursor) then Cursor.FInitFieldDef := False;
  2739. end;
  2740. end;
  2741. procedure TCustomSQLQuery.InternalOpen;
  2742. var counter, fieldc : integer;
  2743. F : TField;
  2744. IndexFields : TStrings;
  2745. begin
  2746. if IsReadFromPacket then
  2747. begin
  2748. // When we read from file there is no need for Cursor, also note that Database may not be assigned
  2749. //FStatement.AllocateCursor;
  2750. //Cursor.FSelectable:=True;
  2751. //Cursor.FStatementType:=stSelect;
  2752. FUpdateable:=True;
  2753. end
  2754. else
  2755. begin
  2756. CheckPrepare;
  2757. if not Cursor.FSelectable then
  2758. DatabaseError(SErrNoSelectStatement,Self);
  2759. // Call UpdateServerIndexDefs before Execute, to avoid problems with connections
  2760. // which do not allow processing multiple recordsets at a time. (Microsoft
  2761. // calls this MARS, see bug 13241)
  2762. if DefaultFields and FUpdateable and FusePrimaryKeyAsKey and (not IsUniDirectional) then
  2763. UpdateServerIndexDefs;
  2764. FStatement.Execute;
  2765. if (Cursor=nil) or (not Cursor.FSelectable) then
  2766. DatabaseError(SErrNoSelectStatement,Self);
  2767. // InternalInitFieldDef is only called after a prepare. i.e. not twice if
  2768. // a dataset is opened - closed - opened.
  2769. if Cursor.FInitFieldDef then
  2770. InternalInitFieldDefs;
  2771. if DefaultFields then
  2772. begin
  2773. CreateFields;
  2774. if FUpdateable and FusePrimaryKeyAsKey and (not IsUniDirectional) then
  2775. for counter := 0 to ServerIndexDefs.Count-1 do
  2776. if ixPrimary in ServerIndexDefs[counter].Options then
  2777. begin
  2778. IndexFields := TStringList.Create;
  2779. ExtractStrings([';'],[' '],pchar(ServerIndexDefs[counter].Fields),IndexFields);
  2780. for fieldc := 0 to IndexFields.Count-1 do
  2781. begin
  2782. F := FindField(IndexFields[fieldc]);
  2783. if F <> nil then
  2784. F.ProviderFlags := F.ProviderFlags + [pfInKey];
  2785. end;
  2786. IndexFields.Free;
  2787. end;
  2788. end;
  2789. end;
  2790. BindFields(True);
  2791. if not ReadOnly and not FUpdateable and (FSchemaType=stNoSchema) then
  2792. begin
  2793. if (trim(FDeleteSQL.Text) <> '') or (trim(FUpdateSQL.Text) <> '') or
  2794. (trim(FInsertSQL.Text) <> '') then FUpdateable := True;
  2795. end;
  2796. inherited InternalOpen;
  2797. end;
  2798. procedure TCustomSQLQuery.InternalRefresh;
  2799. begin
  2800. if (ChangeCount>0) and (sqoCancelUpdatesOnRefresh in Options) then
  2801. CancelUpdates;
  2802. inherited InternalRefresh;
  2803. end;
  2804. // public part
  2805. procedure TCustomSQLQuery.CheckPrepare;
  2806. begin
  2807. if Not IsPrepared then
  2808. begin
  2809. Prepare;
  2810. FDoUnPrepare:=True;
  2811. end;
  2812. end;
  2813. procedure TCustomSQLQuery.CheckUnPrepare;
  2814. begin
  2815. if FDoUnPrepare then
  2816. begin
  2817. FDoUnPrepare:=False;
  2818. UnPrepare;
  2819. end;
  2820. end;
  2821. procedure TCustomSQLQuery.ExecSQL;
  2822. begin
  2823. CheckPrepare;
  2824. try
  2825. Execute;
  2826. // Always retrieve rows affected
  2827. FStatement.RowsAffected;
  2828. If sqoAutoCommit in Options then
  2829. SQLTransaction.Commit;
  2830. finally
  2831. CheckUnPrepare;
  2832. // if not Prepared and (assigned(Database)) and (assigned(Cursor)) then SQLConnection.UnPrepareStatement(Cursor);
  2833. end;
  2834. end;
  2835. procedure TCustomSQLQuery.ApplyUpdates(MaxErrors: Integer);
  2836. begin
  2837. inherited ApplyUpdates(MaxErrors);
  2838. If sqoAutoCommit in Options then
  2839. begin
  2840. // Retrieve rows affected for last update.
  2841. FStatement.RowsAffected;
  2842. SQLTransaction.Commit;
  2843. end;
  2844. end;
  2845. procedure TCustomSQLQuery.Post;
  2846. begin
  2847. inherited Post;
  2848. If (sqoAutoApplyUpdates in Options) then
  2849. ApplyUpdates;
  2850. end;
  2851. procedure TCustomSQLQuery.Delete;
  2852. begin
  2853. inherited Delete;
  2854. If (sqoAutoApplyUpdates in Options) then
  2855. ApplyUpdates;
  2856. end;
  2857. procedure TCustomSQLQuery.SetReadOnly(AValue : Boolean);
  2858. begin
  2859. CheckInactive;
  2860. inherited SetReadOnly(AValue);
  2861. end;
  2862. procedure TCustomSQLQuery.SetParseSQL(AValue : Boolean);
  2863. begin
  2864. CheckInactive;
  2865. FStatement.ParseSQL:=AValue;
  2866. if not AValue then
  2867. FServerFiltered := False;
  2868. end;
  2869. procedure TCustomSQLQuery.SetSQL(const AValue: TStringList);
  2870. begin
  2871. FStatement.SQL.Assign(AValue);
  2872. end;
  2873. procedure TCustomSQLQuery.SetUsePrimaryKeyAsKey(AValue : Boolean);
  2874. begin
  2875. if not Active then FusePrimaryKeyAsKey := AValue
  2876. else
  2877. begin
  2878. // Just temporary, this should be possible in the future
  2879. DatabaseError(SActiveDataset);
  2880. end;
  2881. end;
  2882. procedure TCustomSQLQuery.UpdateServerIndexDefs;
  2883. begin
  2884. FServerIndexDefs.Clear;
  2885. if assigned(DataBase) and (FTableName<>'') then
  2886. SQLConnection.UpdateIndexDefs(ServerIndexDefs,FTableName);
  2887. end;
  2888. function TCustomSQLQuery.NeedLastInsertID: TField;
  2889. Var
  2890. I : Integer;
  2891. begin
  2892. Result:=Nil;
  2893. if sqLastInsertID in SQLConnection.ConnOptions then
  2894. begin
  2895. I:=0;
  2896. While (Result=Nil) and (I<Fields.Count) do
  2897. begin
  2898. Result:=Fields[i];
  2899. if (Result.DataType<>ftAutoInc) or not Result.IsNull then
  2900. Result:=Nil;
  2901. Inc(I);
  2902. end;
  2903. end
  2904. end;
  2905. procedure TCustomSQLQuery.SetMacroChar(AValue: Char);
  2906. begin
  2907. FStatement.MacroChar:=AValue;
  2908. end;
  2909. function TCustomSQLQuery.RefreshLastInsertID(Field: TField): Boolean;
  2910. begin
  2911. Result:=SQLConnection.RefreshLastInsertID(Self, Field);
  2912. end;
  2913. procedure TCustomSQLQuery.ApplyRecUpdate(UpdateKind: TUpdateKind);
  2914. Var
  2915. DoRefresh : Boolean;
  2916. LastIDField : TField;
  2917. S : TDataSetState;
  2918. begin
  2919. // Moved to connection: the SQLConnection always has more information about types etc.
  2920. // than SQLQuery itself.
  2921. SQLConnection.ApplyRecUpdate(Self,UpdateKind);
  2922. if UpdateKind=ukInsert then
  2923. LastIDField:=NeedLastInsertID
  2924. else
  2925. LastIDField:=nil;
  2926. DoRefresh:=(UpdateKind in [ukModify,ukInsert]) and NeedRefreshRecord(UpdateKind);
  2927. if assigned(LastIDField) or DoRefresh then
  2928. begin
  2929. // updates fields directly in record buffer of TBufDataSet
  2930. // TDataSet buffers are resynchronized at end of ApplyUpdates process
  2931. S:=SetTempState(dsRefreshFields);
  2932. try
  2933. if assigned(LastIDField) then
  2934. RefreshLastInsertID(LastIDField);
  2935. if DoRefresh then
  2936. RefreshRecord(UpdateKind);
  2937. finally
  2938. RestoreState(S);
  2939. end;
  2940. end;
  2941. end;
  2942. procedure TCustomSQLQuery.SetPacketRecords(aValue: integer);
  2943. begin
  2944. if (AValue=PacketRecords) then exit;
  2945. if (AValue<>-1) and (sqoKeepOpenOnCommit in Options) then
  2946. DatabaseError(SErrDisconnectedPacketRecords);
  2947. Inherited SetPacketRecords(aValue);
  2948. end;
  2949. function TCustomSQLQuery.GetCanModify: Boolean;
  2950. begin
  2951. // the test for assigned(Cursor) is needed for the case that the dataset isn't opened
  2952. if assigned(Cursor) and (Cursor.FStatementType = stSelect) then
  2953. Result:= FUpdateable and (not ReadOnly) and (not IsUniDirectional)
  2954. else
  2955. Result := False;
  2956. end;
  2957. procedure TCustomSQLQuery.SetUpdateMode(AValue : TUpdateMode);
  2958. begin
  2959. FUpdateMode := AValue;
  2960. end;
  2961. procedure TCustomSQLQuery.SetSchemaInfo( ASchemaType : TSchemaType; ASchemaObjectName, ASchemaPattern : string);
  2962. begin
  2963. FSchemaType:=ASchemaType;
  2964. FSchemaObjectName:=ASchemaObjectName;
  2965. FSchemaPattern:=ASchemaPattern;
  2966. end;
  2967. procedure TCustomSQLQuery.BeforeRefreshOpenCursor;
  2968. begin
  2969. // This is only necessary because TIBConnection can not re-open a
  2970. // prepared cursor. In fact this is wrong, but has never led to
  2971. // problems because in SetActive(false) queries are always
  2972. // unprepared. (which is also wrong, but has to be fixed later)
  2973. if IsPrepared then with SQLConnection do
  2974. UnPrepareStatement(Cursor);
  2975. end;
  2976. function TCustomSQLQuery.CreateParams: TSQLDBParams;
  2977. begin
  2978. Result:=TSQLDBParams.Create(Nil);
  2979. end;
  2980. function TCustomSQLQuery.LogEvent(EventType: TDBEventType): Boolean;
  2981. begin
  2982. Result:=Assigned(Database) and SQLConnection.LogEvent(EventType);
  2983. end;
  2984. procedure TCustomSQLQuery.Log(EventType: TDBEventType; const Msg: String);
  2985. Var
  2986. M : String;
  2987. begin
  2988. If LogEvent(EventType) then
  2989. begin
  2990. M:=Msg;
  2991. If (Name<>'') then
  2992. M:=Name+' : '+M;
  2993. SQLConnection.Log(EventType,M);
  2994. end;
  2995. end;
  2996. class function TCustomSQLQuery.FieldDefsClass: TFieldDefsClass;
  2997. begin
  2998. Result:=TSQLDBFieldDefs;
  2999. end;
  3000. function TCustomSQLQuery.GetStatementType : TStatementType;
  3001. begin
  3002. if Assigned(Cursor) then
  3003. Result:=Cursor.FStatementType
  3004. else
  3005. Result:=stUnknown;
  3006. end;
  3007. function TCustomSQLQuery.HasMacros: Boolean;
  3008. begin
  3009. Result := Macros.Count > 0;
  3010. end;
  3011. function TCustomSQLQuery.HasParams: Boolean;
  3012. begin
  3013. Result := Params.Count > 0;
  3014. end;
  3015. procedure TCustomSQLQuery.SetParamCheck(AValue: Boolean);
  3016. begin
  3017. FStatement.ParamCheck:=AValue;
  3018. end;
  3019. procedure TCustomSQLQuery.SetMacroCheck(AValue: Boolean);
  3020. begin
  3021. FStatement.MacroCheck:=AValue;
  3022. end;
  3023. procedure TCustomSQLQuery.SetOptions(AValue: TSQLQueryOptions);
  3024. begin
  3025. if FOptions=AValue then Exit;
  3026. CheckInactive;
  3027. FOptions:=AValue;
  3028. if sqoKeepOpenOnCommit in FOptions then
  3029. PacketRecords:=-1;
  3030. end;
  3031. procedure TCustomSQLQuery.SetSQLConnection(AValue: TSQLConnection);
  3032. begin
  3033. Database:=AValue;
  3034. end;
  3035. procedure TCustomSQLQuery.SetSQLTransaction(AValue: TSQLTransaction);
  3036. begin
  3037. Transaction:=AValue;
  3038. end;
  3039. procedure TCustomSQLQuery.SetInsertSQL(const AValue: TStringList);
  3040. begin
  3041. FInsertSQL.Assign(AValue);
  3042. end;
  3043. procedure TCustomSQLQuery.SetUpdateSQL(const AValue: TStringList);
  3044. begin
  3045. FUpdateSQL.Assign(AValue);
  3046. end;
  3047. procedure TCustomSQLQuery.SetDeleteSQL(const AValue: TStringList);
  3048. begin
  3049. FDeleteSQL.Assign(AValue);
  3050. end;
  3051. procedure TCustomSQLQuery.SetRefreshSQL(const AValue: TStringList);
  3052. begin
  3053. FRefreshSQL.Assign(AValue);
  3054. end;
  3055. procedure TCustomSQLQuery.SetParams(AValue: TParams);
  3056. begin
  3057. FStatement.Params.Assign(AValue);
  3058. end;
  3059. procedure TCustomSQLQuery.SetMacros(AValue: TParams);
  3060. begin
  3061. FStatement.Macros.Assign(AValue);
  3062. end;
  3063. procedure TCustomSQLQuery.SetDataSource(AValue: TDataSource);
  3064. Var
  3065. DS : TDataSource;
  3066. begin
  3067. DS:=DataSource;
  3068. If (AValue<>DS) then
  3069. begin
  3070. If Assigned(AValue) and (AValue.Dataset=Self) then
  3071. DatabaseError(SErrCircularDataSourceReferenceNotAllowed,Self);
  3072. If Assigned(DS) then
  3073. DS.RemoveFreeNotification(Self);
  3074. FStatement.DataSource:=AValue;
  3075. end;
  3076. end;
  3077. function TCustomSQLQuery.GetDataSource: TDataSource;
  3078. begin
  3079. If Assigned(FStatement) then
  3080. Result:=FStatement.DataSource
  3081. else
  3082. Result:=Nil;
  3083. end;
  3084. procedure TCustomSQLQuery.Notification(AComponent: TComponent; Operation: TOperation);
  3085. begin
  3086. Inherited;
  3087. If (Operation=opRemove) and (AComponent=DataSource) then
  3088. DataSource:=Nil;
  3089. end;
  3090. procedure TCustomSQLQuery.DoOnNewRecord;
  3091. begin
  3092. inherited;
  3093. if FSequence.ApplyEvent = saeOnNewRecord then
  3094. FSequence.Apply;
  3095. end;
  3096. procedure TCustomSQLQuery.DoBeforePost;
  3097. begin
  3098. if (State = dsInsert) and (FSequence.ApplyEvent = saeOnPost) then
  3099. FSequence.Apply;
  3100. inherited;
  3101. end;
  3102. function TCustomSQLQuery.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
  3103. var
  3104. PrevErrorCode, ErrorCode: Integer;
  3105. begin
  3106. if Assigned(Prev) then
  3107. PrevErrorCode := Prev.ErrorCode
  3108. else
  3109. PrevErrorCode := 0;
  3110. if E is ESQLDatabaseError then
  3111. ErrorCode := ESQLDatabaseError(E).ErrorCode
  3112. else
  3113. ErrorCode := 0;
  3114. Result := EUpdateError.Create(SOnUpdateError, E.Message, ErrorCode, PrevErrorCode, E);
  3115. end;
  3116. function TCustomSQLQuery.PSGetTableName: string;
  3117. begin
  3118. Result := FTableName;
  3119. end;
  3120. { TSQLScript }
  3121. procedure TSQLScript.ExecuteStatement(SQLStatement: TStrings;
  3122. var StopExecution: Boolean);
  3123. begin
  3124. fquery.SQL.assign(SQLStatement);
  3125. fquery.ExecSQL;
  3126. end;
  3127. procedure TSQLScript.ExecuteDirective(Directive, Argument: String;
  3128. var StopExecution: Boolean);
  3129. begin
  3130. if assigned (FOnDirective) then
  3131. FOnDirective (Self, Directive, Argument, StopExecution);
  3132. end;
  3133. procedure TSQLScript.ExecuteCommit(CommitRetaining: boolean=true);
  3134. begin
  3135. if FTransaction is TSQLTransaction then
  3136. if CommitRetaining then
  3137. TSQLTransaction(FTransaction).CommitRetaining
  3138. else
  3139. begin
  3140. TSQLTransaction(FTransaction).Commit;
  3141. TSQLTransaction(FTransaction).StartTransaction;
  3142. end
  3143. else
  3144. begin
  3145. FTransaction.Active := false;
  3146. FTransaction.Active := true;
  3147. end;
  3148. end;
  3149. procedure TSQLScript.SetDatabase(Value: TDatabase);
  3150. begin
  3151. FDatabase := Value;
  3152. end;
  3153. procedure TSQLScript.SetTransaction(Value: TDBTransaction);
  3154. begin
  3155. FTransaction := Value;
  3156. end;
  3157. procedure TSQLScript.CheckDatabase;
  3158. begin
  3159. If (FDatabase=Nil) then
  3160. DatabaseError(SErrNoDatabaseAvailable,Self)
  3161. end;
  3162. function TSQLScript.CreateQuery: TCustomSQLQuery;
  3163. begin
  3164. Result := TCustomSQLQuery.Create(nil);
  3165. Result.ParamCheck := false; // Do not parse for parameters; breaks use of e.g. select bla into :bla in Firebird procedures
  3166. end;
  3167. constructor TSQLScript.Create(AOwner: TComponent);
  3168. begin
  3169. inherited Create(AOwner);
  3170. FQuery := CreateQuery;
  3171. end;
  3172. destructor TSQLScript.Destroy;
  3173. begin
  3174. FQuery.Free;
  3175. inherited Destroy;
  3176. end;
  3177. procedure TSQLScript.Execute;
  3178. begin
  3179. FQuery.DataBase := FDatabase;
  3180. FQuery.Transaction := FTransaction;
  3181. inherited Execute;
  3182. end;
  3183. procedure TSQLScript.ExecuteScript;
  3184. begin
  3185. Execute;
  3186. end;
  3187. { Connection definitions }
  3188. Var
  3189. ConnDefs : TStringList;
  3190. Procedure CheckDefs;
  3191. begin
  3192. If (ConnDefs=Nil) then
  3193. begin
  3194. ConnDefs:=TStringList.Create;
  3195. ConnDefs.Sorted:=True;
  3196. ConnDefs.Duplicates:=dupError;
  3197. end;
  3198. end;
  3199. Procedure DoneDefs;
  3200. Var
  3201. I : Integer;
  3202. begin
  3203. If Assigned(ConnDefs) then
  3204. begin
  3205. For I:=ConnDefs.Count-1 downto 0 do
  3206. begin
  3207. ConnDefs.Objects[i].Free;
  3208. ConnDefs.Delete(I);
  3209. end;
  3210. FreeAndNil(ConnDefs);
  3211. end;
  3212. end;
  3213. Function GetConnectionDef(const ConnectorName : String) : TConnectionDef;
  3214. Var
  3215. I : Integer;
  3216. begin
  3217. CheckDefs;
  3218. I:=ConnDefs.IndexOf(ConnectorName);
  3219. If (I<>-1) then
  3220. Result:=TConnectionDef(ConnDefs.Objects[i])
  3221. else
  3222. Result:=Nil;
  3223. end;
  3224. procedure RegisterConnection(Def: TConnectionDefClass);
  3225. Var
  3226. I : Integer;
  3227. begin
  3228. CheckDefs;
  3229. I:=ConnDefs.IndexOf(Def.TypeName);
  3230. If (I=-1) then
  3231. ConnDefs.AddObject(Def.TypeName,Def.Create)
  3232. else
  3233. begin
  3234. ConnDefs.Objects[I].Free;
  3235. ConnDefs.Objects[I]:=Def.Create;
  3236. end;
  3237. end;
  3238. procedure UnRegisterConnection(Def: TConnectionDefClass);
  3239. begin
  3240. UnRegisterConnection(Def.TypeName);
  3241. end;
  3242. procedure UnRegisterConnection(const ConnectionName: String);
  3243. Var
  3244. I : Integer;
  3245. begin
  3246. if (ConnDefs<>Nil) then
  3247. begin
  3248. I:=ConnDefs.IndexOf(ConnectionName);
  3249. If (I<>-1) then
  3250. begin
  3251. ConnDefs.Objects[I].Free;
  3252. ConnDefs.Delete(I);
  3253. end;
  3254. end;
  3255. end;
  3256. procedure GetConnectionList(List: TSTrings);
  3257. begin
  3258. CheckDefs;
  3259. List.Text:=ConnDefs.Text;
  3260. end;
  3261. { TSQLConnector }
  3262. procedure TSQLConnector.SetConnectorType(const AValue: String);
  3263. begin
  3264. if FConnectorType<>AValue then
  3265. begin
  3266. CheckDisconnected;
  3267. If Assigned(FProxy) then
  3268. FreeProxy;
  3269. FConnectorType:=AValue;
  3270. CreateProxy;
  3271. end;
  3272. end;
  3273. procedure TSQLConnector.SetForcedClose(AValue: Boolean);
  3274. begin
  3275. inherited SetForcedClose(AValue);
  3276. FProxy.ForcedClose:=aValue;
  3277. end;
  3278. procedure TSQLConnector.SetTransaction(Value: TSQLTransaction);
  3279. begin
  3280. inherited SetTransaction(Value);
  3281. If Assigned(FProxy) and (FProxy.Transaction<>Value) then
  3282. FProxy.FTransaction:=Value;
  3283. end;
  3284. procedure TSQLConnector.DoInternalConnect;
  3285. Var
  3286. D : TConnectionDef;
  3287. begin
  3288. inherited DoInternalConnect;
  3289. CheckProxy;
  3290. FProxy.CharSet:=Self.CharSet;
  3291. FProxy.DatabaseName:=Self.DatabaseName;
  3292. FProxy.HostName:=Self.HostName;
  3293. FProxy.LogEvents:=Self.LogEvents;
  3294. FProxy.Password:=Self.Password;
  3295. FProxy.Role:=Self.Role;
  3296. FProxy.UserName:=Self.UserName;
  3297. FProxy.FTransaction:=Self.Transaction;
  3298. FProxy.LogEvents:=Self.LogEvents;
  3299. FProxy.OnLog:=Self.OnLog;
  3300. FProxy.Options:=Self.Options;
  3301. D:=GetConnectionDef(ConnectorType);
  3302. D.ApplyParams(Params,FProxy);
  3303. FProxy.Connected:=True;
  3304. end;
  3305. procedure TSQLConnector.DoInternalDisconnect;
  3306. begin
  3307. FProxy.Connected:=False;
  3308. inherited DoInternalDisconnect;
  3309. end;
  3310. procedure TSQLConnector.CheckProxy;
  3311. begin
  3312. If (FProxy=Nil) then
  3313. CreateProxy;
  3314. end;
  3315. procedure TSQLConnector.CreateProxy;
  3316. Var
  3317. D : TConnectionDef;
  3318. begin
  3319. D:=GetConnectionDef(ConnectorType);
  3320. If (D=Nil) then
  3321. DatabaseErrorFmt(SErrUnknownConnectorType,[ConnectorType],Self);
  3322. FProxy:=D.ConnectionClass.Create(Self);
  3323. FFieldNameQuoteChars := FProxy.FieldNameQuoteChars;
  3324. FConnOptions := FProxy.ConnOptions;
  3325. end;
  3326. procedure TSQLConnector.FreeProxy;
  3327. begin
  3328. FProxy.Connected:=False;
  3329. FreeAndNil(FProxy);
  3330. end;
  3331. function TSQLConnector.StrToStatementType(s: string): TStatementType;
  3332. begin
  3333. CheckProxy;
  3334. Result:=FProxy.StrToStatementType(s);
  3335. end;
  3336. function TSQLConnector.GetAsSQLText(Field: TField): string;
  3337. begin
  3338. CheckProxy;
  3339. Result:=FProxy.GetAsSQLText(Field);
  3340. end;
  3341. function TSQLConnector.GetAsSQLText(Param: TParam): string;
  3342. begin
  3343. CheckProxy;
  3344. Result:=FProxy.GetAsSQLText(Param);
  3345. end;
  3346. function TSQLConnector.GetHandle: pointer;
  3347. begin
  3348. CheckProxy;
  3349. Result:=FProxy.GetHandle;
  3350. end;
  3351. function TSQLConnector.AllocateCursorHandle: TSQLCursor;
  3352. begin
  3353. CheckProxy;
  3354. Result:=FProxy.AllocateCursorHandle;
  3355. end;
  3356. procedure TSQLConnector.DeAllocateCursorHandle(var cursor: TSQLCursor);
  3357. begin
  3358. CheckProxy;
  3359. FProxy.DeAllocateCursorHandle(cursor);
  3360. end;
  3361. function TSQLConnector.AllocateTransactionHandle: TSQLHandle;
  3362. begin
  3363. CheckProxy;
  3364. Result:=FProxy.AllocateTransactionHandle;
  3365. end;
  3366. procedure TSQLConnector.PrepareStatement(cursor: TSQLCursor;
  3367. ATransaction: TSQLTransaction; buf: string; AParams: TParams);
  3368. begin
  3369. CheckProxy;
  3370. FProxy.PrepareStatement(cursor, ATransaction, buf, AParams);
  3371. end;
  3372. procedure TSQLConnector.Execute(cursor: TSQLCursor;
  3373. atransaction: tSQLtransaction; AParams: TParams);
  3374. begin
  3375. CheckProxy;
  3376. FProxy.Execute(cursor, atransaction, AParams);
  3377. end;
  3378. function TSQLConnector.Fetch(cursor: TSQLCursor): boolean;
  3379. begin
  3380. CheckProxy;
  3381. Result:=FProxy.Fetch(cursor);
  3382. end;
  3383. procedure TSQLConnector.AddFieldDefs(cursor: TSQLCursor; FieldDefs: TfieldDefs
  3384. );
  3385. begin
  3386. CheckProxy;
  3387. FProxy.AddFieldDefs(cursor, FieldDefs);
  3388. end;
  3389. procedure TSQLConnector.UnPrepareStatement(cursor: TSQLCursor);
  3390. begin
  3391. CheckProxy;
  3392. FProxy.UnPrepareStatement(cursor);
  3393. end;
  3394. procedure TSQLConnector.FreeFldBuffers(cursor: TSQLCursor);
  3395. begin
  3396. CheckProxy;
  3397. FProxy.FreeFldBuffers(cursor);
  3398. end;
  3399. function TSQLConnector.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
  3400. begin
  3401. Result:=Proxy.GetNextValueSQL(SequenceName, IncrementBy);
  3402. end;
  3403. function TSQLConnector.LoadField(cursor: TSQLCursor; FieldDef: TFieldDef;
  3404. buffer: pointer; out CreateBlob: boolean): boolean;
  3405. begin
  3406. CheckProxy;
  3407. Result:=FProxy.LoadField(cursor, FieldDef, buffer, CreateBlob);
  3408. end;
  3409. procedure TSQLConnector.LoadBlobIntoBuffer(FieldDef: TFieldDef;
  3410. ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
  3411. begin
  3412. CheckProxy;
  3413. FProxy.LoadBlobIntoBuffer(FieldDef, ABlobBuf, cursor, ATransaction);
  3414. end;
  3415. function TSQLConnector.RowsAffected(cursor: TSQLCursor): TRowsCount;
  3416. begin
  3417. CheckProxy;
  3418. Result := FProxy.RowsAffected(cursor);
  3419. end;
  3420. function TSQLConnector.GetTransactionHandle(trans: TSQLHandle): pointer;
  3421. begin
  3422. CheckProxy;
  3423. Result:=FProxy.GetTransactionHandle(trans);
  3424. end;
  3425. function TSQLConnector.Commit(trans: TSQLHandle): boolean;
  3426. begin
  3427. CheckProxy;
  3428. Result:=FProxy.Commit(trans);
  3429. end;
  3430. function TSQLConnector.RollBack(trans: TSQLHandle): boolean;
  3431. begin
  3432. CheckProxy;
  3433. Result:=FProxy.RollBack(trans);
  3434. end;
  3435. function TSQLConnector.StartDBTransaction(trans: TSQLHandle; aParams: string): boolean;
  3436. begin
  3437. CheckProxy;
  3438. Result:=FProxy.StartDBTransaction(trans, aParams);
  3439. end;
  3440. procedure TSQLConnector.CommitRetaining(trans: TSQLHandle);
  3441. begin
  3442. CheckProxy;
  3443. FProxy.CommitRetaining(trans);
  3444. end;
  3445. procedure TSQLConnector.RollBackRetaining(trans: TSQLHandle);
  3446. begin
  3447. CheckProxy;
  3448. FProxy.RollBackRetaining(trans);
  3449. end;
  3450. procedure TSQLConnector.UpdateIndexDefs(IndexDefs: TIndexDefs;
  3451. TableName: string);
  3452. begin
  3453. CheckProxy;
  3454. FProxy.UpdateIndexDefs(IndexDefs, TableName);
  3455. end;
  3456. function TSQLConnector.GetSchemaInfoSQL(SchemaType: TSchemaType;
  3457. SchemaObjectName, SchemaPattern: string): string;
  3458. begin
  3459. CheckProxy;
  3460. Result:=FProxy.GetSchemaInfoSQL(SchemaType, SchemaObjectName, SchemaPattern);
  3461. end;
  3462. { TConnectionDef }
  3463. class function TConnectionDef.TypeName: String;
  3464. begin
  3465. Result:='';
  3466. end;
  3467. class function TConnectionDef.ConnectionClass: TSQLConnectionClass;
  3468. begin
  3469. Result:=Nil;
  3470. end;
  3471. class function TConnectionDef.Description: String;
  3472. begin
  3473. Result:='';
  3474. end;
  3475. class function TConnectionDef.DefaultLibraryName: String;
  3476. begin
  3477. Result:='';
  3478. end;
  3479. class function TConnectionDef.LoadFunction: TLibraryLoadFunction;
  3480. begin
  3481. Result:=Nil;
  3482. end;
  3483. class function TConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
  3484. begin
  3485. Result:=Nil;
  3486. end;
  3487. class function TConnectionDef.LoadedLibraryName: string;
  3488. begin
  3489. Result:='';
  3490. end;
  3491. procedure TConnectionDef.ApplyParams(Params: TStrings;
  3492. AConnection: TSQLConnection);
  3493. begin
  3494. AConnection.Params.Assign(Params);
  3495. end;
  3496. { TServerIndexDefs }
  3497. constructor TServerIndexDefs.create(ADataset: TDataset);
  3498. begin
  3499. if not (ADataset is TCustomSQLQuery) then
  3500. DatabaseErrorFmt(SErrNotASQLQuery,[ADataset.Name]);
  3501. inherited create(ADataset);
  3502. end;
  3503. procedure TServerIndexDefs.Update;
  3504. begin
  3505. if (not updated) and assigned(Dataset) then
  3506. begin
  3507. TCustomSQLQuery(Dataset).UpdateServerIndexDefs;
  3508. updated := True;
  3509. end;
  3510. end;
  3511. Initialization
  3512. Finalization
  3513. DoneDefs;
  3514. end.