mysqlconn.inc 40 KB

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