opensource/HeidiSQL
1
0
Fork 0
mirror of https://github.com/HeidiSQL/HeidiSQL.git synced 2025-08-16 20:11:48 +08:00
Code Issues Packages Projects Releases Wiki Activity

Experimental: introduce TDbLib and descendant TMySQLLib, and outsource dll loading mechanism there, out of DoBeforeConnect

Browse Source
This commit is contained in:
Ansgar Becker
2019-06-19 21:15:22 +02:00
parent e704ecd371
commit a77eedde58
3 changed files with 255 additions and 215 deletions
Download Patch File Download Diff File Expand all files Collapse all files

270
source/dbconnection.pas
View File

@ -228,7 +228,7 @@ type
constructor Create(SessionRegPath: String); overload; constructor Create(SessionRegPath: String); overload;
procedure SaveToRegistry; procedure SaveToRegistry;
function CreateConnection(AOwner: TComponent): TDBConnection; function CreateConnection(AOwner: TComponent): TDBConnection;
function CreateQuery(AOwner: TComponent): TDBQuery; function CreateQuery(Connection: TDbConnection): TDBQuery;
function NetTypeName(NetType: TNetType; LongFormat: Boolean): String; function NetTypeName(NetType: TNetType; LongFormat: Boolean): String;
class function IsCompatibleToWin10S(NetType: TNetType): Boolean; class function IsCompatibleToWin10S(NetType: TNetType): Boolean;
function GetNetTypeGroup: TNetTypeGroup; function GetNetTypeGroup: TNetTypeGroup;
@ -402,7 +402,7 @@ type
function DbObjectsCached(db: String): Boolean; function DbObjectsCached(db: String): Boolean;
function ParseDateTime(Str: String): TDateTime; function ParseDateTime(Str: String): TDateTime;
function GetKeyColumns(Columns: TTableColumnList; Keys: TTableKeyList): TStringList; function GetKeyColumns(Columns: TTableColumnList; Keys: TTableKeyList): TStringList;
function ConnectionInfo: TStringList; function ConnectionInfo: TStringList; virtual;
function GetLastResults: TDBQueryList; virtual; abstract; function GetLastResults: TDBQueryList; virtual; abstract;
function GetCreateCode(Obj: TDBObject): String; virtual; function GetCreateCode(Obj: TDBObject): String; virtual;
procedure PrefetchCreateCode(Objects: TDBObjectList); procedure PrefetchCreateCode(Objects: TDBObjectList);
@ -477,11 +477,11 @@ type
TMySQLConnection = class(TDBConnection) TMySQLConnection = class(TDBConnection)
private private
FHandle: PMYSQL; FHandle: PMYSQL;
FLib: TMySQLLib;
FLastRawResults: TMySQLRawResults; FLastRawResults: TMySQLRawResults;
procedure SetActive(Value: Boolean); override; procedure SetActive(Value: Boolean); override;
procedure DoBeforeConnect; override; procedure DoBeforeConnect; override;
procedure DoAfterConnect; override; procedure DoAfterConnect; override;
procedure AssignProc(var Proc: FARPROC; Name: PAnsiChar);
function GetThreadId: Int64; override; function GetThreadId: Int64; override;
function GetCharacterSet: String; override; function GetCharacterSet: String; override;
procedure SetCharacterSet(CharsetName: String); override; procedure SetCharacterSet(CharsetName: String); override;
@ -497,8 +497,10 @@ type
procedure SetLockedByThread(Value: TThread); override; procedure SetLockedByThread(Value: TThread); override;
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
property Lib: TMySQLLib read FLib;
procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); override; procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); override;
function Ping(Reconnect: Boolean): Boolean; override; function Ping(Reconnect: Boolean): Boolean; override;
function ConnectionInfo: TStringList; override;
function GetLastResults: TDBQueryList; override; function GetLastResults: TDBQueryList; override;
function GetCreateCode(Obj: TDBObject): String; override; function GetCreateCode(Obj: TDBObject): String; override;
property LastRawResults: TMySQLRawResults read FLastRawResults; property LastRawResults: TMySQLRawResults read FLastRawResults;
@ -649,9 +651,8 @@ type
property ColumnOrgNames: TStringList read FColumnOrgNames write SetColumnOrgNames; property ColumnOrgNames: TStringList read FColumnOrgNames write SetColumnOrgNames;
property AutoIncrementColumn: Integer read FAutoIncrementColumn; property AutoIncrementColumn: Integer read FAutoIncrementColumn;
property DBObject: TDBObject read FDBObject write SetDBObject; property DBObject: TDBObject read FDBObject write SetDBObject;
published
property SQL: String read FSQL write FSQL; property SQL: String read FSQL write FSQL;
property Connection: TDBConnection read FConnection write FConnection; property Connection: TDBConnection read FConnection;
end; end;
PDBQuery = ^TDBQuery; PDBQuery = ^TDBQuery;
@ -659,11 +660,13 @@ type
TMySQLQuery = class(TDBQuery) TMySQLQuery = class(TDBQuery)
private private
FConnection: TMySQLConnection;
FResultList: TMySQLRawResults; FResultList: TMySQLRawResults;
FCurrentResults: PMYSQL_RES; FCurrentResults: PMYSQL_RES;
FCurrentRow: PMYSQL_ROW; FCurrentRow: PMYSQL_ROW;
procedure SetRecNo(Value: Int64); override; procedure SetRecNo(Value: Int64); override;
public public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
procedure Execute(AddResult: Boolean=False; UseRawResult: Integer=-1); override; procedure Execute(AddResult: Boolean=False; UseRawResult: Integer=-1); override;
function GetColBinData(Column: Integer; var baData: TBytes): Boolean; override; function GetColBinData(Column: Integer; var baData: TBytes): Boolean; override;
@ -730,37 +733,6 @@ exports
{$I const.inc} {$I const.inc}
var var
LibMysqlPath: String;
LibMysqlHandle: HMODULE; // Shared module handle
mysql_affected_rows: function(Handle: PMYSQL): Int64; stdcall;
mysql_character_set_name: function(Handle: PMYSQL): PAnsiChar; stdcall;
mysql_close: procedure(Handle: PMYSQL); stdcall;
mysql_data_seek: procedure(Result: PMYSQL_RES; Offset: Int64); stdcall;
mysql_errno: function(Handle: PMYSQL): Cardinal; stdcall;
mysql_error: function(Handle: PMYSQL): PAnsiChar; stdcall;
mysql_fetch_field_direct: function(Result: PMYSQL_RES; FieldNo: Cardinal): PMYSQL_FIELD; stdcall;
mysql_fetch_lengths: function(Result: PMYSQL_RES): PLongInt; stdcall;
mysql_fetch_row: function(Result: PMYSQL_RES): PMYSQL_ROW; stdcall;
mysql_free_result: procedure(Result: PMYSQL_RES); stdcall;
mysql_get_client_info: function: PAnsiChar; stdcall;
mysql_get_server_info: function(Handle: PMYSQL): PAnsiChar; stdcall;
mysql_init: function(Handle: PMYSQL): PMYSQL; stdcall;
mysql_num_fields: function(Result: PMYSQL_RES): Integer; stdcall;
mysql_num_rows: function(Result: PMYSQL_RES): Int64; stdcall;
mysql_options: function(Handle: PMYSQL; Option: Integer; arg: PAnsiChar): Integer; stdcall;
mysql_ping: function(Handle: PMYSQL): Integer; stdcall;
mysql_real_connect: function(Handle: PMYSQL; const Host, User, Passwd, Db: PAnsiChar; Port: Cardinal; const UnixSocket: PAnsiChar; ClientFlag: Cardinal): PMYSQL; stdcall;
mysql_real_query: function(Handle: PMYSQL; const Query: PAnsiChar; Length: Cardinal): Integer; stdcall;
mysql_ssl_set: function(Handle: PMYSQL; const key, cert, CA, CApath, cipher: PAnsiChar): Byte; stdcall;
mysql_stat: function(Handle: PMYSQL): PAnsiChar; stdcall;
mysql_store_result: function(Handle: PMYSQL): PMYSQL_RES; stdcall;
mysql_thread_id: function(Handle: PMYSQL): Cardinal; stdcall;
mysql_next_result: function(Handle: PMYSQL): Integer; stdcall;
mysql_set_character_set: function(Handle: PMYSQL; csname: PAnsiChar): Integer; stdcall;
mysql_thread_init: function: Byte; stdcall;
mysql_thread_end: procedure; stdcall;
mysql_warning_count: function(Handle: PMYSQL): Cardinal; stdcall;
LibPqPath: String = 'libpq.dll'; LibPqPath: String = 'libpq.dll';
LibPqHandle: HMODULE; LibPqHandle: HMODULE;
@ -1302,15 +1274,15 @@ begin
end; end;
function TConnectionParameters.CreateQuery(AOwner: TComponent): TDBQuery; function TConnectionParameters.CreateQuery(Connection: TDbConnection): TDBQuery;
begin begin
case NetTypeGroup of case NetTypeGroup of
ngMySQL: ngMySQL:
Result := TMySQLQuery.Create(AOwner); Result := TMySQLQuery.Create(Connection);
ngMSSQL: ngMSSQL:
Result := TAdoDBQuery.Create(AOwner); Result := TAdoDBQuery.Create(Connection);
ngPgSQL: ngPgSQL:
Result := TPGQuery.Create(AOwner); Result := TPGQuery.Create(Connection);
else else
raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(FNetType)]); raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(FNetType)]);
end; end;
@ -1682,25 +1654,6 @@ begin
end; end;
procedure TMySQLConnection.AssignProc(var Proc: FARPROC; Name: PAnsiChar);
var
ClientVersion: String;
begin
// Map library procedure to internal procedure
Log(lcDebug, f_('Assign procedure "%s"', [Name]));
Proc := GetProcAddress(LibMysqlHandle, Name);
if Proc = nil then begin
if @mysql_get_client_info = nil then
mysql_get_client_info := GetProcAddress(LibMysqlHandle, 'mysql_get_client_info');
ClientVersion := '';
if @mysql_get_client_info <> nil then
ClientVersion := ' ('+DecodeApiString(mysql_get_client_info)+')';
LibMysqlHandle := 0;
raise EDatabaseError.Create(f_('Your %s is out-dated or somehow incompatible to %s. Please use the one from the installer, or just reinstall %s.', [LibMysqlPath+ClientVersion, APPNAME, APPNAME]));
end;
end;
procedure TPgConnection.AssignProc(var Proc: FARPROC; Name: PAnsiChar); procedure TPgConnection.AssignProc(var Proc: FARPROC; Name: PAnsiChar);
begin begin
// Map library procedure to internal procedure // Map library procedure to internal procedure
@ -1727,9 +1680,9 @@ begin
// We're running in a thread already. Ensure that Log() is able to detect that. // We're running in a thread already. Ensure that Log() is able to detect that.
FLockedByThread := Value; FLockedByThread := Value;
Log(lcDebug, 'mysql_thread_init, thread id #'+IntToStr(Value.ThreadID)); Log(lcDebug, 'mysql_thread_init, thread id #'+IntToStr(Value.ThreadID));
mysql_thread_init; FLib.mysql_thread_init;
end else begin end else begin
mysql_thread_end; FLib.mysql_thread_end;
Log(lcDebug, 'mysql_thread_end, thread id #'+IntToStr(FLockedByThread.ThreadID)); Log(lcDebug, 'mysql_thread_end, thread id #'+IntToStr(FLockedByThread.ThreadID));
FLockedByThread := Value; FLockedByThread := Value;
end; end;
@ -1761,7 +1714,7 @@ begin
DoBeforeConnect; DoBeforeConnect;
// Get handle // Get handle
FHandle := mysql_init(nil); FHandle := FLib.mysql_init(nil);
// Prepare special stuff for SSL and SSH tunnel // Prepare special stuff for SSL and SSH tunnel
FinalHost := FParameters.Hostname; FinalHost := FParameters.Hostname;
@ -1783,7 +1736,7 @@ begin
if FParameters.SSLCipher <> '' then if FParameters.SSLCipher <> '' then
sslcipher := PAnsiChar(AnsiString(FParameters.SSLCipher)); sslcipher := PAnsiChar(AnsiString(FParameters.SSLCipher));
{ TODO : Use Cipher and CAPath parameters } { TODO : Use Cipher and CAPath parameters }
mysql_ssl_set(FHandle, FLib.mysql_ssl_set(FHandle,
sslkey, sslkey,
sslcert, sslcert,
sslca, sslca,
@ -1819,7 +1772,7 @@ begin
// Point libmysql to the folder with client plugins // Point libmysql to the folder with client plugins
PluginDir := AnsiString(ExtractFilePath(ParamStr(0))+'plugins'); PluginDir := AnsiString(ExtractFilePath(ParamStr(0))+'plugins');
SetOptionResult := mysql_options(FHandle, Integer(MYSQL_PLUGIN_DIR), PAnsiChar(PluginDir)); SetOptionResult := FLib.mysql_options(FHandle, Integer(MYSQL_PLUGIN_DIR), PAnsiChar(PluginDir));
if SetOptionResult <> 0 then begin if SetOptionResult <> 0 then begin
raise EDatabaseError.Create(f_('Plugin directory %s could not be set.', [PluginDir])); raise EDatabaseError.Create(f_('Plugin directory %s could not be set.', [PluginDir]));
end; end;
@ -1827,14 +1780,14 @@ begin
// Define which TLS protocol versions are allowed. // Define which TLS protocol versions are allowed.
// See https://www.heidisql.com/forum.php?t=27158 // See https://www.heidisql.com/forum.php?t=27158
// See https://mariadb.com/kb/en/library/mysql_optionsv/ // See https://mariadb.com/kb/en/library/mysql_optionsv/
mysql_options(FHandle, Integer(MARIADB_OPT_TLS_VERSION), PAnsiChar('TLSv1,TLSv1.1,TLSv1.2,TLSv1.3')); FLib.mysql_options(FHandle, Integer(MARIADB_OPT_TLS_VERSION), PAnsiChar('TLSv1,TLSv1.1,TLSv1.2,TLSv1.3'));
mysql_options(FHandle, Integer(MYSQL_OPT_TLS_VERSION), PAnsiChar('TLSv1,TLSv1.1,TLSv1.2,TLSv1.3')); FLib.mysql_options(FHandle, Integer(MYSQL_OPT_TLS_VERSION), PAnsiChar('TLSv1,TLSv1.1,TLSv1.2,TLSv1.3'));
// Enable cleartext plugin // Enable cleartext plugin
if Parameters.CleartextPluginEnabled then if Parameters.CleartextPluginEnabled then
mysql_options(FHandle, Integer(MYSQL_ENABLE_CLEARTEXT_PLUGIN), PAnsiChar('1')); FLib.mysql_options(FHandle, Integer(MYSQL_ENABLE_CLEARTEXT_PLUGIN), PAnsiChar('1'));
Connected := mysql_real_connect( Connected := FLib.mysql_real_connect(
FHandle, FHandle,
PAnsiChar(Utf8Encode(FinalHost)), PAnsiChar(Utf8Encode(FinalHost)),
PAnsiChar(Utf8Encode(FParameters.Username)), PAnsiChar(Utf8Encode(FParameters.Username)),
@ -1912,7 +1865,7 @@ begin
Status.Next; Status.Next;
end; end;
FServerDateTimeOnStartup := GetVar('SELECT NOW()'); FServerDateTimeOnStartup := GetVar('SELECT NOW()');
FServerVersionUntouched := DecodeAPIString(mysql_get_server_info(FHandle)); FServerVersionUntouched := DecodeAPIString(FLib.mysql_get_server_info(FHandle));
Vars := GetSessionVariables(False); Vars := GetSessionVariables(False);
while not Vars.Eof do begin while not Vars.Eof do begin
if Vars.Col(0) = 'version_compile_os' then if Vars.Col(0) = 'version_compile_os' then
@ -1941,7 +1894,7 @@ begin
end end
else if (not Value) and (FHandle <> nil) then begin else if (not Value) and (FHandle <> nil) then begin
mysql_close(FHandle); FLib.mysql_close(FHandle);
FActive := False; FActive := False;
ClearCache(False); ClearCache(False);
FConnectionStarted := 0; FConnectionStarted := 0;
@ -2290,11 +2243,10 @@ procedure TMySQLConnection.DoBeforeConnect;
var var
msg, msg,
TryLibraryPath: String; TryLibraryPath: String;
OldErrorMode: Cardinal;
TryLibraryPaths: TStringList; TryLibraryPaths: TStringList;
begin begin
// Init libmysql before actually connecting. // Init libmysql before actually connecting.
if LibMysqlHandle = 0 then begin
// Try newer libmariadb version at first, and fall back to libmysql, // Try newer libmariadb version at first, and fall back to libmysql,
// then fall back to dlls somewhere else on the users harddisk // then fall back to dlls somewhere else on the users harddisk
@ -2306,59 +2258,24 @@ begin
for TryLibraryPath in TryLibraryPaths do begin for TryLibraryPath in TryLibraryPaths do begin
Log(lcDebug, f_('Loading library file %s ...', [TryLibraryPath])); Log(lcDebug, f_('Loading library file %s ...', [TryLibraryPath]));
// Temporarily suppress error popups while loading new library on Windows XP, see #79 try
OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS); FLib := TMySQLLib.Create(ExtractFilePath(Application.ExeName) + TryLibraryPath);
SetErrorMode(OldErrorMode or SEM_FAILCRITICALERRORS); Log(lcDebug, FLib.DllFile + ' v' + DecodeApiString(FLib.mysql_get_client_info) + ' loaded.');
LibMysqlHandle := LoadLibrary(PWideChar(TryLibraryPath)); Break;
SetErrorMode(OldErrorMode); except
if LibMysqlHandle = 0 then begin
// Win XP needs libmysql.dll // Win XP needs libmysql.dll
Log(lcDebug, f_('Could not load %s', [TryLibraryPath])); Log(lcDebug, f_('Could not load %s', [TryLibraryPath]));
end else begin end
LibMysqlPath := TryLibraryPath;
Break;
end; end;
end; if not Assigned(FLib) then begin
if LibMysqlHandle = 0 then begin
msg := f_('Cannot find a usable %s. Please launch %s from the directory where you have installed it.', msg := f_('Cannot find a usable %s. Please launch %s from the directory where you have installed it.',
[ExtractFileName(TryLibraryPaths[0]), ExtractFileName(ParamStr(0))] [ExtractFileName(TryLibraryPaths[0]), ExtractFileName(ParamStr(0))]
); );
if Windows.GetLastError <> 0 then if Windows.GetLastError <> 0 then
msg := msg + CRLF + CRLF + f_('Internal error %d:', [Windows.GetLastError]) + ' ' + SysErrorMessage(Windows.GetLastError); msg := msg + CRLF + CRLF + f_('Internal error %d:', [Windows.GetLastError]) + ' ' + SysErrorMessage(Windows.GetLastError);
raise EDatabaseError.Create(msg); raise EDatabaseError.Create(msg);
end
else begin
AssignProc(@mysql_affected_rows, 'mysql_affected_rows');
AssignProc(@mysql_character_set_name, 'mysql_character_set_name');
AssignProc(@mysql_close, 'mysql_close');
AssignProc(@mysql_data_seek, 'mysql_data_seek');
AssignProc(@mysql_errno, 'mysql_errno');
AssignProc(@mysql_error, 'mysql_error');
AssignProc(@mysql_fetch_field_direct, 'mysql_fetch_field_direct');
AssignProc(@mysql_fetch_lengths, 'mysql_fetch_lengths');
AssignProc(@mysql_fetch_row, 'mysql_fetch_row');
AssignProc(@mysql_free_result, 'mysql_free_result');
AssignProc(@mysql_get_client_info, 'mysql_get_client_info');
AssignProc(@mysql_get_server_info, 'mysql_get_server_info');
AssignProc(@mysql_init, 'mysql_init');
AssignProc(@mysql_num_fields, 'mysql_num_fields');
AssignProc(@mysql_num_rows, 'mysql_num_rows');
AssignProc(@mysql_ping, 'mysql_ping');
AssignProc(@mysql_options, 'mysql_options');
AssignProc(@mysql_real_connect, 'mysql_real_connect');
AssignProc(@mysql_real_query, 'mysql_real_query');
AssignProc(@mysql_ssl_set, 'mysql_ssl_set');
AssignProc(@mysql_stat, 'mysql_stat');
AssignProc(@mysql_store_result, 'mysql_store_result');
AssignProc(@mysql_thread_id, 'mysql_thread_id');
AssignProc(@mysql_next_result, 'mysql_next_result');
AssignProc(@mysql_set_character_set, 'mysql_set_character_set');
AssignProc(@mysql_thread_init, 'mysql_thread_init');
AssignProc(@mysql_thread_end, 'mysql_thread_end');
AssignProc(@mysql_warning_count, 'mysql_warning_count');
Log(lcDebug, LibMysqlPath + ' v' + DecodeApiString(mysql_get_client_info) + ' loaded.');
end;
end; end;
inherited; inherited;
end; end;
@ -2503,7 +2420,7 @@ begin
Log(lcDebug, 'Ping server ...'); Log(lcDebug, 'Ping server ...');
IsDead := True; IsDead := True;
try try
IsDead := (FHandle=nil) or (mysql_ping(FHandle) <> 0); IsDead := (FHandle=nil) or (FLib.mysql_ping(FHandle) <> 0);
except except
// silence dumb exceptions from mysql_ping // silence dumb exceptions from mysql_ping
on E:Exception do on E:Exception do
@ -2615,7 +2532,7 @@ begin
SetLength(FLastRawResults, 0); SetLength(FLastRawResults, 0);
FResultCount := 0; FResultCount := 0;
FStatementNum := 1; FStatementNum := 1;
QueryStatus := mysql_real_query(FHandle, PAnsiChar(NativeSQL), Length(NativeSQL)); QueryStatus := FLib.mysql_real_query(FHandle, PAnsiChar(NativeSQL), Length(NativeSQL));
FLastQueryDuration := GetTickCount - TimerStart; FLastQueryDuration := GetTickCount - TimerStart;
FLastQueryNetworkDuration := 0; FLastQueryNetworkDuration := 0;
if QueryStatus <> 0 then begin if QueryStatus <> 0 then begin
@ -2626,13 +2543,13 @@ begin
// We must call mysql_store_result() + mysql_free_result() to unblock the connection // We must call mysql_store_result() + mysql_free_result() to unblock the connection
// See: http://dev.mysql.com/doc/refman/5.0/en/mysql-store-result.html // See: http://dev.mysql.com/doc/refman/5.0/en/mysql-store-result.html
FRowsAffected := 0; FRowsAffected := 0;
FWarningCount := mysql_warning_count(FHandle); FWarningCount := FLib.mysql_warning_count(FHandle);
FRowsFound := 0; FRowsFound := 0;
TimerStart := GetTickCount; TimerStart := GetTickCount;
QueryResult := mysql_store_result(FHandle); QueryResult := FLib.mysql_store_result(FHandle);
FLastQueryNetworkDuration := GetTickCount - TimerStart; FLastQueryNetworkDuration := GetTickCount - TimerStart;
if (QueryResult = nil) and (mysql_affected_rows(FHandle) = -1) then begin if (QueryResult = nil) and (FLib.mysql_affected_rows(FHandle) = -1) then begin
// Indicates a late error, e.g. triggered by mysql_store_result(), after selecting a stored // Indicates a late error, e.g. triggered by mysql_store_result(), after selecting a stored
// function with invalid SQL body. Also SHOW TABLE STATUS on older servers. // function with invalid SQL body. Also SHOW TABLE STATUS on older servers.
// See http://dev.mysql.com/doc/refman/5.0/en/mysql-affected-rows.html // See http://dev.mysql.com/doc/refman/5.0/en/mysql-affected-rows.html
@ -2651,22 +2568,22 @@ begin
while QueryStatus=0 do begin while QueryStatus=0 do begin
if QueryResult <> nil then begin if QueryResult <> nil then begin
// Statement returned a result set // Statement returned a result set
Inc(FRowsFound, mysql_num_rows(QueryResult)); Inc(FRowsFound, FLib.mysql_num_rows(QueryResult));
if DoStoreResult then begin if DoStoreResult then begin
SetLength(FLastRawResults, Length(FLastRawResults)+1); SetLength(FLastRawResults, Length(FLastRawResults)+1);
FLastRawResults[Length(FLastRawResults)-1] := QueryResult; FLastRawResults[Length(FLastRawResults)-1] := QueryResult;
end else begin end else begin
mysql_free_result(QueryResult); FLib.mysql_free_result(QueryResult);
end; end;
end else begin end else begin
// No result, but probably affected rows // No result, but probably affected rows
Inc(FRowsAffected, mysql_affected_rows(FHandle)); Inc(FRowsAffected, FLib.mysql_affected_rows(FHandle));
end; end;
// more results? -1 = no, >0 = error, 0 = yes (keep looping) // more results? -1 = no, >0 = error, 0 = yes (keep looping)
Inc(FStatementNum); Inc(FStatementNum);
QueryStatus := mysql_next_result(FHandle); QueryStatus := FLib.mysql_next_result(FHandle);
if QueryStatus = 0 then if QueryStatus = 0 then
QueryResult := mysql_store_result(FHandle) QueryResult := FLib.mysql_store_result(FHandle)
else if QueryStatus > 0 then begin else if QueryStatus > 0 then begin
// MySQL stops executing a multi-query when an error occurs. So do we here by raising an exception. // MySQL stops executing a multi-query when an error occurs. So do we here by raising an exception.
SetLength(FLastRawResults, 0); SetLength(FLastRawResults, 0);
@ -2826,8 +2743,7 @@ var
begin begin
Result := TDBQueryList.Create(False); Result := TDBQueryList.Create(False);
for i:=Low(FLastRawResults) to High(FLastRawResults) do begin for i:=Low(FLastRawResults) to High(FLastRawResults) do begin
r := Parameters.CreateQuery(nil); r := Parameters.CreateQuery(Self);
r.Connection := Self;
r.SQL := FLastQuerySQL; r.SQL := FLastQuerySQL;
r.Execute(False, i); r.Execute(False, i);
Result.Add(r); Result.Add(r);
@ -2845,8 +2761,7 @@ begin
Batch := TSQLBatch.Create; Batch := TSQLBatch.Create;
Batch.SQL := FLastQuerySQL; Batch.SQL := FLastQuerySQL;
for i:=Low(FLastRawResults) to High(FLastRawResults) do begin for i:=Low(FLastRawResults) to High(FLastRawResults) do begin
r := Parameters.CreateQuery(nil); r := Parameters.CreateQuery(Self);
r.Connection := Self;
if Batch.Count > i then if Batch.Count > i then
r.SQL := Batch[i].SQL r.SQL := Batch[i].SQL
else // See http://www.heidisql.com/forum.php?t=21036 else // See http://www.heidisql.com/forum.php?t=21036
@ -2865,8 +2780,7 @@ var
begin begin
Result := TDBQueryList.Create(False); Result := TDBQueryList.Create(False);
for i:=Low(FLastRawResults) to High(FLastRawResults) do begin for i:=Low(FLastRawResults) to High(FLastRawResults) do begin
r := Parameters.CreateQuery(nil); r := Parameters.CreateQuery(Self);
r.Connection := Self;
r.SQL := FLastQuerySQL; r.SQL := FLastQuerySQL;
r.Execute(False, i); r.Execute(False, i);
Result.Add(r); Result.Add(r);
@ -3412,7 +3326,7 @@ end;
function TMySQLConnection.GetCharacterSet: String; function TMySQLConnection.GetCharacterSet: String;
begin begin
Result := inherited; Result := inherited;
Result := DecodeAPIString(mysql_character_set_name(FHandle)); Result := DecodeAPIString(FLib.mysql_character_set_name(FHandle));
end; end;
@ -3424,7 +3338,7 @@ var
Return: Integer; Return: Integer;
begin begin
FStatementNum := 0; FStatementNum := 0;
Return := mysql_set_character_set(FHandle, PAnsiChar(Utf8Encode(CharsetName))); Return := FLib.mysql_set_character_set(FHandle, PAnsiChar(Utf8Encode(CharsetName)));
if Return <> 0 then if Return <> 0 then
raise EDatabaseError.Create(LastErrorMsg) raise EDatabaseError.Create(LastErrorMsg)
else else
@ -3447,7 +3361,7 @@ end;
function TMySQLConnection.GetLastErrorCode: Cardinal; function TMySQLConnection.GetLastErrorCode: Cardinal;
begin begin
Result := mysql_errno(FHandle); Result := FLib.mysql_errno(FHandle);
end; end;
@ -3476,7 +3390,7 @@ var
rx: TRegExpr; rx: TRegExpr;
begin begin
Result := ''; Result := '';
Msg := DecodeAPIString(mysql_error(FHandle)); Msg := DecodeAPIString(FLib.mysql_error(FHandle));
// Find "(errno: 123)" in message and add more meaningful message from perror.exe // Find "(errno: 123)" in message and add more meaningful message from perror.exe
rx := TRegExpr.Create; rx := TRegExpr.Create;
rx.Expression := '.+\(errno\:\s+(\d+)\)'; rx.Expression := '.+\(errno\:\s+(\d+)\)';
@ -3716,7 +3630,6 @@ begin
// Fire query // Fire query
if Result = nil then begin if Result = nil then begin
Result := Parameters.CreateQuery(Self); Result := Parameters.CreateQuery(Self);
Result.Connection := Self;
Result.SQL := SQL; Result.SQL := SQL;
try try
Result.Execute; Result.Execute;
@ -5080,7 +4993,7 @@ end;
function TDBConnection.ConnectionInfo: TStringList; function TDBConnection.ConnectionInfo: TStringList;
var var
Infos, Val, v, ConnectionString: String; v, ConnectionString: String;
major, minor, build: Integer; major, minor, build: Integer;
rx: TRegExpr; rx: TRegExpr;
@ -5108,25 +5021,6 @@ begin
if Assigned(FSessionVariables) then if Assigned(FSessionVariables) then
Result.Values['max_allowed_packet'] := FormatByteNumber(MaxAllowedPacket); Result.Values['max_allowed_packet'] := FormatByteNumber(MaxAllowedPacket);
case Parameters.NetTypeGroup of case Parameters.NetTypeGroup of
ngMySQL: begin
Result.Values[f_('Client version (%s)', [LibMysqlPath])] := DecodeApiString(mysql_get_client_info);
Infos := DecodeApiString(mysql_stat((Self as TMySQLConnection).FHandle));
rx := TRegExpr.Create;
rx.ModifierG := False;
rx.Expression := '(\S.*)\:\s+(\S*)(\s+|$)';
if rx.Exec(Infos) then while True do begin
Val := rx.Match[2];
if LowerCase(rx.Match[1]) = 'uptime' then
Val := FormatTimeNumber(StrToFloatDef(Val, 0), True)
else
Val := FormatNumber(Val);
Result.Values[_(rx.Match[1])] := Val;
if not rx.ExecNext then
break;
end;
rx.Free;
end;
ngMSSQL: begin ngMSSQL: begin
// clear out password // clear out password
ConnectionString := TAdoDBConnection(Self).FAdoHandle.ConnectionString; ConnectionString := TAdoDBConnection(Self).FAdoHandle.ConnectionString;
@ -5149,6 +5043,31 @@ begin
end; end;
end; end;
function TMySQLConnection.ConnectionInfo: TStringList;
var
Infos, Val: String;
rx: TRegExpr;
begin
Result := Inherited;
Result.Values[f_('Client version (%s)', [FLib.DllFile])] := DecodeApiString(FLib.mysql_get_client_info);
Infos := DecodeApiString(FLib.mysql_stat(FHandle));
rx := TRegExpr.Create;
rx.ModifierG := False;
rx.Expression := '(\S.*)\:\s+(\S*)(\s+|$)';
if rx.Exec(Infos) then while True do begin
Val := rx.Match[2];
if LowerCase(rx.Match[1]) = 'uptime' then
Val := FormatTimeNumber(StrToFloatDef(Val, 0), True)
else
Val := FormatNumber(Val);
Result.Values[_(rx.Match[1])] := Val;
if not rx.ExecNext then
break;
end;
rx.Free;
end;
procedure TDBConnection.ParseTableStructure(CreateTable: String; Columns: TTableColumnList; Keys: TTableKeyList; ForeignKeys: TForeignKeyList); procedure TDBConnection.ParseTableStructure(CreateTable: String; Columns: TTableColumnList; Keys: TTableKeyList; ForeignKeys: TForeignKeyList);
var var
@ -5669,6 +5588,7 @@ end;
constructor TDBQuery.Create(AOwner: TComponent); constructor TDBQuery.Create(AOwner: TComponent);
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FConnection := AOwner as TDbConnection;
FRecNo := -1; FRecNo := -1;
FRecordCount := 0; FRecordCount := 0;
FColumnNames := TStringList.Create; FColumnNames := TStringList.Create;
@ -5681,6 +5601,13 @@ begin
end; end;
constructor TMySQLQuery.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FConnection := AOwner as TMySQLConnection;
end;
destructor TDBQuery.Destroy; destructor TDBQuery.Destroy;
begin begin
FreeAndNil(FColumnNames); FreeAndNil(FColumnNames);
@ -5704,7 +5631,7 @@ var
i: Integer; i: Integer;
begin begin
if HasResult then for i:=Low(FResultList) to High(FResultList) do if HasResult then for i:=Low(FResultList) to High(FResultList) do
mysql_free_result(FResultList[i]); FConnection.Lib.mysql_free_result(FResultList[i]);
SetLength(FResultList, 0); SetLength(FResultList, 0);
inherited; inherited;
end; end;
@ -5757,7 +5684,7 @@ begin
NumResults := Length(FResultList)+1 NumResults := Length(FResultList)+1
else begin else begin
for i:=Low(FResultList) to High(FResultList) do for i:=Low(FResultList) to High(FResultList) do
mysql_free_result(FResultList[i]); FConnection.Lib.mysql_free_result(FResultList[i]);
NumResults := 1; NumResults := 1;
FRecordCount := 0; FRecordCount := 0;
FAutoIncrementColumn := -1; FAutoIncrementColumn := -1;
@ -5773,14 +5700,14 @@ begin
if HasResult then begin if HasResult then begin
// FCurrentResults is normally done in SetRecNo, but never if result has no rows // FCurrentResults is normally done in SetRecNo, but never if result has no rows
FCurrentResults := LastResult; FCurrentResults := LastResult;
NumFields := mysql_num_fields(LastResult); NumFields := FConnection.Lib.mysql_num_fields(LastResult);
SetLength(FColumnTypes, NumFields); SetLength(FColumnTypes, NumFields);
SetLength(FColumnLengths, NumFields); SetLength(FColumnLengths, NumFields);
SetLength(FColumnFlags, NumFields); SetLength(FColumnFlags, NumFields);
FColumnNames.Clear; FColumnNames.Clear;
FColumnOrgNames.Clear; FColumnOrgNames.Clear;
for i:=0 to NumFields-1 do begin for i:=0 to NumFields-1 do begin
Field := mysql_fetch_field_direct(LastResult, i); Field := FConnection.Lib.mysql_fetch_field_direct(LastResult, i);
FColumnNames.Add(Connection.DecodeAPIString(Field.name)); FColumnNames.Add(Connection.DecodeAPIString(Field.name));
if Connection.ServerVersionInt >= 40100 then if Connection.ServerVersionInt >= 40100 then
FColumnOrgNames.Add(Connection.DecodeAPIString(Field.org_name)) FColumnOrgNames.Add(Connection.DecodeAPIString(Field.org_name))
@ -6069,11 +5996,11 @@ begin
// Do not seek if FCurrentRow points to the previous row of the wanted row // Do not seek if FCurrentRow points to the previous row of the wanted row
WantedLocalRecNo := FCurrentResults.row_count-(NumRows-Value); WantedLocalRecNo := FCurrentResults.row_count-(NumRows-Value);
if (WantedLocalRecNo = 0) or (FRecNo+1 <> Value) or (FCurrentRow = nil) then if (WantedLocalRecNo = 0) or (FRecNo+1 <> Value) or (FCurrentRow = nil) then
mysql_data_seek(FCurrentResults, WantedLocalRecNo); FConnection.Lib.mysql_data_seek(FCurrentResults, WantedLocalRecNo);
FCurrentRow := mysql_fetch_row(FCurrentResults); FCurrentRow := FConnection.Lib.mysql_fetch_row(FCurrentResults);
FCurrentUpdateRow := nil; FCurrentUpdateRow := nil;
// Remember length of column contents. Important for Col() so contents of cells with #0 chars are not cut off // Remember length of column contents. Important for Col() so contents of cells with #0 chars are not cut off
LengthPointer := mysql_fetch_lengths(FCurrentResults); LengthPointer := FConnection.Lib.mysql_fetch_lengths(FCurrentResults);
for j:=Low(FColumnLengths) to High(FColumnLengths) do for j:=Low(FColumnLengths) to High(FColumnLengths) do
FColumnLengths[j] := PInteger(Integer(LengthPointer) + j * SizeOf(Integer))^; FColumnLengths[j] := PInteger(Integer(LengthPointer) + j * SizeOf(Integer))^;
break; break;
@ -6261,7 +6188,7 @@ begin
Result := Connection.DecodeAPIString(AnsiStr); Result := Connection.DecodeAPIString(AnsiStr);
// Create string bitmask for BIT fields // Create string bitmask for BIT fields
if Datatype(Column).Index = dtBit then begin if Datatype(Column).Index = dtBit then begin
Field := mysql_fetch_field_direct(FCurrentResults, column); Field := FConnection.Lib.mysql_fetch_field_direct(FCurrentResults, column);
// FConnection.Log(lcInfo, Field.name+': def: '+field.def+' length: '+inttostr(field.length)+' max_length: '+inttostr(field.max_length)+' decimals: '+inttostr(field.decimals)); // FConnection.Log(lcInfo, Field.name+': def: '+field.def+' length: '+inttostr(field.length)+' max_length: '+inttostr(field.max_length)+' decimals: '+inttostr(field.decimals));
for c in Result do begin for c in Result do begin
ByteVal := Byte(c); ByteVal := Byte(c);
@ -7028,7 +6955,7 @@ begin
// Return first available Field.db property, or just the current database as fallback. // Return first available Field.db property, or just the current database as fallback.
// For a view in db1 selecting from db2, this returns db2, which triggers errors in GetCreateViewCode! // For a view in db1 selecting from db2, this returns db2, which triggers errors in GetCreateViewCode!
for i:=0 to ColumnCount-1 do begin for i:=0 to ColumnCount-1 do begin
Field := mysql_fetch_field_direct(FCurrentResults, i); Field := FConnection.Lib.mysql_fetch_field_direct(FCurrentResults, i);
if Field.db <> '' then begin if Field.db <> '' then begin
Result := Connection.DecodeAPIString(Field.db); Result := Connection.DecodeAPIString(Field.db);
break; break;
@ -7064,7 +6991,7 @@ var
begin begin
IsView := False; IsView := False;
for i:=0 to ColumnCount-1 do begin for i:=0 to ColumnCount-1 do begin
Field := mysql_fetch_field_direct(FCurrentResults, i); Field := FConnection.Lib.mysql_fetch_field_direct(FCurrentResults, i);
if Connection.DecodeAPIString(Field.table) <> Connection.DecodeAPIString(Field.org_table) then begin if Connection.DecodeAPIString(Field.table) <> Connection.DecodeAPIString(Field.org_table) then begin
// Probably a VIEW, in which case we rely on the first column's table name. // Probably a VIEW, in which case we rely on the first column's table name.
@ -7790,16 +7717,5 @@ begin
end; end;
initialization
finalization
// Release libmysql.dll handle
if LibMysqlHandle <> 0 then begin
FreeLibrary(LibMysqlHandle);
LibMysqlHandle := 0;
end;
end. end.

3
source/main.pas
View File

@ -5246,9 +5246,8 @@ begin
// Result object must be of the right vendor type // Result object must be of the right vendor type
if not RefreshingData then begin if not RefreshingData then begin
FreeAndNil(DataGridResult); FreeAndNil(DataGridResult);
DataGridResult := DBObj.Connection.Parameters.CreateQuery(Self); DataGridResult := DBObj.Connection.Parameters.CreateQuery(DBObj.Connection);
end; end;
DataGridResult.Connection := DBObj.Connection;
DataGridResult.DBObject := DBObj; DataGridResult.DBObject := DBObj;
DataGridResult.SQL := Trim(Select); DataGridResult.SQL := Trim(Select);
DataGridResult.Execute(Offset > 0); DataGridResult.Execute(Offset > 0);

127
source/mysql_structures.pas
View File

@ -2,12 +2,13 @@
// ------------------------------------- // -------------------------------------
// MySQL Constants, Variables and Types // MySQL Constants, Variables and Types
// TODO: rename to dbstructures
// ------------------------------------- // -------------------------------------
interface interface
uses uses
Classes, Graphics, Windows, SysUtils, gnugettext; Classes, Graphics, Windows, SysUtils, gnugettext, Vcl.Forms;
{$I const.inc} {$I const.inc}
@ -310,6 +311,52 @@ type
EnumValues: String; EnumValues: String;
end; end;
// DLL loading
TDbLib = class(TObject)
private
FDllFile: String;
FHandle: HMODULE;
procedure AssignProc(var Proc: FARPROC; Name: PAnsiChar; Mandantory: Boolean=True);
procedure AssignProcedures; virtual; abstract;
public
property Handle: HMODULE read FHandle;
property DllFile: String read FDllFile;
constructor Create(DllFile: String);
destructor Destroy; override;
end;
TMySQLLib = class(TDbLib)
mysql_affected_rows: function(Handle: PMYSQL): Int64; stdcall;
mysql_character_set_name: function(Handle: PMYSQL): PAnsiChar; stdcall;
mysql_close: procedure(Handle: PMYSQL); stdcall;
mysql_data_seek: procedure(Result: PMYSQL_RES; Offset: Int64); stdcall;
mysql_errno: function(Handle: PMYSQL): Cardinal; stdcall;
mysql_error: function(Handle: PMYSQL): PAnsiChar; stdcall;
mysql_fetch_field_direct: function(Result: PMYSQL_RES; FieldNo: Cardinal): PMYSQL_FIELD; stdcall;
mysql_fetch_lengths: function(Result: PMYSQL_RES): PLongInt; stdcall;
mysql_fetch_row: function(Result: PMYSQL_RES): PMYSQL_ROW; stdcall;
mysql_free_result: procedure(Result: PMYSQL_RES); stdcall;
mysql_get_client_info: function: PAnsiChar; stdcall;
mysql_get_server_info: function(Handle: PMYSQL): PAnsiChar; stdcall;
mysql_init: function(Handle: PMYSQL): PMYSQL; stdcall;
mysql_num_fields: function(Result: PMYSQL_RES): Integer; stdcall;
mysql_num_rows: function(Result: PMYSQL_RES): Int64; stdcall;
mysql_options: function(Handle: PMYSQL; Option: Integer; arg: PAnsiChar): Integer; stdcall;
mysql_ping: function(Handle: PMYSQL): Integer; stdcall;
mysql_real_connect: function(Handle: PMYSQL; const Host, User, Passwd, Db: PAnsiChar; Port: Cardinal; const UnixSocket: PAnsiChar; ClientFlag: Cardinal): PMYSQL; stdcall;
mysql_real_query: function(Handle: PMYSQL; const Query: PAnsiChar; Length: Cardinal): Integer; stdcall;
mysql_ssl_set: function(Handle: PMYSQL; const key, cert, CA, CApath, cipher: PAnsiChar): Byte; stdcall;
mysql_stat: function(Handle: PMYSQL): PAnsiChar; stdcall;
mysql_store_result: function(Handle: PMYSQL): PMYSQL_RES; stdcall;
mysql_thread_id: function(Handle: PMYSQL): Cardinal; stdcall;
mysql_next_result: function(Handle: PMYSQL): Integer; stdcall;
mysql_set_character_set: function(Handle: PMYSQL; csname: PAnsiChar): Integer; stdcall;
mysql_thread_init: function: Byte; stdcall;
mysql_thread_end: procedure; stdcall;
mysql_warning_count: function(Handle: PMYSQL): Cardinal; stdcall;
private
procedure AssignProcedures; override;
end;
var var
MySQLKeywords: TStringList; MySQLKeywords: TStringList;
MySQLErrorCodes: TStringList; MySQLErrorCodes: TStringList;
@ -7564,6 +7611,84 @@ begin
end; end;
constructor TDbLib.Create(DllFile: String);
var
OldErrorMode: Cardinal;
begin
// Load DLL as is (with or without path)
inherited Create;
FDllFile := DllFile;
// Temporarily suppress error popups while loading new library on Windows XP, see #79
OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
SetErrorMode(OldErrorMode or SEM_FAILCRITICALERRORS);
FHandle := LoadLibrary(PWideChar(FDllFile));
SetErrorMode(OldErrorMode);
if FHandle = 0 then begin
Raise Exception.Create('Library file could not be loaded: '+DllFile);
end;
// Dll was loaded, now initialize required procedures
AssignProcedures;
end;
destructor TDbLib.Destroy;
begin
if FHandle <> 0 then begin
FreeLibrary(FHandle);
FHandle := 0;
end;
inherited;
end;
procedure TDbLib.AssignProc(var Proc: FARPROC; Name: PAnsiChar; Mandantory: Boolean=True);
begin
// Map library procedure to internal procedure
Proc := GetProcAddress(FHandle, Name);
if Proc = nil then begin
if Mandantory then begin
Raise Exception.Create(f_('Your %s is out-dated or somehow incompatible to %s. Please use the one from the installer, or just reinstall %s.',
[FDllFile, APPNAME, APPNAME])
);
end;
end;
end;
procedure TMySQLLib.AssignProcedures;
begin
AssignProc(@mysql_affected_rows, 'mysql_affected_rows');
AssignProc(@mysql_character_set_name, 'mysql_character_set_name');
AssignProc(@mysql_close, 'mysql_close');
AssignProc(@mysql_data_seek, 'mysql_data_seek');
AssignProc(@mysql_errno, 'mysql_errno');
AssignProc(@mysql_error, 'mysql_error');
AssignProc(@mysql_fetch_field_direct, 'mysql_fetch_field_direct');
AssignProc(@mysql_fetch_lengths, 'mysql_fetch_lengths');
AssignProc(@mysql_fetch_row, 'mysql_fetch_row');
AssignProc(@mysql_free_result, 'mysql_free_result');
AssignProc(@mysql_get_client_info, 'mysql_get_client_info');
AssignProc(@mysql_get_server_info, 'mysql_get_server_info');
AssignProc(@mysql_init, 'mysql_init');
AssignProc(@mysql_num_fields, 'mysql_num_fields');
AssignProc(@mysql_num_rows, 'mysql_num_rows');
AssignProc(@mysql_ping, 'mysql_ping');
AssignProc(@mysql_options, 'mysql_options');
AssignProc(@mysql_real_connect, 'mysql_real_connect');
AssignProc(@mysql_real_query, 'mysql_real_query');
AssignProc(@mysql_ssl_set, 'mysql_ssl_set');
AssignProc(@mysql_stat, 'mysql_stat');
AssignProc(@mysql_store_result, 'mysql_store_result');
AssignProc(@mysql_thread_id, 'mysql_thread_id');
AssignProc(@mysql_next_result, 'mysql_next_result');
AssignProc(@mysql_set_character_set, 'mysql_set_character_set');
AssignProc(@mysql_thread_init, 'mysql_thread_init');
AssignProc(@mysql_thread_end, 'mysql_thread_end');
AssignProc(@mysql_warning_count, 'mysql_warning_count');
end;
initialization initialization
// Keywords copied from SynHighligherSQL // Keywords copied from SynHighligherSQL