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