mysqlconn.inc 40 KB

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