sqldb.pp 113 KB

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