mysqlconn.inc 42 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594
  1. {$IFDEF MYSQL80_UP}
  2. {$DEFINE MYSQL57_UP}
  3. {$ENDIF}
  4. {$IFDEF MYSQL57_UP}
  5. {$DEFINE MYSQL56_UP}
  6. {$ENDIF}
  7. {$IFDEF MYSQL56_UP}
  8. {$DEFINE MYSQL55_UP}
  9. {$ENDIF}
  10. {$IFDEF MYSQL55_UP}
  11. {$DEFINE MYSQL51_UP}
  12. {$ENDIF}
  13. {$IFDEF MYSQL51_UP}
  14. {$DEFINE MYSQL50_UP}
  15. {$ENDIF}
  16. {$mode objfpc}{$H+}
  17. interface
  18. uses
  19. Classes, SysUtils,bufdataset,sqldb,db,ctypes,fmtbcd,
  20. {$IFDEF mysql80}
  21. mysql80dyn;
  22. {$ELSE}
  23. {$IFDEF mysql57}
  24. mysql57dyn;
  25. {$ELSE}
  26. {$IFDEF mysql56}
  27. mysql56dyn;
  28. {$ELSE}
  29. {$IFDEF mysql55}
  30. mysql55dyn;
  31. {$ELSE}
  32. {$IFDEF mysql51}
  33. mysql51dyn;
  34. {$ELSE}
  35. {$IfDef mysql50}
  36. mysql50dyn;
  37. {$ELSE}
  38. {$IfDef mysql41}
  39. mysql41dyn;
  40. {$ELSE}
  41. mysql40dyn;
  42. {$EndIf}
  43. {$EndIf}
  44. {$endif}
  45. {$endif}
  46. {$ENDIF}
  47. {$ENDIF}
  48. {$ENDIF}
  49. Const
  50. MySQLVersion =
  51. {$IFDEF mysql80}
  52. '8.0';
  53. {$ELSE}
  54. {$IFDEF mysql57}
  55. '5.7';
  56. {$ELSE}
  57. {$IFDEF mysql56}
  58. '5.6';
  59. {$ELSE}
  60. {$IFDEF mysql55}
  61. '5.5';
  62. {$ELSE}
  63. {$IFDEF mysql51}
  64. '5.1';
  65. {$else}
  66. {$IfDef mysql50}
  67. '5.0';
  68. {$ELSE}
  69. {$IfDef mysql41}
  70. '4.1';
  71. {$ELSE}
  72. '4.0';
  73. {$EndIf}
  74. {$EndIf}
  75. {$endif}
  76. {$endif}
  77. {$ENDIF}
  78. {$ENDIF}
  79. {$ENDIF}
  80. MariaDBVersion =
  81. {$IFDEF mysql57}
  82. '10.';
  83. {$ELSE}
  84. {$IFDEF mysql56} // MariaDB 10.0 is compatible with MySQL 5.6
  85. '10.';
  86. {$ELSE} // MariaDB 5.1..5.5 presumably report the same version number as MySQL
  87. MySQLVersion;
  88. {$ENDIF}
  89. {$ENDIF}
  90. Type
  91. TTransactionName = Class(TSQLHandle)
  92. protected
  93. end;
  94. { TCursorName }
  95. TCursorName = Class(TSQLCursor)
  96. protected
  97. FRes: PMYSQL_RES; { Record pointer }
  98. // Statement with param placeholders $1 $2 etc.
  99. FPreparedStatement : String;
  100. // Statement with param placeholders replaced with actual values.
  101. FActualStatement : String;
  102. FStatement : String;
  103. Row : MYSQL_ROW;
  104. Lengths : pculong; { Lengths of the columns of the current row }
  105. RowsAffected : QWord;
  106. LastInsertID : QWord;
  107. ParamBinding : TParamBinding;
  108. ParamReplaceString : String;
  109. MapDSRowToMSQLRow : array of integer;
  110. end;
  111. { TConnectionName }
  112. TConnectionName = class (TSQLConnection)
  113. private
  114. FSkipLibraryVersionCheck : Boolean;
  115. FHostInfo: String;
  116. FServerInfo: String;
  117. FMySQL : PMySQL;
  118. {$IFDEF MYSQL50_UP}
  119. FConnectionCharsetInfo: MY_CHARSET_INFO;
  120. {$ENDIF}
  121. function GetClientInfo: string;
  122. function GetServerStatus: String;
  123. procedure ConnectMySQL(var HMySQL: PMySQL);
  124. procedure ExecuteDirectMySQL(const query : string);
  125. function InternalStrToBCD(C: pchar; Len: integer): tBCD;
  126. function InternalStrToCurrency(C: pchar; Len: integer): Currency;
  127. function InternalStrToDate(C: pchar; Len: integer): TDateTime;
  128. function InternalStrToDateTime(C: pchar; Len: integer): TDateTime;
  129. function InternalStrToFloat(C: pchar; Len: integer): Extended;
  130. function InternalStrToInt(C: pchar; Len: integer): integer;
  131. function InternalStrToDWord(C: pchar; Len: integer): DWord;
  132. function InternalStrToInt64(C: pchar; Len: integer): Int64;
  133. function InternalStrToTime(C: pchar; Len: integer): TDateTime;
  134. function StrToMSecs(C: pchar; Len: integer): Word;
  135. {$IFDEF MYSQL40}
  136. function InternalStrToTimeStamp(C: pchar; Len: integer): TDateTime;
  137. {$ENDIF}
  138. protected
  139. Procedure ConnectToServer; virtual;
  140. Procedure SelectDatabase; virtual;
  141. function MySQLDataType(AField: PMYSQL_FIELD; var NewType: TFieldType; var NewSize: Integer): Boolean;
  142. function MySQLWriteData(AField: PMYSQL_FIELD; FieldDef: TFieldDef; Source, Dest: PChar; Len: integer; out CreateBlob : boolean): Boolean;
  143. function EscapeString(const Str : string) : string;
  144. // SQLConnection methods
  145. procedure DoInternalConnect; override;
  146. procedure DoInternalDisconnect; override;
  147. function GetHandle : pointer; override;
  148. function GetConnectionCharSet: string; override;
  149. function GetAsSQLText(Param : TParam) : string; overload; override;
  150. Function AllocateCursorHandle : TSQLCursor; override;
  151. Procedure DeAllocateCursorHandle(var cursor : TSQLCursor); override;
  152. Function AllocateTransactionHandle : TSQLHandle; override;
  153. function StrToStatementType(s : string) : TStatementType; override;
  154. procedure PrepareStatement(cursor: TSQLCursor;ATransaction : TSQLTransaction;buf : string; AParams : TParams); override;
  155. procedure UnPrepareStatement(cursor:TSQLCursor); override;
  156. procedure FreeFldBuffers(cursor : TSQLCursor); override;
  157. procedure Execute(cursor: TSQLCursor;atransaction:tSQLtransaction;AParams : TParams); override;
  158. procedure AddFieldDefs(cursor: TSQLCursor; FieldDefs : TfieldDefs); override;
  159. function Fetch(cursor : TSQLCursor) : boolean; override;
  160. function LoadField(cursor : TSQLCursor;FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean; override;
  161. procedure LoadBlobIntoBuffer(FieldDef: TFieldDef;ABlobBuf: PBufBlobField; cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
  162. function GetTransactionHandle(trans : TSQLHandle): pointer; override;
  163. function Commit(trans : TSQLHandle) : boolean; override;
  164. function RollBack(trans : TSQLHandle) : boolean; override;
  165. function StartdbTransaction(trans : TSQLHandle; AParams : string) : boolean; override;
  166. procedure CommitRetaining(trans : TSQLHandle); override;
  167. procedure RollBackRetaining(trans : TSQLHandle); override;
  168. function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
  169. procedure UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string); override;
  170. function RowsAffected(cursor: TSQLCursor): TRowsCount; override;
  171. function RefreshLastInsertID(Query : TCustomSQLQuery; Field : TField): Boolean; override;
  172. Public
  173. constructor Create(AOwner : TComponent); override;
  174. {$IFNDEF MYSQL50_UP}
  175. procedure GetFieldNames(const TableName : string; List : TStrings); override;
  176. procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); override;
  177. {$ENDIF}
  178. function GetConnectionInfo(InfoType:TConnInfoType): string; override;
  179. Function GetInsertID: int64;
  180. procedure CreateDB; override;
  181. procedure DropDB; override;
  182. Property ServerInfo : String Read FServerInfo;
  183. Property HostInfo : String Read FHostInfo;
  184. property ClientInfo: string read GetClientInfo;
  185. property ServerStatus : String read GetServerStatus;
  186. published
  187. Property SkipLibraryVersionCheck : Boolean Read FSkipLibraryVersionCheck Write FSkipLibraryVersionCheck;
  188. property DatabaseName;
  189. property HostName;
  190. property KeepConnection;
  191. property LoginPrompt;
  192. property Params;
  193. property Port stored false;
  194. property OnLogin;
  195. end;
  196. { TMySQLConnectionDef }
  197. TMySQLConnectionDef = Class(TConnectionDef)
  198. Class Function TypeName : String; override;
  199. Class Function ConnectionClass : TSQLConnectionClass; override;
  200. Class Function Description : String; override;
  201. Class Function DefaultLibraryName : String; override;
  202. Class Function LoadFunction : TLibraryLoadFunction; override;
  203. Class Function UnLoadFunction : TLibraryUnLoadFunction; override;
  204. Class Function LoadedLibraryName : string; override;
  205. end;
  206. {$IFDEF mysql80}
  207. TMySQL80Connection = Class(TConnectionName);
  208. TMySQL80ConnectionDef = Class(TMySQLConnectionDef);
  209. TMySQL80Transaction = Class(TTransactionName);
  210. TMySQL80Cursor = Class(TCursorName);
  211. {$ELSE}
  212. {$IFDEF mysql57}
  213. TMySQL57Connection = Class(TConnectionName);
  214. TMySQL57ConnectionDef = Class(TMySQLConnectionDef);
  215. TMySQL57Transaction = Class(TTransactionName);
  216. TMySQL57Cursor = Class(TCursorName);
  217. {$ELSE}
  218. {$IFDEF mysql56}
  219. TMySQL56Connection = Class(TConnectionName);
  220. TMySQL56ConnectionDef = Class(TMySQLConnectionDef);
  221. TMySQL56Transaction = Class(TTransactionName);
  222. TMySQL56Cursor = Class(TCursorName);
  223. {$ELSE}
  224. {$ifdef mysql55}
  225. TMySQL55Connection = Class(TConnectionName);
  226. TMySQL55ConnectionDef = Class(TMySQLConnectionDef);
  227. TMySQL55Transaction = Class(TTransactionName);
  228. TMySQL55Cursor = Class(TCursorName);
  229. {$else}
  230. {$IfDef mysql51}
  231. TMySQL51Connection = Class(TConnectionName);
  232. TMySQL51ConnectionDef = Class(TMySQLConnectionDef);
  233. TMySQL51Transaction = Class(TTransactionName);
  234. TMySQL51Cursor = Class(TCursorName);
  235. {$ELSE}
  236. {$IfDef mysql50}
  237. TMySQL50Connection = Class(TConnectionName);
  238. TMySQL50ConnectionDef = Class(TMySQLConnectionDef);
  239. TMySQL50Transaction = Class(TTransactionName);
  240. TMySQL50Cursor = Class(TCursorName);
  241. {$ELSE}
  242. {$IfDef mysql41}
  243. TMySQL41Connection = Class(TConnectionName);
  244. TMySQL41ConnectionDef = Class(TMySQLConnectionDef);
  245. TMySQL41Transaction = Class(TTransactionName);
  246. TMySQL41Cursor = Class(TCursorName);
  247. {$ELSE}
  248. TMySQL40Connection = Class(TConnectionName);
  249. TMySQL40ConnectionDef = Class(TMySQLConnectionDef);
  250. TMySQL40Transaction = Class(TTransactionName);
  251. TMySQL40Cursor = Class(TCursorName);
  252. {$EndIf}
  253. {$endif}
  254. {$EndIf}
  255. {$ENDIF}
  256. {$ENDIF}
  257. {$ENDIF}
  258. {$ENDIF}
  259. implementation
  260. uses
  261. dbconst,
  262. StrUtils,
  263. DateUtils;
  264. const
  265. Mysql_Option_Names : array[mysql_option] of string = (
  266. 'MYSQL_OPT_CONNECT_TIMEOUT',
  267. 'MYSQL_OPT_COMPRESS',
  268. 'MYSQL_OPT_NAMED_PIPE',
  269. 'MYSQL_INIT_COMMAND',
  270. 'MYSQL_READ_DEFAULT_FILE',
  271. 'MYSQL_READ_DEFAULT_GROUP',
  272. 'MYSQL_SET_CHARSET_DIR',
  273. 'MYSQL_SET_CHARSET_NAME',
  274. 'MYSQL_OPT_LOCAL_INFILE',
  275. 'MYSQL_OPT_PROTOCOL',
  276. 'MYSQL_SHARED_MEMORY_BASE_NAME',
  277. 'MYSQL_OPT_READ_TIMEOUT',
  278. 'MYSQL_OPT_WRITE_TIMEOUT',
  279. 'MYSQL_OPT_USE_RESULT'
  280. {$IFDEF MYSQL80}
  281. ,'MYSQL_REPORT_DATA_TRUNCATION',
  282. 'MYSQL_OPT_RECONNECT',
  283. 'MYSQL_PLUGIN_DIR',
  284. 'MYSQL_DEFAULT_AUTH',
  285. 'MYSQL_OPT_BIND',
  286. 'MYSQL_OPT_SSL_KEY',
  287. 'MYSQL_OPT_SSL_CERT',
  288. 'MYSQL_OPT_SSL_CA',
  289. 'MYSQL_OPT_SSL_CAPATH',
  290. 'MYSQL_OPT_SSL_CIPHER',
  291. 'MYSQL_OPT_SSL_CRL',
  292. 'MYSQL_OPT_SSL_CRLPATH',
  293. 'MYSQL_OPT_CONNECT_ATTR_RESET',
  294. 'MYSQL_OPT_CONNECT_ATTR_ADD',
  295. 'MYSQL_OPT_CONNECT_ATTR_DELETE',
  296. 'MYSQL_SERVER_PUBLIC_KEY',
  297. 'MYSQL_ENABLE_CLEARTEXT_PLUGIN',
  298. 'MYSQL_OPT_CAN_HANDLE_EXPIRED_PASSWORDS',
  299. 'MYSQL_OPT_MAX_ALLOWED_PACKET',
  300. 'MYSQL_OPT_NET_BUFFER_LENGTH',
  301. 'MYSQL_OPT_TLS_VERSION',
  302. 'MYSQL_OPT_SSL_MODE',
  303. 'MYSQL_OPT_GET_SERVER_PUBLIC_KEY',
  304. 'MYSQL_OPT_RETRY_COUNT',
  305. 'MYSQL_OPT_OPTIONAL_RESULTSET_METADATA',
  306. 'MYSQL_OPT_SSL_FIPS_MODE',
  307. 'MYSQL_OPT_TLS_CIPHERSUITES',
  308. 'MYSQL_OPT_COMPRESSION_ALGORITHMS',
  309. 'MYSQL_OPT_ZSTD_COMPRESSION_LEVEL',
  310. 'MYSQL_OPT_LOAD_DATA_LOCAL_DIR'
  311. {$ELSE}
  312. ,'MYSQL_OPT_USE_REMOTE_CONNECTION',
  313. 'MYSQL_OPT_USE_EMBEDDED_CONNECTION',
  314. 'MYSQL_OPT_GUESS_CONNECTION',
  315. 'MYSQL_SET_CLIENT_IP',
  316. 'MYSQL_SECURE_AUTH'
  317. {$IFDEF MYSQL50_UP}
  318. ,'MYSQL_REPORT_DATA_TRUNCATION', 'MYSQL_OPT_RECONNECT'
  319. {$IFDEF mysql51_UP}
  320. ,'MYSQL_OPT_SSL_VERIFY_SERVER_CERT'
  321. {$IFDEF mysql55_UP}
  322. ,'MYSQL_PLUGIN_DIR', 'MYSQL_DEFAULT_AUTH'
  323. {$IFDEF MYSQL56_UP}
  324. ,'MYSQL_OPT_BIND'
  325. ,'MYSQL_OPT_SSL_KEY', 'MYSQL_OPT_SSL_CERT', 'MYSQL_OPT_SSL_CA', 'MYSQL_OPT_SSL_CAPATH', 'MYSQL_OPT_SSL_CIPHER', 'MYSQL_OPT_SSL_CRL', 'MYSQL_OPT_SSL_CRLPATH'
  326. ,'MYSQL_OPT_CONNECT_ATTR_RESET', 'MYSQL_OPT_CONNECT_ATTR_ADD', 'MYSQL_OPT_CONNECT_ATTR_DELETE'
  327. ,'MYSQL_SERVER_PUBLIC_KEY'
  328. ,'MYSQL_ENABLE_CLEARTEXT_PLUGIN'
  329. ,'MYSQL_OPT_CAN_HANDLE_EXPIRED_PASSWORDS'
  330. {$IFDEF MYSQL57_UP}
  331. ,'MYSQL_OPT_SSL_ENFORCE'
  332. {$ENDIF}
  333. {$ENDIF}
  334. {$ENDIF}
  335. {$ENDIF}
  336. {$ENDIF}
  337. {$ENDIF}
  338. );
  339. Resourcestring
  340. SErrServerConnectFailed = 'Server connect failed.';
  341. SErrSetCharsetFailed = 'Failed to set connection character set: %s';
  342. SErrDatabaseSelectFailed = 'Failed to select database: %s';
  343. //SErrDatabaseCreate = 'Failed to create database: %s';
  344. //SErrDatabaseDrop = 'Failed to drop database: %s';
  345. //SErrNoData = 'No data for record';
  346. SErrExecuting = 'Error executing query: %s';
  347. SErrFetchingdata = 'Error fetching row data: %s';
  348. SErrGettingResult = 'Error getting result set: %s';
  349. SErrNoQueryResult = 'No result from query.';
  350. SErrVersionMismatch = '%s can not work with the installed MySQL client version: Expected (%s), got (%s).';
  351. SErrSettingParameter = 'Error setting parameter "%s"';
  352. Procedure MySQLError(R : PMySQL; Msg: String; Comp : TComponent);
  353. Var
  354. MySQLError, MySQLState : String;
  355. MySQLErrno: integer;
  356. begin
  357. If (R<>Nil) then
  358. begin
  359. MySQLError:=StrPas(mysql_error(R));
  360. MySQLErrno:=mysql_errno(R);
  361. MySQLState:=StrPas(mysql_sqlstate(R));
  362. end
  363. else
  364. begin
  365. MySQLError:='';
  366. MySQLErrno:=0;
  367. MySQLState:='';
  368. end;
  369. raise ESQLDatabaseError.CreateFmt(Msg, [MySQLError], Comp, MySQLErrno, MySQLState);
  370. end;
  371. function MysqlOption(const OptionName: string; out AMysql_Option: mysql_option) : boolean;
  372. var AMysql_Option_i: mysql_option;
  373. begin
  374. result := false;
  375. for AMysql_Option_i:=low(AMysql_Option) to high(AMysql_Option) do
  376. if sametext(Mysql_Option_Names[AMysql_Option_i],OptionName) then
  377. begin
  378. result := true;
  379. AMysql_Option:=AMysql_Option_i;
  380. break;
  381. end;
  382. end;
  383. { TConnectionName }
  384. function TConnectionName.StrToStatementType(s : string) : TStatementType;
  385. begin
  386. s:=Lowercase(s);
  387. if (s='analyze') or (s='check') or (s='checksum') or (s='optimize') or (s='repair') or (s='show') then
  388. exit(stSelect)
  389. else if s='call' then
  390. exit(stExecProcedure)
  391. else
  392. Result := inherited StrToStatementType(s);
  393. end;
  394. function TConnectionName.GetClientInfo: string;
  395. begin
  396. // To make it possible to call this if there's no connection yet
  397. InitialiseMysql;
  398. Try
  399. Result:=strpas(mysql_get_client_info());
  400. Finally
  401. ReleaseMysql;
  402. end;
  403. end;
  404. function TConnectionName.GetServerStatus: String;
  405. begin
  406. CheckConnected;
  407. Result := mysql_stat(FMYSQL);
  408. end;
  409. Function TConnectionName.GetInsertID: int64;
  410. begin
  411. CheckConnected;
  412. Result:=mysql_insert_id(GetHandle);
  413. end;
  414. procedure TConnectionName.ConnectMySQL(var HMySQL: PMySQL);
  415. Var
  416. APort : Cardinal;
  417. i,e: integer;
  418. AMysql_Option: mysql_option;
  419. OptStr: string;
  420. OptInt: cuint;
  421. Opt: pointer;
  422. begin
  423. HMySQL := mysql_init(HMySQL);
  424. APort:=Abs(StrToIntDef(Params.Values['Port'],0));
  425. for i := 0 to Params.Count-1 do
  426. begin
  427. if MysqlOption(Params.Names[i],AMysql_Option) then
  428. begin
  429. OptStr:=Params.ValueFromIndex[i];
  430. val(OptStr,OptInt,e);
  431. if e=0 then
  432. Opt := @OptInt
  433. else
  434. Opt := pchar(OptStr);
  435. if mysql_options(HMySQL,AMysql_Option,Opt) <> 0 then
  436. MySQLError(HMySQL,Format(SErrSettingParameter,[Params.Names[i]]),Self);
  437. end;
  438. end;
  439. if mysql_real_connect(HMySQL,PChar(HostName),PChar(UserName),PChar(Password),Nil,APort,Nil,CLIENT_MULTI_RESULTS) = nil then //CLIENT_MULTI_RESULTS is required by CALL SQL statement(executes stored procedure), that produces result sets
  440. MySQLError(HMySQL,SErrServerConnectFailed,Self);
  441. if (trim(CharSet) <> '') then
  442. // major_version*10000 + minor_version *100 + sub_version
  443. if (50007 <= mysql_get_server_version(HMySQL)) then
  444. begin
  445. // Only available for MySQL 5.0.7 and later...
  446. if mysql_set_character_set(HMySQL, PChar(CharSet)) <> 0 then
  447. MySQLError(HMySQL,SErrSetCharsetFailed,Self);
  448. end
  449. else
  450. if mysql_query(HMySQL,PChar('SET NAMES ''' + EscapeString(CharSet) +'''')) <> 0 then
  451. MySQLError(HMySQL,SErrExecuting,Self);
  452. end;
  453. function TConnectionName.GetAsSQLText(Param: TParam) : string;
  454. begin
  455. if (not assigned(Param)) or Param.IsNull then
  456. Result := 'Null'
  457. else if Param.DataType in [ftString,ftFixedChar,ftMemo] then
  458. Result := '''' + EscapeString(GetAsString(Param)) + ''''
  459. else if Param.DataType in [ftBlob,ftBytes,ftVarBytes] then
  460. Result := '''' + EscapeString(Param.AsString) + ''''
  461. else
  462. Result := inherited GetAsSQLText(Param);
  463. end;
  464. Procedure TConnectionName.ConnectToServer;
  465. begin
  466. ConnectMySQL(FMySQL);
  467. FServerInfo := strpas(mysql_get_server_info(FMYSQL));
  468. FHostInfo := strpas(mysql_get_host_info(FMYSQL));
  469. {$IFDEF MYSQL50_UP}
  470. mysql_get_character_set_info(FMYSQL, @FConnectionCharsetInfo);
  471. {$ENDIF}
  472. end;
  473. Procedure TConnectionName.SelectDatabase;
  474. begin
  475. if mysql_select_db(FMySQL,pchar(DatabaseName))<>0 then
  476. MySQLError(FMySQL,SErrDatabaseSelectFailed,Self);
  477. end;
  478. procedure TConnectionName.CreateDB;
  479. begin
  480. ExecuteDirectMySQL('CREATE DATABASE ' +DatabaseName);
  481. end;
  482. procedure TConnectionName.DropDB;
  483. begin
  484. ExecuteDirectMySQL('DROP DATABASE ' +DatabaseName);
  485. end;
  486. procedure TConnectionName.ExecuteDirectMySQL(const query : string);
  487. var AMySQL : PMySQL;
  488. begin
  489. CheckDisConnected;
  490. InitialiseMysql;
  491. try
  492. AMySQL := nil;
  493. ConnectMySQL(AMySQL);
  494. try
  495. if mysql_query(AMySQL,pchar(query))<>0 then
  496. MySQLError(AMySQL,SErrExecuting,Self);
  497. finally
  498. mysql_close(AMySQL);
  499. end;
  500. finally
  501. ReleaseMysql;
  502. end;
  503. end;
  504. function TConnectionName.EscapeString(const Str: string): string;
  505. var Len : integer;
  506. begin
  507. SetLength(result,length(str)*2+1);
  508. Len := mysql_real_escape_string(FMySQL,pchar(Result),pchar(Str),length(Str));
  509. SetLength(result,Len);
  510. end;
  511. procedure TConnectionName.DoInternalConnect;
  512. var
  513. FullVersion: string;
  514. begin
  515. InitialiseMysql;
  516. if not SkipLibraryVersionCheck then
  517. begin
  518. FullVersion:=strpas(mysql_get_client_info());
  519. // Version string should start with version number:
  520. // Note: in case of MariaDB version mismatch: tough luck, we report MySQL
  521. // version only.
  522. if (pos(MySQLVersion, FullVersion) <> 1) and
  523. (pos(MariaDBVersion, FullVersion) <> 1) then
  524. Raise EInOutError.CreateFmt(SErrVersionMisMatch,[ClassName,MySQLVersion,FullVersion]);
  525. end;
  526. inherited DoInternalConnect;
  527. ConnectToServer;
  528. SelectDatabase;
  529. end;
  530. procedure TConnectionName.DoInternalDisconnect;
  531. begin
  532. inherited DoInternalDisconnect;
  533. mysql_close(FMySQL);
  534. FMySQL:=Nil;
  535. ReleaseMysql;
  536. end;
  537. function TConnectionName.GetHandle: pointer;
  538. begin
  539. Result:=FMySQL;
  540. end;
  541. function TConnectionName.GetConnectionCharSet: string;
  542. begin
  543. Result:=StrPas(mysql_character_set_name(FMySQL));
  544. end;
  545. Function TConnectionName.AllocateCursorHandle: TSQLCursor;
  546. begin
  547. {$IFDEF mysql80}
  548. Result:=TMySQL80Cursor.Create;
  549. {$ELSE}
  550. {$IFDEF mysql57}
  551. Result:=TMySQL57Cursor.Create;
  552. {$ELSE}
  553. {$IFDEF mysql56}
  554. Result:=TMySQL56Cursor.Create;
  555. {$ELSE}
  556. {$IfDef mysql55}
  557. Result:=TMySQL55Cursor.Create;
  558. {$ELSE}
  559. {$IfDef mysql51}
  560. Result:=TMySQL51Cursor.Create;
  561. {$ELSE}
  562. {$IfDef mysql50}
  563. Result:=TMySQL50Cursor.Create;
  564. {$ELSE}
  565. {$IfDef mysql41}
  566. Result:=TMySQL41Cursor.Create;
  567. {$ELSE}
  568. Result:=TMySQL40Cursor.Create;
  569. {$EndIf}
  570. {$EndIf}
  571. {$EndIf}
  572. {$EndIf}
  573. {$ENDIF}
  574. {$ENDIF}
  575. {$ENDIF}
  576. end;
  577. Procedure TConnectionName.DeAllocateCursorHandle(var cursor : TSQLCursor);
  578. begin
  579. FreeAndNil(cursor);
  580. end;
  581. Function TConnectionName.AllocateTransactionHandle: TSQLHandle;
  582. begin
  583. // Result:=TTransactionName.Create;
  584. Result := nil;
  585. end;
  586. procedure TConnectionName.PrepareStatement(cursor: TSQLCursor;
  587. ATransaction: TSQLTransaction; buf: string;AParams : TParams);
  588. begin
  589. // if assigned(AParams) and (AParams.count > 0) then
  590. // DatabaseError('Parameters (not) yet supported for the MySQL SqlDB connection.',self);
  591. With Cursor as TCursorName do
  592. begin
  593. FPreparedStatement:=Buf;
  594. if assigned(AParams) and (AParams.count > 0) then
  595. FPreparedStatement := AParams.ParseSQL(FPreparedStatement,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psSimulated,paramBinding,ParamReplaceString);
  596. FPrepared:=True;
  597. end;
  598. end;
  599. procedure TConnectionName.UnPrepareStatement(cursor: TSQLCursor);
  600. Var
  601. C : TCursorName;
  602. begin
  603. C:=Cursor as TCursorName;
  604. if assigned(C.FRes) then //ExecSQL with dataset returned
  605. begin
  606. mysql_free_result(C.FRes);
  607. C.FRes:=nil;
  608. end;
  609. end;
  610. procedure TConnectionName.FreeFldBuffers(cursor: TSQLCursor);
  611. Var
  612. C : TCursorName;
  613. begin
  614. C:=Cursor as TCursorName;
  615. if assigned(C.FRes) then
  616. begin
  617. mysql_free_result(C.FRes);
  618. C.FRes:=Nil;
  619. end;
  620. C.FInitFieldDef:=True;
  621. SetLength(c.MapDSRowToMSQLRow,0);
  622. inherited;
  623. end;
  624. procedure TConnectionName.Execute(cursor: TSQLCursor;
  625. atransaction: tSQLtransaction;AParams : TParams);
  626. Var
  627. C : TCursorName;
  628. i : integer;
  629. ParamNames,ParamValues : array of string;
  630. Res: PMYSQL_RES;
  631. Status : Integer;
  632. begin
  633. C:=Cursor as TCursorName;
  634. If (C.FRes=Nil) then
  635. begin
  636. if Assigned(AParams) and (AParams.count > 0) then
  637. begin
  638. setlength(ParamNames,AParams.Count);
  639. setlength(ParamValues,AParams.Count);
  640. for i := 0 to AParams.count -1 do
  641. begin
  642. ParamNames[AParams.count-i-1] := C.ParamReplaceString+inttostr(AParams[i].Index+1);
  643. ParamValues[AParams.count-i-1] := GetAsSQLText(AParams[i]);
  644. end;
  645. C.FActualStatement := stringsreplace(C.FPreparedStatement,ParamNames,ParamValues,[rfReplaceAll]);
  646. end
  647. else
  648. C.FActualStatement:=C.FPreparedStatement;
  649. if LogEvent(detParamValue) then
  650. LogParams(AParams);
  651. if LogEvent(detExecute) then
  652. Log(detExecute, C.FPreparedStatement);
  653. if LogEvent(detActualSQL) then
  654. Log(detActualSQL,C.FActualStatement);
  655. if mysql_query(FMySQL,Pchar(C.FActualStatement))<>0 then
  656. begin
  657. if not ForcedClose then
  658. MySQLError(FMYSQL,SErrExecuting,Self)
  659. else //don't return a resulset. We are shutting down, not opening.
  660. begin
  661. C.RowsAffected:=0;
  662. C.FSelectable:= False;
  663. C.FRes:=nil;
  664. end;
  665. end
  666. else
  667. begin
  668. C.RowsAffected := mysql_affected_rows(FMYSQL);
  669. C.LastInsertID := mysql_insert_id(FMYSQL);
  670. C.FSelectable := False;
  671. repeat
  672. Res:=mysql_store_result(FMySQL); //returns a null pointer also if the statement didn't return a result set
  673. if mysql_errno(FMySQL)<>0 then
  674. begin
  675. if not ForcedClose then
  676. MySQLError(FMySQL, SErrGettingResult, Self)
  677. else
  678. begin
  679. C.RowsAffected:=0;
  680. C.FSelectable:= False;
  681. C.FRes:=nil;
  682. break;
  683. end;
  684. end;
  685. if Res<>nil then
  686. begin
  687. mysql_free_result(C.FRes);
  688. C.FRes:=Res;
  689. C.FSelectable:=True;
  690. end;
  691. Status:=mysql_next_result(FMySQL);
  692. if (Status>0) then
  693. begin
  694. if not ForcedClose then
  695. MySQLError(FMySQL, SErrGettingResult, Self)
  696. else
  697. begin
  698. C.RowsAffected:=0;
  699. C.FSelectable:= False;
  700. C.FRes:=nil;
  701. break;
  702. end;
  703. end;
  704. until (Status<>0);
  705. end;
  706. end;
  707. end;
  708. function TConnectionName.MySQLDataType(AField: PMYSQL_FIELD; var NewType: TFieldType; var NewSize: Integer): Boolean;
  709. var
  710. ASize: culong;
  711. ADecimals: cuint;
  712. begin
  713. Result := True;
  714. ASize := AField^.length;
  715. NewSize := 0;
  716. case AField^.ftype of
  717. FIELD_TYPE_LONGLONG:
  718. begin
  719. NewType := ftLargeint;
  720. end;
  721. FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_YEAR:
  722. begin
  723. if AField^.flags and UNSIGNED_FLAG <> 0 then
  724. NewType := ftWord
  725. else
  726. NewType := ftSmallint;
  727. end;
  728. FIELD_TYPE_LONG, FIELD_TYPE_INT24:
  729. begin
  730. if AField^.flags and AUTO_INCREMENT_FLAG <> 0 then
  731. NewType := ftAutoInc
  732. else
  733. NewType := ftInteger;
  734. end;
  735. {$ifdef mysql50_up}
  736. FIELD_TYPE_NEWDECIMAL,
  737. {$endif}
  738. FIELD_TYPE_DECIMAL:
  739. begin
  740. ADecimals:=AField^.decimals;
  741. if (ADecimals < 5) and (ASize-2-ADecimals < 15) then //ASize is display size i.e. with sign and decimal point
  742. NewType := ftBCD
  743. else if (ADecimals = 0) and (ASize < 20) then
  744. NewType := ftLargeInt
  745. else
  746. NewType := ftFmtBCD;
  747. NewSize := ADecimals;
  748. end;
  749. FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
  750. begin
  751. NewType := ftFloat;
  752. end;
  753. FIELD_TYPE_TIMESTAMP, FIELD_TYPE_DATETIME:
  754. begin
  755. NewType := ftDateTime;
  756. end;
  757. FIELD_TYPE_DATE:
  758. begin
  759. NewType := ftDate;
  760. end;
  761. FIELD_TYPE_TIME:
  762. begin
  763. NewType := ftTime;
  764. end;
  765. FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
  766. begin
  767. // Since mysql server version 5.0.3 string-fields with a length of more
  768. // then 256 characters are suported
  769. if AField^.ftype = FIELD_TYPE_STRING then
  770. NewType := ftFixedChar
  771. else
  772. NewType := ftString;
  773. {$IFDEF MYSQL50_UP}
  774. if AField^.charsetnr = 63 then begin //BINARY vs. CHAR, VARBINARY vs. VARCHAR
  775. if NewType = ftFixedChar then
  776. NewType := ftBytes
  777. else
  778. NewType := ftVarBytes;
  779. NewSize := ASize;
  780. end
  781. else
  782. NewSize := ASize div FConnectionCharsetInfo.mbmaxlen;
  783. {$ELSE}
  784. NewSize := ASize;
  785. {$ENDIF}
  786. end;
  787. FIELD_TYPE_TINY_BLOB..FIELD_TYPE_BLOB:
  788. begin
  789. {$IFDEF MYSQL50_UP}
  790. if AField^.charsetnr = 63 then //character set is binary
  791. NewType := ftBlob
  792. else
  793. NewType := ftMemo;
  794. {$ELSE}
  795. NewType := ftBlob;
  796. {$ENDIF}
  797. end;
  798. {$IFDEF MYSQL50_UP}
  799. FIELD_TYPE_BIT:
  800. NewType := ftLargeInt;
  801. {$ENDIF}
  802. else
  803. Result := False;
  804. end;
  805. end;
  806. procedure TConnectionName.AddFieldDefs(cursor: TSQLCursor;
  807. FieldDefs: TfieldDefs);
  808. var
  809. C : TCursorName;
  810. I, FC: Integer;
  811. field: PMYSQL_FIELD;
  812. DFT: TFieldType;
  813. DFS: Integer;
  814. begin
  815. // Writeln('MySQL: Adding fielddefs');
  816. C:=(Cursor as TCursorName);
  817. If (C.FRes=Nil) then
  818. begin
  819. // Writeln('res is nil');
  820. MySQLError(FMySQL,SErrNoQueryResult,Self);
  821. end;
  822. // Writeln('MySQL: have result');
  823. FC:=mysql_num_fields(C.FRes);
  824. SetLength(c.MapDSRowToMSQLRow,FC);
  825. For I := 0 to FC-1 do
  826. begin
  827. field := mysql_fetch_field_direct(C.FRES, I);
  828. // Writeln('MySQL: creating fielddef ',I+1);
  829. if MySQLDataType(field, DFT, DFS) then
  830. begin
  831. AddFieldDef(FieldDefs, I+1, field^.name, DFT, DFS, -1,
  832. False,
  833. (field^.flags and (AUTO_INCREMENT_FLAG or NOT_NULL_FLAG {$IFDEF MYSQL50_UP}or NO_DEFAULT_VALUE_FLAG{$ENDIF})) = (NOT_NULL_FLAG {$IFDEF MYSQL50_UP}or NO_DEFAULT_VALUE_FLAG{$ENDIF}),
  834. False);
  835. c.MapDSRowToMSQLRow[I] := I;
  836. end
  837. end;
  838. // Writeln('MySQL: Finished adding fielddefs');
  839. end;
  840. function TConnectionName.Fetch(cursor: TSQLCursor): boolean;
  841. Var
  842. C : TCursorName;
  843. begin
  844. C:=Cursor as TCursorName;
  845. C.Row:=MySQL_Fetch_row(C.FRes);
  846. Result:=(C.Row<>Nil);
  847. if Result then
  848. C.Lengths := mysql_fetch_lengths(C.FRes)
  849. else
  850. C.Lengths := nil;
  851. end;
  852. function TConnectionName.LoadField(cursor : TSQLCursor;
  853. FieldDef : TfieldDef;buffer : pointer; out CreateBlob : boolean) : boolean;
  854. var
  855. field: PMYSQL_FIELD;
  856. C : TCursorName;
  857. i : integer;
  858. begin
  859. // Writeln('LoadFieldsFromBuffer');
  860. C:=Cursor as TCursorName;
  861. if (C.Row=nil) or (C.Lengths=nil) then
  862. begin
  863. // Writeln('LoadFieldsFromBuffer: row=nil');
  864. MySQLError(FMySQL,SErrFetchingData,Self);
  865. end;
  866. i := c.MapDSRowToMSQLRow[FieldDef.FieldNo-1];
  867. field := mysql_fetch_field_direct(C.FRES, i);
  868. Result := MySQLWriteData(field, FieldDef, C.Row[i], Buffer, C.Lengths[i], CreateBlob);
  869. end;
  870. procedure TConnectionName.LoadBlobIntoBuffer(FieldDef: TFieldDef;
  871. ABlobBuf: PBufBlobField; cursor: TSQLCursor; ATransaction: TSQLTransaction);
  872. var
  873. C : TCursorName;
  874. i : integer;
  875. len : longint;
  876. begin
  877. C:=Cursor as TCursorName;
  878. if (C.Row=nil) or (C.Lengths=nil) then
  879. MySQLError(FMySQL,SErrFetchingData,Self);
  880. i := c.MapDSRowToMSQLRow[FieldDef.FieldNo-1];
  881. len := C.Lengths[i];
  882. ReAllocMem(ABlobBuf^.BlobBuffer^.Buffer, len);
  883. Move(C.Row[i]^, ABlobBuf^.BlobBuffer^.Buffer^, len);
  884. ABlobBuf^.BlobBuffer^.Size := len;
  885. end;
  886. function TConnectionName.InternalStrToInt(C: pchar; Len: integer): integer;
  887. Var
  888. S : String;
  889. begin
  890. Result := 0;
  891. if (Len=0) or (C=Nil) then
  892. exit;
  893. SetString(S,C,Len);
  894. Result:=StrToInt(S);
  895. end;
  896. function TConnectionName.InternalStrToDWord(C: pchar; Len: integer): DWord;
  897. Var
  898. S : String;
  899. begin
  900. Result := 0;
  901. if (Len=0) or (C=Nil) then
  902. exit;
  903. SetString(S,C,Len);
  904. Result:=StrToDWord(S);
  905. end;
  906. function TConnectionName.InternalStrToInt64(C: pchar; Len: integer): Int64;
  907. Var
  908. S : String;
  909. begin
  910. Result := 0;
  911. if (Len=0) or (C=Nil) then
  912. exit;
  913. SetString(S,C,Len);
  914. Result:=StrToInt64(S);
  915. end;
  916. function TConnectionName.InternalStrToFloat(C: pchar; Len: integer): Extended;
  917. var
  918. Tmp: string;
  919. begin
  920. SetString(Tmp, C, Len);
  921. if Tmp='' then
  922. Exit(0);
  923. Result := StrToFloat(Tmp, FSQLFormatSettings);
  924. end;
  925. function TConnectionName.InternalStrToCurrency(C: pchar; Len: integer): Currency;
  926. var
  927. Tmp: string;
  928. begin
  929. SetString(Tmp, C, Len);
  930. if Tmp='' then
  931. Exit(0);
  932. Result := StrToCurr(Tmp, FSQLFormatSettings);
  933. end;
  934. function TConnectionName.InternalStrToBCD(C: pchar; Len: integer): tBCD;
  935. var
  936. Tmp: string;
  937. begin
  938. SetString(Tmp, C, Len);
  939. if Tmp='' then
  940. Exit(0);
  941. Result := StrToBCD(Tmp, FSQLFormatSettings);
  942. end;
  943. function TConnectionName.InternalStrToDate(C: pchar; Len: integer): TDateTime;
  944. var
  945. EY, EM, ED: Word;
  946. begin
  947. if Len=0 then
  948. Exit(0);
  949. if Len<10 then
  950. raise EConvertError.Create('Invalid date string');
  951. EY := InternalStrToInt(C,4);
  952. EM := InternalStrToInt(C+5,2);
  953. ED := InternalStrToInt(C+8,2);
  954. if (EY = 0) or (EM = 0) or (ED = 0) then
  955. Result:=0
  956. else
  957. Result:=EncodeDate(EY, EM, ED);
  958. end;
  959. function TConnectionName.StrToMSecs(C: pchar; Len: integer): Word;
  960. {$IFDEF MYSQL56_UP}
  961. var I: Integer;
  962. d, MSecs: double;
  963. {$ENDIF}
  964. begin
  965. {$IFDEF MYSQL56_UP}
  966. // datetime(n), where n is fractional seconds precision (between 0 and 6)
  967. MSecs := 0;
  968. d := 100;
  969. for I := 1 to Len do
  970. begin
  971. case C^ of
  972. '0'..'9': MSecs := MSecs + (ord(C^)-ord('0'))*d;
  973. #0: break;
  974. end;
  975. d := d / 10;
  976. Inc(C);
  977. end;
  978. Result := Round(MSecs);
  979. {$ELSE}
  980. Result := 0;
  981. {$ENDIF}
  982. end;
  983. function TConnectionName.InternalStrToDateTime(C: pchar; Len: integer): TDateTime;
  984. var
  985. EY, EM, ED: Word;
  986. EH, EN, ES, EMS: Word;
  987. begin
  988. if Len=0 then
  989. Exit(0);
  990. if Len<19 then
  991. raise EConvertError.Create('Invalid datetime string');
  992. EY := InternalStrToInt(C,4);
  993. EM := InternalStrToInt(C+5,2);
  994. ED := InternalStrToInt(C+8,2);
  995. EH := InternalStrToInt(C+11, 2);
  996. EN := InternalStrToInt(C+14, 2);
  997. ES := InternalStrToInt(C+17, 2);
  998. if Len>20 then
  999. EMS := StrToMSecs(C+20, Len-20)
  1000. else
  1001. EMS := 0;
  1002. if (EY = 0) or (EM = 0) or (ED = 0) then
  1003. Result := 0
  1004. else
  1005. Result := EncodeDate(EY, EM, ED);
  1006. Result := ComposeDateTime(Result, EncodeTimeInterval(EH, EN, ES, EMS));
  1007. end;
  1008. function TConnectionName.InternalStrToTime(C: pchar; Len: integer): TDateTime;
  1009. var
  1010. EH, EM, ES, EMS: Word;
  1011. M: PChar;
  1012. I: Integer;
  1013. begin
  1014. if Len=0 then
  1015. Exit(0);
  1016. if Len<8 then
  1017. raise EConvertError.Create('Invalid time string');
  1018. //hours can be 2 or 3 digits
  1019. M:=C;
  1020. for I := 1 to Len do
  1021. begin
  1022. if M^=':' then
  1023. break;
  1024. Inc(M);
  1025. end;
  1026. if M^<>':' then
  1027. raise EConvertError.Create('Invalid time string');
  1028. EH := InternalStrToInt(C, NativeInt(M-C));
  1029. EM := InternalStrToInt(M+1, 2);
  1030. ES := InternalStrToInt(M+4, 2);
  1031. if Len>NativeInt(M-C)+7 then
  1032. EMS := StrToMSecs(M+7, Len-(NativeInt(M-C)+7))
  1033. else
  1034. EMS := 0;
  1035. Result := EncodeTimeInterval(EH, EM, ES, EMS);
  1036. end;
  1037. {$IFDEF mysql40}
  1038. function TConnectionName.InternalStrToTimeStamp(C: pchar; Len: integer): TDateTime;
  1039. var
  1040. EY, EM, ED: Word;
  1041. EH, EN, ES: Word;
  1042. begin
  1043. if Len=0 then
  1044. Exit(0);
  1045. if Len<14 then
  1046. raise EConvertError.Create('Invalid timestamp string');
  1047. EY := InternalStrToInt(C, 4);
  1048. EM := InternalStrToInt(C+4, 2));
  1049. ED := InternalStrToInt(C+6, 2));
  1050. EH := InternalStrToInt(C+8, 2));
  1051. EN := InternalStrToInt(C+10, 2));
  1052. ES := InternalStrToInt(C+12, 2));
  1053. if (EY = 0) or (EM = 0) or (ED = 0) then
  1054. Result := 0
  1055. else
  1056. Result := EncodeDate(EY, EM, ED);
  1057. Result := ComposeDateTime(Result, EncodeTime(EH, EN, ES, 0));
  1058. end;
  1059. {$ENDIF}
  1060. function TConnectionName.MySQLWriteData(AField: PMYSQL_FIELD; FieldDef: TFieldDef; Source, Dest: PChar; Len: integer; out CreateBlob : boolean): Boolean;
  1061. var
  1062. VI: Integer;
  1063. VL: LargeInt;
  1064. VS: Smallint;
  1065. VW: Word;
  1066. VO: LongWord;
  1067. VF: Double;
  1068. VC: Currency;
  1069. VD: TDateTime;
  1070. VB: TBCD;
  1071. begin
  1072. Result := False;
  1073. CreateBlob := False;
  1074. if Source = Nil then // If the pointer is NULL, the field is NULL
  1075. exit;
  1076. case FieldDef.DataType of
  1077. ftSmallint:
  1078. begin
  1079. VS := InternalStrToInt(Source, Len);
  1080. Move(VS, Dest^, SizeOf(Smallint));
  1081. end;
  1082. ftWord:
  1083. begin
  1084. VW := InternalStrToInt(Source, Len);
  1085. Move(VW, Dest^, SizeOf(Word));
  1086. end;
  1087. ftInteger, ftAutoInc:
  1088. begin
  1089. VI := InternalStrToInt(Source, Len);
  1090. Move(VI, Dest^, SizeOf(Integer));
  1091. end;
  1092. ftLargeInt:
  1093. begin
  1094. {$IFDEF MYSQL50_UP}
  1095. if AField^.ftype = FIELD_TYPE_BIT then
  1096. begin
  1097. VL := 0;
  1098. for VI := 0 to Len-1 do
  1099. VL := VL * 256 + PByte(Source+VI)^;
  1100. end
  1101. else
  1102. {$ENDIF}
  1103. VL := InternalStrToInt64(Source, Len);
  1104. Move(VL, Dest^, SizeOf(LargeInt));
  1105. end;
  1106. ftLongWord:
  1107. begin
  1108. VO := InternalStrToDWord(Source, Len);
  1109. Move(VO, Dest^, SizeOf(LongWord));
  1110. end;
  1111. ftFloat:
  1112. begin
  1113. VF := InternalStrToFloat(Source, Len);
  1114. Move(VF, Dest^, SizeOf(Double));
  1115. end;
  1116. ftBCD:
  1117. begin
  1118. VC := InternalStrToCurrency(Source, Len);
  1119. Move(VC, Dest^, SizeOf(Currency));
  1120. end;
  1121. ftFmtBCD:
  1122. begin
  1123. VB := InternalStrToBCD(Source, Len);
  1124. Move(VB, Dest^, SizeOf(TBCD));
  1125. end;
  1126. ftDate:
  1127. begin
  1128. VD := InternalStrToDate(Source, Len);
  1129. Move(VD, Dest^, SizeOf(TDateTime));
  1130. end;
  1131. ftTime:
  1132. begin
  1133. VD := InternalStrToTime(Source, Len);
  1134. Move(VD, Dest^, SizeOf(TDateTime));
  1135. end;
  1136. ftDateTime:
  1137. begin
  1138. {$IFDEF mysql40}
  1139. if AField^.ftype = FIELD_TYPE_TIMESTAMP then
  1140. VD := InternalStrToTimeStamp(Source, Len)
  1141. else
  1142. {$ENDIF}
  1143. VD := InternalStrToDateTime(Source, Len);
  1144. Move(VD, Dest^, SizeOf(TDateTime));
  1145. end;
  1146. ftString, ftFixedChar:
  1147. // String-fields which can contain more then dsMaxStringSize characters
  1148. // are mapped to ftBlob fields, while their mysql-datatype is FIELD_TYPE_BLOB
  1149. begin
  1150. if Len > FieldDef.Size*FieldDef.CharSize then Len := FieldDef.Size*FieldDef.CharSize;
  1151. Move(Source^, Dest^, Len);
  1152. (Dest+Len)^ := #0;
  1153. end;
  1154. ftVarBytes:
  1155. begin
  1156. if Len > FieldDef.Size then Len := FieldDef.Size;
  1157. PWord(Dest)^ := Len;
  1158. Move(Source^, (Dest+sizeof(Word))^, Len);
  1159. end;
  1160. ftBytes:
  1161. begin
  1162. if Len > FieldDef.Size then Len := FieldDef.Size;
  1163. Move(Source^, Dest^, Len);
  1164. end;
  1165. ftBlob, ftMemo:
  1166. CreateBlob := True;
  1167. end;
  1168. Result := True;
  1169. end;
  1170. procedure TConnectionName.UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string);
  1171. var qry : TSQLQuery;
  1172. begin
  1173. if not assigned(Transaction) then
  1174. DatabaseError(SErrConnTransactionnSet);
  1175. qry := TSQLQuery.Create(nil);
  1176. qry.Transaction := Transaction;
  1177. qry.Database := Self;
  1178. try
  1179. with qry do
  1180. begin
  1181. ParseSQL := False;
  1182. SQL.Clear;
  1183. SQL.Add('show index from ' + TableName);
  1184. Open;
  1185. end;
  1186. while not qry.Eof do with IndexDefs.AddIndexDef do
  1187. begin
  1188. Name := trim(qry.FieldByName('Key_name').AsString);
  1189. Fields := trim(qry.FieldByName('Column_name').AsString);
  1190. If Name = 'PRIMARY' then Options := Options + [ixPrimary];
  1191. If qry.FieldByName('Non_unique').AsInteger = 0 then Options := Options + [ixUnique];
  1192. qry.Next;
  1193. while (Name = trim(qry.FieldByName('Key_name').AsString)) and (not qry.Eof) do
  1194. begin
  1195. Fields := Fields + ';' + trim(qry.FieldByName('Column_name').AsString);
  1196. qry.Next;
  1197. end;
  1198. end;
  1199. qry.Close;
  1200. finally
  1201. qry.Free;
  1202. end;
  1203. end;
  1204. function TConnectionName.RowsAffected(cursor: TSQLCursor): TRowsCount;
  1205. begin
  1206. if assigned(cursor) then
  1207. // Compile this without range-checking. RowsAffected can be -1, although
  1208. // it's an unsigned integer. (small joke from the mysql-guys)
  1209. // Without range-checking this goes ok. If Range is turned on, this results
  1210. // in range-check errors.
  1211. Result := (cursor as TCursorName).RowsAffected
  1212. else
  1213. Result := -1;
  1214. end;
  1215. function TConnectionName.RefreshLastInsertID(Query: TCustomSQLQuery; Field: TField): Boolean;
  1216. begin
  1217. Field.AsLargeInt:=GetInsertID;
  1218. Result := True;
  1219. end;
  1220. constructor TConnectionName.Create(AOwner: TComponent);
  1221. const SingleBackQoutes: TQuoteChars = ('`','`');
  1222. begin
  1223. inherited Create(AOwner);
  1224. FConnOptions := [sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction, sqLastInsertID];
  1225. FieldNameQuoteChars:=SingleBackQoutes;
  1226. FMySQL := Nil;
  1227. end;
  1228. {$IFNDEF MYSQL50_UP}
  1229. procedure TConnectionName.GetFieldNames(const TableName: string; List: TStrings);
  1230. begin
  1231. GetDBInfo(stColumns,TableName,'field',List);
  1232. end;
  1233. procedure TConnectionName.GetTableNames(List: TStrings; SystemTables: Boolean);
  1234. begin
  1235. GetDBInfo(stTables,'','tables_in_'+DatabaseName,List)
  1236. end;
  1237. {$ENDIF}
  1238. function TConnectionName.GetConnectionInfo(InfoType: TConnInfoType): string;
  1239. begin
  1240. Result:='';
  1241. try
  1242. InitialiseMysql;
  1243. case InfoType of
  1244. citServerType:
  1245. Result:='MySQL';
  1246. citServerVersion:
  1247. if Connected then
  1248. Result:=format('%6.6d', [mysql_get_server_version(FMySQL)]);
  1249. citServerVersionString:
  1250. if Connected then
  1251. Result:=mysql_get_server_info(FMySQL);
  1252. citClientVersion:
  1253. Result:=format('%6.6d', [mysql_get_client_version()]);
  1254. citClientName:
  1255. Result:=TMySQLConnectionDef.LoadedLibraryName;
  1256. else
  1257. Result:=inherited GetConnectionInfo(InfoType);
  1258. end;
  1259. finally
  1260. ReleaseMysql;
  1261. end;
  1262. end;
  1263. function TConnectionName.GetTransactionHandle(trans: TSQLHandle): pointer;
  1264. begin
  1265. Result:=Nil;
  1266. end;
  1267. function TConnectionName.Commit(trans: TSQLHandle): boolean;
  1268. begin
  1269. //mysql_commit(FMySQL);
  1270. Result := (mysql_query(FMySQL, 'COMMIT') = 0) or ForcedClose;
  1271. if not Result then
  1272. MySQLError(FMySQL, SErrExecuting, Self);
  1273. end;
  1274. function TConnectionName.RollBack(trans: TSQLHandle): boolean;
  1275. begin
  1276. //mysql_rollback(FMySQL);
  1277. Result := (mysql_query(FMySQL, 'ROLLBACK') = 0) or ForcedClose;
  1278. if not Result then
  1279. MySQLError(FMySQL, SErrExecuting, Self);
  1280. end;
  1281. function TConnectionName.StartdbTransaction(trans: TSQLHandle; AParams : string): boolean;
  1282. begin
  1283. Result := mysql_query(FMySQL, 'START TRANSACTION') = 0;
  1284. if not Result then
  1285. MySQLError(FMySQL, SErrExecuting, Self);
  1286. end;
  1287. procedure TConnectionName.CommitRetaining(trans: TSQLHandle);
  1288. begin
  1289. {$IFDEF MYSQL50_UP}
  1290. if mysql_query(FMySQL, 'COMMIT AND CHAIN') <> 0 then
  1291. MySQLError(FMySQL, SErrExecuting, Self);
  1292. {$ELSE}
  1293. if mysql_query(FMySQL, 'COMMIT') <> 0 then
  1294. MySQLError(FMySQL, SErrExecuting, Self);
  1295. if mysql_query(FMySQL, 'START TRANSACTION') <> 0 then
  1296. MySQLError(FMySQL, SErrExecuting, Self);
  1297. {$ENDIF}
  1298. end;
  1299. procedure TConnectionName.RollBackRetaining(trans: TSQLHandle);
  1300. begin
  1301. {$IFDEF MYSQL50_UP}
  1302. if mysql_query(FMySQL, 'ROLLBACK AND CHAIN') <> 0 then
  1303. MySQLError(FMySQL, SErrExecuting, Self);
  1304. {$ELSE}
  1305. if mysql_query(FMySQL, 'ROLLBACK') <> 0 then
  1306. MySQLError(FMySQL, SErrExecuting, Self);
  1307. if mysql_query(FMySQL, 'START TRANSACTION') <> 0 then
  1308. MySQLError(FMySQL, SErrExecuting, Self);
  1309. {$ENDIF}
  1310. end;
  1311. function TConnectionName.GetSchemaInfoSQL(SchemaType: TSchemaType;
  1312. SchemaObjectName, SchemaPattern: string): string;
  1313. begin
  1314. case SchemaType of
  1315. {$IFDEF MYSQL50_UP}
  1316. stTables : result := 'SELECT * FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA=SCHEMA() AND TABLE_TYPE IN (''BASE TABLE'',''VIEW'')';
  1317. stColumns : result := 'SELECT * FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_SCHEMA=SCHEMA() AND TABLE_NAME='+QuotedStr(SchemaObjectName);
  1318. {$ELSE}
  1319. stTables : result := 'show tables';
  1320. stColumns : result := 'show columns from ' + EscapeString(SchemaObjectName);
  1321. {$ENDIF}
  1322. else
  1323. result := inherited;
  1324. end; {case}
  1325. end;
  1326. { TMySQLConnectionDef }
  1327. class function TMySQLConnectionDef.TypeName: String;
  1328. begin
  1329. Result:='MySQL '+MySQLVersion;
  1330. end;
  1331. class function TMySQLConnectionDef.ConnectionClass: TSQLConnectionClass;
  1332. begin
  1333. {$IFDEF mysql80}
  1334. Result:=TMySQL80Connection;
  1335. {$ELSE}
  1336. {$IFDEF mysql57}
  1337. Result:=TMySQL57Connection;
  1338. {$ELSE}
  1339. {$IFDEF mysql56}
  1340. Result:=TMySQL56Connection;
  1341. {$ELSE}
  1342. {$IfDef mysql55}
  1343. Result:=TMySQL55Connection;
  1344. {$ELSE}
  1345. {$IfDef mysql51}
  1346. Result:=TMySQL51Connection;
  1347. {$ELSE}
  1348. {$IfDef mysql50}
  1349. Result:=TMySQL50Connection;
  1350. {$ELSE}
  1351. {$IfDef mysql41}
  1352. Result:=TMySQL41Connection;
  1353. {$ELSE}
  1354. Result:=TMySQL40Connection;
  1355. {$EndIf}
  1356. {$EndIf}
  1357. {$endif}
  1358. {$endif}
  1359. {$ENDIF}
  1360. {$ENDIF}
  1361. {$ENDIF}
  1362. end;
  1363. class function TMySQLConnectionDef.Description: String;
  1364. begin
  1365. Result:='Connect to a MySQL '+MySQLVersion+' database directly via the client library';
  1366. end;
  1367. class function TMySQLConnectionDef.DefaultLibraryName: String;
  1368. begin
  1369. Result:=mysqlvlib;
  1370. end;
  1371. class function TMySQLConnectionDef.LoadFunction: TLibraryLoadFunction;
  1372. begin
  1373. Result:=@InitialiseMySQL;
  1374. end;
  1375. class function TMySQLConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
  1376. begin
  1377. Result:=@ReleaseMySQL;
  1378. end;
  1379. class function TMySQLConnectionDef.LoadedLibraryName: string;
  1380. begin
  1381. Result:=MysqlLoadedLibrary;
  1382. end;
  1383. {$IFDEF mysql80}
  1384. initialization
  1385. RegisterConnection(TMySQL80ConnectionDef);
  1386. finalization
  1387. UnRegisterConnection(TMySQL80ConnectionDef);
  1388. {$ELSE}
  1389. {$IFDEF mysql57}
  1390. initialization
  1391. RegisterConnection(TMySQL57ConnectionDef);
  1392. finalization
  1393. UnRegisterConnection(TMySQL57ConnectionDef);
  1394. {$ELSE}
  1395. {$IFDEF mysql56}
  1396. initialization
  1397. RegisterConnection(TMySQL56ConnectionDef);
  1398. finalization
  1399. UnRegisterConnection(TMySQL56ConnectionDef);
  1400. {$ELSE}
  1401. {$IfDef mysql55}
  1402. initialization
  1403. RegisterConnection(TMySQL55ConnectionDef);
  1404. finalization
  1405. UnRegisterConnection(TMySQL55ConnectionDef);
  1406. {$else}
  1407. {$IfDef mysql51}
  1408. initialization
  1409. RegisterConnection(TMySQL51ConnectionDef);
  1410. finalization
  1411. UnRegisterConnection(TMySQL51ConnectionDef);
  1412. {$ELSE}
  1413. {$IfDef mysql50}
  1414. initialization
  1415. RegisterConnection(TMySQL50ConnectionDef);
  1416. finalization
  1417. UnRegisterConnection(TMySQL50ConnectionDef);
  1418. {$ELSE}
  1419. {$IfDef mysql41}
  1420. initialization
  1421. RegisterConnection(TMySQL41ConnectionDef);
  1422. finalization
  1423. UnRegisterConnection(TMySQL41ConnectionDef);
  1424. {$ELSE}
  1425. initialization
  1426. RegisterConnection(TMySQL40ConnectionDef);
  1427. finalization
  1428. UnRegisterConnection(TMySQL40ConnectionDef);
  1429. {$EndIf}
  1430. {$EndIf}
  1431. {$ENDIF}
  1432. {$ENDIF}
  1433. {$ENDIF}
  1434. {$ENDIF}
  1435. {$ENDIF}
  1436. end.