sqldb.pp 107 KB

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