mysqlconn.inc 42 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596
  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. {$IF FPC_FULLVERSION >=30301}
  1107. ftLongWord:
  1108. begin
  1109. VO := InternalStrToDWord(Source, Len);
  1110. Move(VO, Dest^, SizeOf(LongWord));
  1111. end;
  1112. {$ENDIF}
  1113. ftFloat:
  1114. begin
  1115. VF := InternalStrToFloat(Source, Len);
  1116. Move(VF, Dest^, SizeOf(Double));
  1117. end;
  1118. ftBCD:
  1119. begin
  1120. VC := InternalStrToCurrency(Source, Len);
  1121. Move(VC, Dest^, SizeOf(Currency));
  1122. end;
  1123. ftFmtBCD:
  1124. begin
  1125. VB := InternalStrToBCD(Source, Len);
  1126. Move(VB, Dest^, SizeOf(TBCD));
  1127. end;
  1128. ftDate:
  1129. begin
  1130. VD := InternalStrToDate(Source, Len);
  1131. Move(VD, Dest^, SizeOf(TDateTime));
  1132. end;
  1133. ftTime:
  1134. begin
  1135. VD := InternalStrToTime(Source, Len);
  1136. Move(VD, Dest^, SizeOf(TDateTime));
  1137. end;
  1138. ftDateTime:
  1139. begin
  1140. {$IFDEF mysql40}
  1141. if AField^.ftype = FIELD_TYPE_TIMESTAMP then
  1142. VD := InternalStrToTimeStamp(Source, Len)
  1143. else
  1144. {$ENDIF}
  1145. VD := InternalStrToDateTime(Source, Len);
  1146. Move(VD, Dest^, SizeOf(TDateTime));
  1147. end;
  1148. ftString, ftFixedChar:
  1149. // String-fields which can contain more then dsMaxStringSize characters
  1150. // are mapped to ftBlob fields, while their mysql-datatype is FIELD_TYPE_BLOB
  1151. begin
  1152. if Len > FieldDef.Size*FieldDef.CharSize then Len := FieldDef.Size*FieldDef.CharSize;
  1153. Move(Source^, Dest^, Len);
  1154. (Dest+Len)^ := #0;
  1155. end;
  1156. ftVarBytes:
  1157. begin
  1158. if Len > FieldDef.Size then Len := FieldDef.Size;
  1159. PWord(Dest)^ := Len;
  1160. Move(Source^, (Dest+sizeof(Word))^, Len);
  1161. end;
  1162. ftBytes:
  1163. begin
  1164. if Len > FieldDef.Size then Len := FieldDef.Size;
  1165. Move(Source^, Dest^, Len);
  1166. end;
  1167. ftBlob, ftMemo:
  1168. CreateBlob := True;
  1169. end;
  1170. Result := True;
  1171. end;
  1172. procedure TConnectionName.UpdateIndexDefs(IndexDefs : TIndexDefs;TableName : string);
  1173. var qry : TSQLQuery;
  1174. begin
  1175. if not assigned(Transaction) then
  1176. DatabaseError(SErrConnTransactionnSet);
  1177. qry := TSQLQuery.Create(nil);
  1178. qry.Transaction := Transaction;
  1179. qry.Database := Self;
  1180. try
  1181. with qry do
  1182. begin
  1183. ParseSQL := False;
  1184. SQL.Clear;
  1185. SQL.Add('show index from ' + TableName);
  1186. Open;
  1187. end;
  1188. while not qry.Eof do with IndexDefs.AddIndexDef do
  1189. begin
  1190. Name := trim(qry.FieldByName('Key_name').AsString);
  1191. Fields := trim(qry.FieldByName('Column_name').AsString);
  1192. If Name = 'PRIMARY' then Options := Options + [ixPrimary];
  1193. If qry.FieldByName('Non_unique').AsInteger = 0 then Options := Options + [ixUnique];
  1194. qry.Next;
  1195. while (Name = trim(qry.FieldByName('Key_name').AsString)) and (not qry.Eof) do
  1196. begin
  1197. Fields := Fields + ';' + trim(qry.FieldByName('Column_name').AsString);
  1198. qry.Next;
  1199. end;
  1200. end;
  1201. qry.Close;
  1202. finally
  1203. qry.Free;
  1204. end;
  1205. end;
  1206. function TConnectionName.RowsAffected(cursor: TSQLCursor): TRowsCount;
  1207. begin
  1208. if assigned(cursor) then
  1209. // Compile this without range-checking. RowsAffected can be -1, although
  1210. // it's an unsigned integer. (small joke from the mysql-guys)
  1211. // Without range-checking this goes ok. If Range is turned on, this results
  1212. // in range-check errors.
  1213. Result := (cursor as TCursorName).RowsAffected
  1214. else
  1215. Result := -1;
  1216. end;
  1217. function TConnectionName.RefreshLastInsertID(Query: TCustomSQLQuery; Field: TField): Boolean;
  1218. begin
  1219. Field.AsLargeInt:=GetInsertID;
  1220. Result := True;
  1221. end;
  1222. constructor TConnectionName.Create(AOwner: TComponent);
  1223. const SingleBackQoutes: TQuoteChars = ('`','`');
  1224. begin
  1225. inherited Create(AOwner);
  1226. FConnOptions := [sqEscapeRepeat, sqEscapeSlash, sqImplicitTransaction, sqLastInsertID];
  1227. FieldNameQuoteChars:=SingleBackQoutes;
  1228. FMySQL := Nil;
  1229. end;
  1230. {$IFNDEF MYSQL50_UP}
  1231. procedure TConnectionName.GetFieldNames(const TableName: string; List: TStrings);
  1232. begin
  1233. GetDBInfo(stColumns,TableName,'field',List);
  1234. end;
  1235. procedure TConnectionName.GetTableNames(List: TStrings; SystemTables: Boolean);
  1236. begin
  1237. GetDBInfo(stTables,'','tables_in_'+DatabaseName,List)
  1238. end;
  1239. {$ENDIF}
  1240. function TConnectionName.GetConnectionInfo(InfoType: TConnInfoType): string;
  1241. begin
  1242. Result:='';
  1243. try
  1244. InitialiseMysql;
  1245. case InfoType of
  1246. citServerType:
  1247. Result:='MySQL';
  1248. citServerVersion:
  1249. if Connected then
  1250. Result:=format('%6.6d', [mysql_get_server_version(FMySQL)]);
  1251. citServerVersionString:
  1252. if Connected then
  1253. Result:=mysql_get_server_info(FMySQL);
  1254. citClientVersion:
  1255. Result:=format('%6.6d', [mysql_get_client_version()]);
  1256. citClientName:
  1257. Result:=TMySQLConnectionDef.LoadedLibraryName;
  1258. else
  1259. Result:=inherited GetConnectionInfo(InfoType);
  1260. end;
  1261. finally
  1262. ReleaseMysql;
  1263. end;
  1264. end;
  1265. function TConnectionName.GetTransactionHandle(trans: TSQLHandle): pointer;
  1266. begin
  1267. Result:=Nil;
  1268. end;
  1269. function TConnectionName.Commit(trans: TSQLHandle): boolean;
  1270. begin
  1271. //mysql_commit(FMySQL);
  1272. Result := (mysql_query(FMySQL, 'COMMIT') = 0) or ForcedClose;
  1273. if not Result then
  1274. MySQLError(FMySQL, SErrExecuting, Self);
  1275. end;
  1276. function TConnectionName.RollBack(trans: TSQLHandle): boolean;
  1277. begin
  1278. //mysql_rollback(FMySQL);
  1279. Result := (mysql_query(FMySQL, 'ROLLBACK') = 0) or ForcedClose;
  1280. if not Result then
  1281. MySQLError(FMySQL, SErrExecuting, Self);
  1282. end;
  1283. function TConnectionName.StartdbTransaction(trans: TSQLHandle; AParams : string): boolean;
  1284. begin
  1285. Result := mysql_query(FMySQL, 'START TRANSACTION') = 0;
  1286. if not Result then
  1287. MySQLError(FMySQL, SErrExecuting, Self);
  1288. end;
  1289. procedure TConnectionName.CommitRetaining(trans: TSQLHandle);
  1290. begin
  1291. {$IFDEF MYSQL50_UP}
  1292. if mysql_query(FMySQL, 'COMMIT AND CHAIN') <> 0 then
  1293. MySQLError(FMySQL, SErrExecuting, Self);
  1294. {$ELSE}
  1295. if mysql_query(FMySQL, 'COMMIT') <> 0 then
  1296. MySQLError(FMySQL, SErrExecuting, Self);
  1297. if mysql_query(FMySQL, 'START TRANSACTION') <> 0 then
  1298. MySQLError(FMySQL, SErrExecuting, Self);
  1299. {$ENDIF}
  1300. end;
  1301. procedure TConnectionName.RollBackRetaining(trans: TSQLHandle);
  1302. begin
  1303. {$IFDEF MYSQL50_UP}
  1304. if mysql_query(FMySQL, 'ROLLBACK AND CHAIN') <> 0 then
  1305. MySQLError(FMySQL, SErrExecuting, Self);
  1306. {$ELSE}
  1307. if mysql_query(FMySQL, 'ROLLBACK') <> 0 then
  1308. MySQLError(FMySQL, SErrExecuting, Self);
  1309. if mysql_query(FMySQL, 'START TRANSACTION') <> 0 then
  1310. MySQLError(FMySQL, SErrExecuting, Self);
  1311. {$ENDIF}
  1312. end;
  1313. function TConnectionName.GetSchemaInfoSQL(SchemaType: TSchemaType;
  1314. SchemaObjectName, SchemaPattern: string): string;
  1315. begin
  1316. case SchemaType of
  1317. {$IFDEF MYSQL50_UP}
  1318. stTables : result := 'SELECT * FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA=SCHEMA() AND TABLE_TYPE IN (''BASE TABLE'',''VIEW'')';
  1319. stColumns : result := 'SELECT * FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_SCHEMA=SCHEMA() AND TABLE_NAME='+QuotedStr(SchemaObjectName);
  1320. {$ELSE}
  1321. stTables : result := 'show tables';
  1322. stColumns : result := 'show columns from ' + EscapeString(SchemaObjectName);
  1323. {$ENDIF}
  1324. else
  1325. result := inherited;
  1326. end; {case}
  1327. end;
  1328. { TMySQLConnectionDef }
  1329. class function TMySQLConnectionDef.TypeName: String;
  1330. begin
  1331. Result:='MySQL '+MySQLVersion;
  1332. end;
  1333. class function TMySQLConnectionDef.ConnectionClass: TSQLConnectionClass;
  1334. begin
  1335. {$IFDEF mysql80}
  1336. Result:=TMySQL80Connection;
  1337. {$ELSE}
  1338. {$IFDEF mysql57}
  1339. Result:=TMySQL57Connection;
  1340. {$ELSE}
  1341. {$IFDEF mysql56}
  1342. Result:=TMySQL56Connection;
  1343. {$ELSE}
  1344. {$IfDef mysql55}
  1345. Result:=TMySQL55Connection;
  1346. {$ELSE}
  1347. {$IfDef mysql51}
  1348. Result:=TMySQL51Connection;
  1349. {$ELSE}
  1350. {$IfDef mysql50}
  1351. Result:=TMySQL50Connection;
  1352. {$ELSE}
  1353. {$IfDef mysql41}
  1354. Result:=TMySQL41Connection;
  1355. {$ELSE}
  1356. Result:=TMySQL40Connection;
  1357. {$EndIf}
  1358. {$EndIf}
  1359. {$endif}
  1360. {$endif}
  1361. {$ENDIF}
  1362. {$ENDIF}
  1363. {$ENDIF}
  1364. end;
  1365. class function TMySQLConnectionDef.Description: String;
  1366. begin
  1367. Result:='Connect to a MySQL '+MySQLVersion+' database directly via the client library';
  1368. end;
  1369. class function TMySQLConnectionDef.DefaultLibraryName: String;
  1370. begin
  1371. Result:=mysqlvlib;
  1372. end;
  1373. class function TMySQLConnectionDef.LoadFunction: TLibraryLoadFunction;
  1374. begin
  1375. Result:=@InitialiseMySQL;
  1376. end;
  1377. class function TMySQLConnectionDef.UnLoadFunction: TLibraryUnLoadFunction;
  1378. begin
  1379. Result:=@ReleaseMySQL;
  1380. end;
  1381. class function TMySQLConnectionDef.LoadedLibraryName: string;
  1382. begin
  1383. Result:=MysqlLoadedLibrary;
  1384. end;
  1385. {$IFDEF mysql80}
  1386. initialization
  1387. RegisterConnection(TMySQL80ConnectionDef);
  1388. finalization
  1389. UnRegisterConnection(TMySQL80ConnectionDef);
  1390. {$ELSE}
  1391. {$IFDEF mysql57}
  1392. initialization
  1393. RegisterConnection(TMySQL57ConnectionDef);
  1394. finalization
  1395. UnRegisterConnection(TMySQL57ConnectionDef);
  1396. {$ELSE}
  1397. {$IFDEF mysql56}
  1398. initialization
  1399. RegisterConnection(TMySQL56ConnectionDef);
  1400. finalization
  1401. UnRegisterConnection(TMySQL56ConnectionDef);
  1402. {$ELSE}
  1403. {$IfDef mysql55}
  1404. initialization
  1405. RegisterConnection(TMySQL55ConnectionDef);
  1406. finalization
  1407. UnRegisterConnection(TMySQL55ConnectionDef);
  1408. {$else}
  1409. {$IfDef mysql51}
  1410. initialization
  1411. RegisterConnection(TMySQL51ConnectionDef);
  1412. finalization
  1413. UnRegisterConnection(TMySQL51ConnectionDef);
  1414. {$ELSE}
  1415. {$IfDef mysql50}
  1416. initialization
  1417. RegisterConnection(TMySQL50ConnectionDef);
  1418. finalization
  1419. UnRegisterConnection(TMySQL50ConnectionDef);
  1420. {$ELSE}
  1421. {$IfDef mysql41}
  1422. initialization
  1423. RegisterConnection(TMySQL41ConnectionDef);
  1424. finalization
  1425. UnRegisterConnection(TMySQL41ConnectionDef);
  1426. {$ELSE}
  1427. initialization
  1428. RegisterConnection(TMySQL40ConnectionDef);
  1429. finalization
  1430. UnRegisterConnection(TMySQL40ConnectionDef);
  1431. {$EndIf}
  1432. {$EndIf}
  1433. {$ENDIF}
  1434. {$ENDIF}
  1435. {$ENDIF}
  1436. {$ENDIF}
  1437. {$ENDIF}
  1438. end.