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