PageRenderTime 51ms CodeModel.GetById 22ms RepoModel.GetById 0ms app.codeStats 1ms

/skychart-3.6-2150-src/skychart/component/libsql/pasmysql.pas

#
Pascal | 844 lines | 643 code | 94 blank | 107 comment | 84 complexity | a16e9068ea2653f10149748fa0a92e95 MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0, BSD-3-Clause, LGPL-2.1
  1. unit pasmysql;
  2. {$IFDEF FPC}
  3. {$MODE Delphi}
  4. {$H+}
  5. {$ELSE}
  6. {$IFNDEF LINUX}
  7. {$DEFINE WIN32}
  8. {$ENDIF}
  9. {$ENDIF}
  10. interface
  11. uses
  12. {$IFDEF MSWINDOWS}
  13. Windows,
  14. {$ENDIF}
  15. Classes, SysUtils,
  16. libmysql,
  17. passql,
  18. sqlsupport;
  19. //This library is compliant with arbitrary
  20. //versions of libmysql.dll and libmysqld.dll
  21. ////////////////////////////////////////////////
  22. // //
  23. // TMyDB component by rene@dubaron.com //
  24. // TMyDB is a MySQL specific interface //
  25. // Nom part of libsql library //
  26. // //
  27. ////////////////////////////////////////////////
  28. // by R.M. Tegel rene@dubaron.com
  29. const MY_DEFAULT_PORT=3306;
  30. type
  31. TMyVersion = (mvUnknown, mv3_23, mv4_0, mv4_1, mv5_0);
  32. TMyDB = class (TSQLDB)
  33. private
  34. function GetHasResult: Boolean;
  35. procedure SetEmbedded(const Value: Boolean);
  36. protected
  37. MyHandle:MySQL;
  38. PMyHandle:PMySQL;
  39. FLibrary:String;
  40. FHostInfo:String;
  41. FInfo:String;
  42. FRealConnect:Boolean;
  43. FUnixSock:String;
  44. FConnectOptions:Integer;
  45. FEmbedded: Boolean;
  46. FMyVersion: TMyVersion;
  47. mf: TMySQLFunctions; //short name, less typing..
  48. procedure StoreResult(Res: PMYSQL_RES);
  49. procedure FillDBInfo; override;
  50. function MapDataType (_datatype: Integer): TSQLDataTypes;
  51. procedure FillFieldInfo (Res: PMYSQL_RES);
  52. public
  53. FClientVersion: String; //holds version info of libmysql.dll
  54. constructor Create (AOwner:TComponent); override;
  55. destructor Destroy; override;
  56. function Query (SQL:String):Boolean; override;
  57. function Connect (Host, User, Pass:String; DataBase:String=''):Boolean; override;
  58. procedure Close; override;
  59. function ExplainTable (Table:String): Boolean; override;
  60. function ShowCreateTable (Table:String): Boolean; override;
  61. function DumpTable (Table:String): Boolean; override;
  62. function DumpDatabase (Table:String): Boolean; override;
  63. //typical MySQL functions:
  64. function SelectDatabase(Database:String):Boolean;
  65. // function GetSelectedDatabase:String;
  66. procedure SetDatabase(Value:String); override;
  67. function CreateDatabase(Database:String):Boolean; virtual;
  68. function DropDatabase(Database:String):Boolean;
  69. procedure ListDatabases(wildcard:String='');
  70. procedure ListTables(wildcard:String='');
  71. procedure ListFields(table:String; wildcard:String='');
  72. procedure ListProcesses;
  73. function ShutDown:Boolean;
  74. function Kill (Pid:Integer):Boolean; //Kill specific process
  75. procedure SetPort (Port:Integer); override;
  76. procedure SetRealConnect(DoRealConnect:Boolean);
  77. function Ping:Boolean; //See if server is alive
  78. function GetLastError:String;
  79. function GetServerInfo:String;
  80. function ShowTables: Boolean; override;
  81. function Flush (Option:String): Boolean; override;
  82. function TruncateTable (Table:String): Boolean; override;
  83. function LockTables (Statement:String): Boolean; override;
  84. function UnLockTables: Boolean; override;
  85. function Vacuum: Boolean; override;
  86. function Execute (SQL: String): THandle; override;
  87. function FetchRow (Handle: THandle; var row: TResultRow): Boolean; override;
  88. procedure FreeResult (Handle: THandle); override;
  89. property DBHandle:MySQL read MyHandle; //Actual libmysql.dll / mysqlclient.so handle, use it if you want to call functions yourself
  90. property HasResult:Boolean read GetHasResult;// write FHasResult; //Queryhas valid result set
  91. property ServerInfo:String read GetServerInfo; //additional server info
  92. property Info:String read FInfo;
  93. property HostInfo:String read FHostInfo;
  94. property UnixSock:String read FUnixSock write FUnixSock;
  95. published
  96. property Embedded: Boolean read FEmbedded write SetEmbedded;
  97. property RealConnect:Boolean read FRealConnect write SetRealConnect;
  98. property ClientVersion: String read FClientVersion write FDummyString;
  99. end;
  100. implementation
  101. //TMyDB has a constructor. Set some variabels to default, nothing more...
  102. constructor TMyDB.Create;
  103. begin
  104. FLibrary:=DEFAULT_DLL_LOCATION;
  105. {$IFDEF MSWINDOWS}
  106. DLL:=FLibrary;
  107. {$ENDIF}
  108. FHost:='localhost';
  109. FPort:=MY_DEFAULT_PORT;
  110. FActive:=False;
  111. FActivateOnLoad:=False;
  112. FRealConnect:=False;
  113. FConnectOptions:=_CLIENT_COMPRESS or _CLIENT_CONNECT_WITH_DB;
  114. FDataBaseType := dbMySQL;
  115. PrimaryKey := 'auto_increment primary key';
  116. inherited Create(AOwner);
  117. end;
  118. destructor TMyDB.Destroy;
  119. begin
  120. if Active then
  121. Close;
  122. inherited Destroy;
  123. end;
  124. procedure TMyDB.Close;
  125. begin
  126. if FActive then
  127. try
  128. mf.mysql_close(@MyHandle);
  129. {
  130. if Assigned (mf.mysql_thread_end) then //embedded mysql
  131. begin
  132. //don't.. probably mysql_thread_start also returned false.
  133. // mf.mysql_thread_end;
  134. // mf.mysql_server_end;
  135. end;
  136. }
  137. if Assigned(FOnClose) then
  138. FOnClose(Self);
  139. except
  140. // raise Exception.Create('An error occured while closing');
  141. end;
  142. FActive:=False;
  143. end;
  144. function TMyDB.Connect(Host, User, Pass:String; DataBase:String):Boolean;
  145. var AHandle:PMySQL;
  146. begin
  147. Result := False;
  148. //Close if already active
  149. if FActive then Close;
  150. { $IFDEF MSWINDOWS}
  151. //Allow user to change shared library
  152. if FLibrary<>'' then
  153. DLL_Client:=FLibrary;
  154. {$IFDEF MSWINDOWS}
  155. //Embedded mysql 4.1 will definitively not work without config file.
  156. if FEmbedded and not fileexists ('c:\my.cnf') then
  157. //for some reason or another, %sysdir%\mysql.ini is not sufficient
  158. begin
  159. FCurrentSet.FLastError := -1;
  160. FCurrentSet.FLastErrorText := 'File c:\my.cnf does not exist';
  161. exit;
  162. end;
  163. {$ENDIF}
  164. FDllLoaded := MySQLLoadLib (mf, FLibraryPath, FEmbedded);
  165. if not FDllLoaded then
  166. exit;
  167. //Succesfully loaded
  168. if assigned(mf.mysql_thread_init) then
  169. begin
  170. if FEmbedded then
  171. FActive := mf.mysql_thread_init = 0
  172. else
  173. begin
  174. {$IFNDEF MSWINDOWS}
  175. mf.mysql_thread_init; //call anyway.
  176. {$ENDIF}
  177. FActive := True;
  178. end;
  179. end
  180. else
  181. FActive := True;
  182. if not FActive then
  183. exit;
  184. if Assigned (mf.mysql_get_client_info) then
  185. FClientVersion := mf.mysql_get_client_info;
  186. FMyVersion := mv5_0; // assume 5.0 for higher version
  187. if pos ('3.23.', FClientVersion)>0 then
  188. FMyVersion := mv3_23;
  189. if pos ('4.0.', FClientVersion)>0 then
  190. FMyVersion := mv4_0;
  191. if pos ('4.1.', FClientVersion)>0 then
  192. FMyVersion := mv4_1;
  193. if pos ('5.0.', FCLientVersion)>0 then
  194. FMyVersion := mv5_0;
  195. if FEmbedded then //some extra actions if embedded
  196. begin
  197. if Assigned (mf.mysql_server_init) then
  198. Result := 0 = mf.mysql_server_init (3, @DEFAULT_PARAMS, @SERVER_GROUPS)
  199. else
  200. exit;
  201. end
  202. else //libmysql client init:
  203. begin
  204. if assigned(mf.mysql_init) then
  205. PMyHandle := mf.mysql_init(@MyHandle)
  206. else
  207. exit;
  208. end;
  209. FDataBase := DataBase;
  210. PMyHandle := @MyHandle;
  211. if FEmbedded and (FDatabase='') then
  212. exit; //no database selected yet.
  213. if FEmbedded then //the 'dummy' connect proc
  214. begin
  215. if Assigned (mf.mysql_connect) then
  216. begin
  217. mf.mysql_connect (@MyHandle, nil, nil, nil);
  218. end
  219. else
  220. if Assigned (mf.mysql_real_connect) then
  221. mf.mysql_real_connect (@MyHandle, nil, nil, nil, PChar(String(FDataBase)), 0, nil, 0);
  222. if FActive and (FDataBase<>'') then
  223. mf.mysql_select_db(PMyHandle, PChar(FDataBase));
  224. end
  225. else //connect to our database server
  226. begin
  227. //Enable realconnect by default, not overridable...
  228. FRealConnect := True;
  229. if FRealConnect then
  230. try
  231. PMyHandle:= mf.mysql_real_connect(@MyHandle, PChar(String(Host)), PChar(String(User)), PChar(String(Pass)),
  232. PChar(String(FDataBase)), FPort, nil {PChar(String(FUnixSock))}, Integer(CLIENT_COMPRESS){ FConnectOptions});
  233. FActive := PMyHandle<>nil;
  234. if not FActive then
  235. begin
  236. FCurrentSet.FLastErrorText := mf.mysql_error (@MyHandle);
  237. if pos(#0, FCurrentSet.FLastErrorText)>0 then //probably is
  238. FCurrentSet.FLastErrorText := copy (FCurrentSet.FLastErrorText, 1, pos(#0, FCurrentSet.FLastErrorText)-1);
  239. FCurrentSet.FLastError := mf.mysql_errno(@MyHandle);
  240. LogError;
  241. end
  242. else
  243. FCurrentSet.FLastError := 0;
  244. except
  245. FActive:=False;
  246. end
  247. else
  248. begin
  249. AHandle{PMyHandle}:=mf.mysql_connect(@MyHandle, PChar(Host), PChar(User), PChar(Pass));
  250. FActive := AHandle<>nil;
  251. //Select database if assigned:
  252. if FActive and (FDataBase<>'') then
  253. mf.mysql_select_db(@MyHandle, PChar(FDataBase));
  254. end;
  255. end;
  256. PMyHandle := @MyHandle;
  257. Result := FActive;
  258. if FActive and not (csDesigning in ComponentState) then
  259. begin
  260. //Fill in some variables:
  261. if Assigned (mf.mysql_get_server_info) then
  262. FVersion := mf.mysql_get_server_info (PMyHandle);
  263. if Assigned (mf.mysql_character_set_name) then
  264. FEncoding := mf.mysql_character_set_name(PMyHandle);
  265. if Assigned (mf.mysql_get_host_info) then
  266. FHostInfo := mf.mysql_get_host_info (PMyHandle);
  267. if Assigned (mf.mysql_get_proto_info) then
  268. FInfo := IntToStr (mf.mysql_get_proto_info (PMyHandle));
  269. end;
  270. if FActive then
  271. FillDBInfo;
  272. if FActive and Assigned(FOnOpen) then
  273. FOnOpen(Self);
  274. end;
  275. //An active property was added to allow
  276. //database-access in development state ;)
  277. //Quite direct MySQL functions:
  278. function TMyDB.CreateDatabase(Database:String):Boolean;
  279. begin
  280. if FActive{ and assigned (mf.mysql_create_db) }then
  281. Result := FormatQuery ('create database %u', [DataBase]) //(0=mf.mysql_create_db(@MyHandle, PChar(Database)))
  282. else
  283. Result := False;
  284. end;
  285. function TMyDB.DropDatabase(Database:String):Boolean;
  286. begin
  287. if FActive and assigned (mf.mysql_drop_db) then
  288. Result := (0=mf.mysql_drop_db(@MyHandle, PChar(Database)))
  289. else
  290. Result := False;
  291. if Result and
  292. (lowercase(FDataBase) = lowercase(DataBase)) then
  293. FDatabase:='';
  294. end;
  295. function TMyDB.SelectDatabase(Database:String):Boolean;
  296. begin
  297. if FActive and assigned (mf.mysql_select_db) then
  298. Result := (0 = mf.mysql_select_db(@MyHandle, PChar(Database)))
  299. else
  300. Result := False;
  301. if Result then FDatabase:=Database;
  302. end;
  303. function TMyDB.Kill(Pid:Integer):Boolean;
  304. begin
  305. if FActive and assigned (mf.mysql_kill) then
  306. Result := (0=mf.mysql_kill(@MyHandle, Pid))
  307. else
  308. Result := False;
  309. end;
  310. function TMyDB.Ping: Boolean;
  311. begin
  312. Result:=False;
  313. if FActive and assigned (mf.mysql_ping) then
  314. Result:=(mf.mysql_ping(@MyHandle)<>0);
  315. end;
  316. function TMyDB.ShutDown: Boolean;
  317. begin
  318. if FActive then
  319. Result := (0=mf.mysql_shutdown(@MyHandle))
  320. else
  321. Result := False;
  322. end;
  323. //This is where the results from a query are stored in delphi string-arrays
  324. procedure TMyDB.StoreResult;
  325. //Loop all rows from a result set and put fields in 2D-array
  326. var i, j, ri: Integer;
  327. // myrow: mysql_row;
  328. pmyrow: pmysql_row;
  329. //fields: Pmysql_fields;
  330. R: TResultRow;
  331. begin
  332. with FCurrentSet do
  333. begin
  334. FHasResult:=False;
  335. if Res<>nil then
  336. begin
  337. FHasResult:=True;
  338. //reset memory usage counter
  339. FQuerySize := 0;
  340. FRowCount := mf.mysql_num_rows(res); //res^.row_count;
  341. for i:=0 to FRowCount - 1 do
  342. begin
  343. if FCallBackOnly then
  344. ri:=0 //only 1 row needed
  345. else
  346. begin
  347. ri := i;
  348. //Check ranges; break if rowlimit or memory limit reached:
  349. if ((FFetchRowLimit<>0) and ((i+1)>=FFetchRowLimit)) or
  350. ((FFetchMemoryLimit<>0) and (FQuerySize>=FFetchMemoryLimit)) then
  351. break; //mem limit exceeded...
  352. end;
  353. //Fetch a row:
  354. //myrow:=mf.mysql_fetch_row(res)^;
  355. pmyrow:=mf.mysql_fetch_row(res);
  356. if ri<FRowList.Count then
  357. begin
  358. R := TResultRow(FRowList[ri]);
  359. R.Clear;
  360. R.FNulls.Clear;
  361. end
  362. else
  363. begin
  364. R := TResultRow.Create;
  365. R.FFields := FFields; //copy pointer to ffields array
  366. FRowList.Add(R);
  367. end;
  368. for j:=0 to mf.mysql_num_fields(res) - 1 do
  369. begin
  370. if Assigned (pmyrow^[j]) then
  371. R.Add(pmyrow^[j])
  372. else
  373. R.Add('');
  374. R.FNulls.Add(Pointer(Integer(pmyrow^[j]<>nil)));
  375. inc (FQuerySize, length(String(pmyrow^[j])));
  376. end;
  377. if Assigned (FOnFetchRow) then
  378. try
  379. FOnFetchRow (Self, R);
  380. except end;
  381. end;
  382. FillFieldInfo (Res);
  383. //Some more vars:
  384. FColCount := mf.mysql_num_fields(res);
  385. mf.mysql_free_result(res);
  386. FHasResult:=True;
  387. if Assigned (FOnSuccess) then
  388. try
  389. FOnSuccess(Self);
  390. except end;
  391. if Assigned (FOnQueryComplete) then
  392. try
  393. FOnQueryComplete(Self);
  394. except end;
  395. end
  396. else //May be invalid result or just no result
  397. begin //Result = nil;
  398. Clear;
  399. // FLastInsertID := -1;
  400. // FRowsAffected := -1;
  401. FLastErrorText := mf.mysql_error(@MyHandle);
  402. FLastError := mf.mysql_errno(@MyHandle);
  403. if (FLastError<>0) and (Assigned (OnError)) then
  404. OnError (Self);
  405. end;
  406. //those can also be set on empty result sets:
  407. FLastInsertID := mf.mysql_insert_id (@MyHandle);
  408. FRowsAffected := mf.mysql_affected_rows (@MyHandle);
  409. end;
  410. end;
  411. //This is the main function to perform a query:
  412. function TMyDB.Query (SQL: String): Boolean;
  413. begin
  414. Result := False;
  415. if not FActive then
  416. SetActive(True); //Try once if client just performs query
  417. Clear;
  418. with FCurrentSet do
  419. begin
  420. FHasResult := False;
  421. if not FActive then
  422. exit; //sorry... nothing to do here, handle is invalid.
  423. if SQL='' then //clear the results:
  424. begin
  425. StoreResult (nil);
  426. //FCurrentSet.Clear;
  427. exit;
  428. end;
  429. if FActive then
  430. begin
  431. //Allow user to view or edit query:
  432. FSQL:=SQL;
  433. if Assigned (FOnBeforeQuery) then
  434. FOnBeforeQuery(Self, FSQL);
  435. SQL:=FSQL;
  436. //Perform actual query:
  437. if 0=mf.mysql_query(@MyHandle, PChar(SQL)) then
  438. //seems noor version of libmysql
  439. //returns on, even on failure (...)
  440. begin
  441. StoreResult(mf.mysql_store_result(@MyHandle));
  442. FLastError := mf.mysql_errno(@MyHandle);
  443. Result := FLastError=0;
  444. FLastErrorText := '';
  445. FHasResult := True;
  446. end
  447. else
  448. begin
  449. //StoreResult is able to handle errors and will call OnError as well
  450. //Calling it with nill forces a result cleanup:
  451. StoreResult(nil);
  452. FLastErrorText := mf.mysql_error(@MyHandle); //MyHandle._net.last_error;
  453. if pos(#0, FLastErrorText)>0 then //probably is
  454. FLastErrorText := copy (FLastErrorText, 1, pos(#0, FLastErrorText)-1);
  455. FLastError := mf.mysql_errno(@MyHandle); //MyHandle._net.last_errno;
  456. //if Assigned (FOnError) then
  457. // FOnError(Self);
  458. LogError;
  459. end;
  460. end;
  461. end;
  462. end;
  463. //Common libmysql / libmysqlclient functions:
  464. procedure TMyDB.ListDatabases;
  465. begin
  466. if FActive then
  467. StoreResult(mf.mysql_list_dbs(@MyHandle, PChar(wildcard)));
  468. end;
  469. procedure TMyDB.ListTables;
  470. begin
  471. if FActive then
  472. StoreResult(mf.mysql_list_tables(@MyHandle, PChar(wildcard)));
  473. end;
  474. procedure TMyDB.ListProcesses;
  475. begin
  476. if FActive then
  477. StoreResult(mf.mysql_list_processes(@MyHandle));
  478. end;
  479. procedure TMyDB.ListFields;
  480. begin
  481. if FActive then
  482. StoreResult(mf.mysql_list_fields(@MyHandle, PChar(table), PChar(wildcard)));
  483. end;
  484. function TMyDB.GetServerInfo: String;
  485. begin
  486. if FActive then
  487. Result:=mf.mysql_get_server_info(@MyHandle)
  488. else
  489. Result:='Inactive';
  490. end;
  491. function TMyDB.GetLastError: String;
  492. begin
  493. Result := FCurrentSet.FLastErrorText;
  494. end;
  495. //TMyDB control functions:
  496. procedure TMyDB.SetPort;
  497. begin
  498. if (Port<=0) or (Port>65535) then //Simply don't accept value
  499. exit;
  500. if Port<>MY_DEFAULT_PORT then //Force real connect:
  501. FRealConnect:=True;
  502. FPort:=Port;
  503. end;
  504. procedure TMyDB.SetRealConnect;
  505. begin
  506. if not DoRealConnect then //Only connect to default port:
  507. FPort:=MY_DEFAULT_PORT;
  508. FRealConnect:=DoRealConnect;
  509. end;
  510. procedure TMyDB.SetDatabase;
  511. begin
  512. if FActive then
  513. begin
  514. if SelectDataBase(Value) then
  515. FDataBase :=Value;
  516. end
  517. else
  518. FDataBase := Value;
  519. end;
  520. function TMyDB.DumpDatabase(Table: String): Boolean;
  521. begin
  522. Result := False;
  523. end;
  524. function TMyDB.DumpTable(Table: String): Boolean;
  525. begin
  526. Result := False;
  527. end;
  528. function TMyDB.ExplainTable(Table: String): Boolean;
  529. begin
  530. Result := FormatQuery ('explain table %q', [Table]);
  531. end;
  532. function TMyDB.ShowCreateTable(Table: String): Boolean;
  533. begin
  534. Result := False;
  535. end;
  536. function TMyDB.GetHasResult: Boolean;
  537. begin
  538. Result := FCurrentSet.FHasResult;
  539. end;
  540. procedure TMyDB.SetEmbedded(const Value: Boolean);
  541. begin
  542. FEmbedded := Value;
  543. if FEmbedded then
  544. FLibrary := MYSQLD_DLL_LOCATION
  545. else
  546. FLibrary := DEFAULT_DLL_LOCATION;
  547. end;
  548. procedure TMyDB.FillDBInfo;
  549. begin
  550. inherited; //clears tables and indexes
  551. ShowTables;
  552. Tables := GetColumnAsStrings (0);
  553. //list indexes
  554. //Query ('SHOW INDEXES');
  555. Query('');
  556. //this returns a lot more than index name
  557. (*
  558. SHOW INDEX returns the index information in a format that closely resembles the SQLStatistics call in ODBC. The following columns are returned:
  559. Column Meaning
  560. Table Name of the table.
  561. Non_unique 0 if the index can't contain duplicates.
  562. Key_name Name of the index.
  563. Seq_in_index Column sequence number in index, starting with 1.
  564. Column_name Column name.
  565. Collation How the column is sorted in the index. In MySQL, this can have values `A' (Ascending) or NULL (Not sorted).
  566. Cardinality Number of unique values in the index. This is updated by running isamchk -a.
  567. Sub_part Number of indexed characters if the column is only partly indexed. NULL if the entire key is indexed.
  568. Comment Various remarks. For now, it tells whether index is FULLTEXT or not.
  569. *)
  570. Indexes := GetColumnAsStrings (2);
  571. end;
  572. function TMyDB.ShowTables: Boolean;
  573. begin
  574. // mf.mysql_list_tables
  575. Result := Query ('SHOW TABLES');
  576. end;
  577. function TMyDB.Flush (Option:String): Boolean;
  578. begin
  579. Result := Query ('FLUSH '+Option);
  580. end;
  581. function TMyDB.TruncateTable (Table:String): Boolean;
  582. begin
  583. Result := Query ('TRUNCATE TABLE '+Table);
  584. end;
  585. function TMyDB.LockTables (Statement:String): Boolean;
  586. begin
  587. Result := Query ('LOCK TABLES '+Statement);
  588. end;
  589. function TMyDB.UnLockTables: Boolean;
  590. begin
  591. Result := Query ('UNLOCK TABLES');
  592. end;
  593. function TMyDB.Vacuum: Boolean;
  594. begin
  595. Result := false;
  596. end;
  597. function TMyDB.MapDataType(_datatype: Integer): TSQLDataTypes;
  598. begin
  599. case _datatype of
  600. FIELD_TYPE_DECIMAL,
  601. FIELD_TYPE_TINY,
  602. FIELD_TYPE_SHORT,
  603. FIELD_TYPE_LONG : Result := dtInteger;
  604. FIELD_TYPE_FLOAT,
  605. FIELD_TYPE_DOUBLE: Result := dtFloat;
  606. FIELD_TYPE_NULL: Result := dtNull;
  607. FIELD_TYPE_TIMESTAMP: Result := dtTimeStamp;
  608. FIELD_TYPE_LONGLONG: Result := dtInt64;
  609. FIELD_TYPE_INT24: Result := dtInteger;
  610. FIELD_TYPE_DATE,
  611. FIELD_TYPE_TIME,
  612. FIELD_TYPE_DATETIME: Result := dtDateTime;
  613. FIELD_TYPE_YEAR: Result := dtInteger;
  614. FIELD_TYPE_NEWDATE: Result := dtDateTime;
  615. FIELD_TYPE_ENUM,
  616. FIELD_TYPE_SET: Result := dtOther;
  617. FIELD_TYPE_TINY_BLOB,
  618. FIELD_TYPE_MEDIUM_BLOB,
  619. FIELD_TYPE_LONG_BLOB,
  620. FIELD_TYPE_BLOB: Result := dtBlob;
  621. FIELD_TYPE_VAR_STRING,
  622. FIELD_TYPE_STRING: Result := dtString;
  623. FIELD_TYPE_GEOMETRY: Result := dtOther;
  624. else
  625. Result := dtUnknown;
  626. end;
  627. end;
  628. function TMyDB.Execute(SQL: String): THandle;
  629. begin
  630. Result := 0;
  631. if not FDllLoaded then
  632. exit;
  633. if 0=mf.mysql_query(@MyHandle, PChar(SQL)) then
  634. begin
  635. Result := Integer (mf.mysql_store_result(@MyHandle));
  636. UseResultSet (Result);
  637. FCurrentSet.Clear;
  638. if Result <> 0 then
  639. begin
  640. FillFieldInfo (PMYSQL_RES(Result));
  641. FCurrentSet.FColCount := mf.mysql_num_fields(PMYSQL_RES(Result));
  642. end;
  643. end;
  644. end;
  645. function TMyDB.FetchRow(Handle: THandle; var row: TResultRow): Boolean;
  646. var //myrow: mysql_row;
  647. pmyrow: PMysql_row;
  648. j: Integer;
  649. begin
  650. Result := False;
  651. if not FDllLoaded or (Handle = 0) then
  652. exit;
  653. UseResultSet (Handle);
  654. row := FCurrentSet.FNilRow;
  655. pmyrow:=mf.mysql_fetch_row(PMYSQL_RES(Handle));
  656. if not Assigned (pmyrow) then
  657. exit;
  658. //bug fix by paul di aggio
  659. //myrow := pmyrow^;
  660. FCurrentSet.FCurrentRow.Clear;
  661. for j:=0 to mf.mysql_num_fields(PMYSQL_RES(Handle)) - 1 do
  662. begin
  663. if Assigned (pmyrow^[j]) then
  664. FCurrentSet.FCurrentRow.Add(pmyrow^[j])
  665. else
  666. FCurrentSet.FCurrentRow.Add('');
  667. FCurrentSet.FCurrentRow.FNulls.Add(Pointer(Integer(pmyrow^[j]<>nil)));
  668. end;
  669. row := FCurrentSet.FCurrentRow;
  670. Result := True;
  671. end;
  672. procedure TMyDB.FreeResult(Handle: THandle);
  673. begin
  674. if not FDllLoaded or (Handle = 0) then
  675. exit;
  676. mf.mysql_free_result(PMYSQL_RES(Handle));
  677. DeleteResultSet (Handle);
  678. end;
  679. procedure TMyDB.FillFieldInfo(Res: PMYSQL_RES);
  680. var i: Integer;
  681. Field: PMysql_field;
  682. FieldDesc: TFieldDesc;
  683. begin
  684. with FCurrentSet do
  685. begin
  686. for i:=0 to mf.mysql_num_fields(res)-1 do
  687. begin
  688. Field := mf.mysql_fetch_field(res);
  689. if not Assigned (Field) then
  690. continue;
  691. FieldDesc := TFieldDesc.Create;
  692. FFields.AddObject(field.Name, FieldDesc);
  693. with FieldDesc do begin
  694. //Copy data mainly for PChar/String converting
  695. //Makes field info available after resource handle is closed!
  696. //assume field.name is always at same (1st) position:
  697. name:=field.name;
  698. case FMyVersion of
  699. mv3_23:
  700. begin
  701. def:=PMysql_field_32(field).def;
  702. table:=PMysql_field_32(field).table;
  703. _datatype:=PMysql_field_32(field).enum_field_type;
  704. max_length:=PMysql_field_32(field).max_length;
  705. flags:=PMysql_field_32(field).flags;
  706. decimals:=PMysql_field_32(field).decimals;
  707. end;
  708. mv4_0:
  709. begin
  710. def:=PMysql_field_40(field).def;
  711. table:=PMysql_field_40(field).table;
  712. _datatype:=PMysql_field_40(field).enum_field_type;
  713. max_length:=PMysql_field_40(field).max_length;
  714. flags:=PMysql_field_40(field).flags;
  715. decimals:=PMysql_field_40(field).decimals;
  716. end;
  717. mv4_1, mv5_0:
  718. begin
  719. def:=PMysql_field_50(field).def;
  720. table:=PMysql_field_50(field).table;
  721. _datatype:=PMysql_field_50(field).enum_field_type;
  722. max_length:=PMysql_field_50(field).max_length;
  723. flags:=PMysql_field_50(field).flags;
  724. decimals:=PMysql_field_50(field).decimals;
  725. end;
  726. end;
  727. //map mysql flags to some properties
  728. //just hope this is compatible across all mysql versions
  729. //afaik this is 4.1 (3.2 compatible) flag specification
  730. IsNullable := 0 <> (Flags and NOT_NULL_FLAG);
  731. IsPrimaryKey := 0 <> (Flags and PRI_KEY_FLAG);
  732. IsUnique := 0 <> (Flags and UNIQUE_KEY_FLAG);
  733. IsKey := 0 <> (Flags and MULTIPLE_KEY_FLAG);
  734. IsBlob := 0 <> (Flags and BLOB_FLAG);
  735. IsUnsigned := 0 <> (Flags and UNSIGNED_FLAG);
  736. IsAutoIncrement := 0 <> (Flags and AUTO_INCREMENT_FLAG);
  737. IsNumeric := 0 <> (Flags and NUM_FLAG);
  738. (*
  739. non mapped flags:
  740. ZEROFILL_FLAG { Field is zerofill }
  741. BINARY_FLAG { Field is binary }
  742. ENUM_FLAG { Field is an enum }
  743. TIMESTAMP_FLAG { Field is a timestamp }
  744. SET_FLAG { Field is a set }
  745. *)
  746. end;
  747. end;
  748. end;
  749. end;
  750. end.