sqldb.pp 106 KB

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