sdmysql.pas

SQLDirect Component Library is a light-weight Borland Database Engine replacement for Borland Delphi

[DllImport(DefSqlApiDLL, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'mysql_real_escape_string')]
function mysql_real_escape_string(mysql: PMYSQL; szTo: TSDCharPtr; const szFrom: TSDCharPtr; length: LongInt): LongInt; external;
[DllImport(DefSqlApiDLL, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'mysql_debug')]
procedure mysql_debug(const debug: TSDCharPtr); external;
[DllImport(DefSqlApiDLL, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'myodbc_remove_escape')]
procedure myodbc_remove_escape(mysql: PMYSQL; name: TSDCharPtr); external;
[DllImport(DefSqlApiDLL, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'mysql_thread_safe')]
function mysql_thread_safe: Integer; external;
[DllImport(DefSqlApiDLL, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'mysql_server_init')]
function mysql_server_init(argc: Integer; argv, groups: TSDPtr): Integer; external;
[DllImport(DefSqlApiDLL, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'mysql_server_end')]
procedure mysql_server_end; external;
[DllImport(DefSqlApiDLL, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'mysql_thread_init')]
function mysql_thread_init: TMyBool; external;
[DllImport(DefSqlApiDLL, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'mysql_thread_end')]
procedure mysql_thread_end; external;
{$ENDIF}

implementation

resourcestring
  SErrLibLoading 	= 'Error loading library ''%s''';
  SErrLibUnloading	= 'Error unloading library ''%s''';
  SErrFuncNotFound	= 'Function ''%s'' not found in MySQL library';

const
  SQueryMySqlStoredProcNamesFmt = '';
  SQueryMySqlTableNames = 'SHOW TABLES';
  SQueryMySqlTableFieldNamesFmt = 'SHOW COLUMNS FROM %s';
  SQueryMySqlIndexNamesFmt = 'SHOW INDEX FROM %s';

  IdentNameLen	= 50;

var
  hSqlLibModule: THandle;
  SqlLibRefCount: Integer;
  SqlLibLock: TCriticalSection;

function InitSqlDatabase(ADbParams: TStrings): TISqlDatabase;
var
  s: string;
begin
  if hSqlLibModule = 0 then begin
    s := Trim( ADbParams.Values[GetSqlLibParamName( Ord(istMySQL) )] );
    if s <> '' then
      SqlApiDLL := s;
  end;

  Result := TIMyDatabase.Create( ADbParams );
end;

function IsAvailFunc(AName: string): Boolean;
begin
  Result := Assigned( GetProcAddress(hSqlLibModule, {$IFDEF SD_CLR}AName{$ELSE}PChar(AName){$ENDIF}) );
end;

(*******************************************************************************
			Load/Unload Sql-library
********************************************************************************)
procedure SetProcAddresses;
begin
{$IFNDEF SD_CLR}
  @mysql_num_rows		:= GetProcAddress(hSqlLibModule, 'mysql_num_rows');  		ASSERT( @mysql_num_rows		<>nil, Format(SErrFuncNotFound, ['mysql_num_rows']) );
  @mysql_num_fields		:= GetProcAddress(hSqlLibModule, 'mysql_num_fields');  		ASSERT( @mysql_num_fields	<>nil, Format(SErrFuncNotFound, ['mysql_num_fields']) );
  @mysql_eof			:= GetProcAddress(hSqlLibModule, 'mysql_eof');  		ASSERT( @mysql_eof	    	<>nil, Format(SErrFuncNotFound, ['mysql_eof']) );
  @mysql_fetch_field_direct	:= GetProcAddress(hSqlLibModule, 'mysql_fetch_field_direct');  	ASSERT( @mysql_fetch_field_direct<>nil, Format(SErrFuncNotFound,['mysql_fetch_field_direct']) );
  @mysql_fetch_fields		:= GetProcAddress(hSqlLibModule, 'mysql_fetch_fields');  	ASSERT( @mysql_fetch_fields   	<>nil, Format(SErrFuncNotFound, ['mysql_fetch_fields']) );
  @mysql_row_tell		:= GetProcAddress(hSqlLibModule, 'mysql_row_tell');  		ASSERT( @mysql_row_tell	       	<>nil, Format(SErrFuncNotFound, ['mysql_row_tell']) );
  @mysql_field_tell		:= GetProcAddress(hSqlLibModule, 'mysql_field_tell');  		ASSERT( @mysql_field_tell	<>nil, Format(SErrFuncNotFound, ['mysql_field_tell']) );
  @mysql_field_count		:= GetProcAddress(hSqlLibModule, 'mysql_field_count');  	ASSERT( @mysql_field_count     	<>nil, Format(SErrFuncNotFound, ['mysql_field_count']) );
  @mysql_affected_rows		:= GetProcAddress(hSqlLibModule, 'mysql_affected_rows');  	ASSERT( @mysql_affected_rows   	<>nil, Format(SErrFuncNotFound, ['mysql_affected_rows']) );
  @mysql_insert_id		:= GetProcAddress(hSqlLibModule, 'mysql_insert_id');  		ASSERT( @mysql_insert_id       	<>nil, Format(SErrFuncNotFound, ['mysql_insert_id']) );
  @mysql_errno			:= GetProcAddress(hSqlLibModule, 'mysql_errno');  		ASSERT( @mysql_errno	       	<>nil, Format(SErrFuncNotFound, ['mysql_errno']) );
  @mysql_error			:= GetProcAddress(hSqlLibModule, 'mysql_error');  		ASSERT( @mysql_error	       	<>nil, Format(SErrFuncNotFound, ['mysql_error']) );
  @mysql_info			:= GetProcAddress(hSqlLibModule, 'mysql_info');  		ASSERT( @mysql_info	       	<>nil, Format(SErrFuncNotFound, ['mysql_info']) );
  @mysql_thread_id		:= GetProcAddress(hSqlLibModule, 'mysql_thread_id');  		ASSERT( @mysql_thread_id       	<>nil, Format(SErrFuncNotFound, ['mysql_thread_id']) );
  @mysql_character_set_name	:= GetProcAddress(hSqlLibModule, 'mysql_character_set_name');
  @mysql_init			:= GetProcAddress(hSqlLibModule, 'mysql_init');  		ASSERT( @mysql_init	      	<>nil, Format(SErrFuncNotFound, ['mysql_init']) );
  @mysql_ssl_set		:= GetProcAddress(hSqlLibModule, 'mysql_ssl_set');
  @mysql_ssl_cipher		:= GetProcAddress(hSqlLibModule, 'mysql_ssl_cipher');
  @mysql_ssl_clear		:= GetProcAddress(hSqlLibModule, 'mysql_ssl_clear');
  @mysql_connect		:= GetProcAddress(hSqlLibModule, 'mysql_connect');  		
  @mysql_change_user		:= GetProcAddress(hSqlLibModule, 'mysql_change_user');
  @mysql_real_connect		:= GetProcAddress(hSqlLibModule, 'mysql_real_connect');  	ASSERT( @mysql_real_connect	<>nil, Format(SErrFuncNotFound, ['mysql_real_connect']) );
  @mysql_close			:= GetProcAddress(hSqlLibModule, 'mysql_close');  		ASSERT( @mysql_close	       	<>nil, Format(SErrFuncNotFound, ['mysql_close']) );
  @mysql_select_db		:= GetProcAddress(hSqlLibModule, 'mysql_select_db');  		ASSERT( @mysql_select_db	<>nil, Format(SErrFuncNotFound, ['mysql_select_db']) );
  @mysql_query			:= GetProcAddress(hSqlLibModule, 'mysql_query');  		ASSERT( @mysql_query		<>nil, Format(SErrFuncNotFound, ['mysql_query']) );
  @mysql_send_query		:= GetProcAddress(hSqlLibModule, 'mysql_send_query');
  @mysql_read_query_result	:= GetProcAddress(hSqlLibModule, 'mysql_read_query_result');
  @mysql_real_query		:= GetProcAddress(hSqlLibModule, 'mysql_real_query');  		ASSERT( @mysql_real_query	<>nil, Format(SErrFuncNotFound, ['mysql_real_query']) );
  @mysql_create_db		:= GetProcAddress(hSqlLibModule, 'mysql_create_db');
  @mysql_drop_db		:= GetProcAddress(hSqlLibModule, 'mysql_drop_db');
  @mysql_shutdown		:= GetProcAddress(hSqlLibModule, 'mysql_shutdown');  		ASSERT( @mysql_shutdown	       	<>nil, Format(SErrFuncNotFound, ['mysql_shutdown']) );
  @mysql_dump_debug_info	:= GetProcAddress(hSqlLibModule, 'mysql_dump_debug_info');  	ASSERT( @mysql_dump_debug_info  <>nil, Format(SErrFuncNotFound, ['mysql_dump_debug_info']) );
  @mysql_refresh		:= GetProcAddress(hSqlLibModule, 'mysql_refresh');  		ASSERT( @mysql_refresh	       	<>nil, Format(SErrFuncNotFound, ['mysql_refresh']) );
  @mysql_kill			:= GetProcAddress(hSqlLibModule, 'mysql_kill');  		ASSERT( @mysql_kill	       	<>nil, Format(SErrFuncNotFound, ['mysql_kill']) );
  @mysql_ping			:= GetProcAddress(hSqlLibModule, 'mysql_ping');  		ASSERT( @mysql_ping	       	<>nil, Format(SErrFuncNotFound, ['mysql_ping']) );
  @mysql_stat			:= GetProcAddress(hSqlLibModule, 'mysql_stat');  		ASSERT( @mysql_stat	       	<>nil, Format(SErrFuncNotFound, ['mysql_stat']) );
  @mysql_get_server_info	:= GetProcAddress(hSqlLibModule, 'mysql_get_server_info');  	ASSERT( @mysql_get_server_info 	<>nil, Format(SErrFuncNotFound, ['mysql_get_server_info']) );
  @mysql_get_client_info	:= GetProcAddress(hSqlLibModule, 'mysql_get_client_info');  	ASSERT( @mysql_get_client_info 	<>nil, Format(SErrFuncNotFound, ['mysql_get_client_info']) );
  @mysql_get_host_info		:= GetProcAddress(hSqlLibModule, 'mysql_get_host_info');  	ASSERT( @mysql_get_host_info   	<>nil, Format(SErrFuncNotFound, ['mysql_get_host_info']) );
  @mysql_get_proto_info		:= GetProcAddress(hSqlLibModule, 'mysql_get_proto_info');  	ASSERT( @mysql_get_proto_info  	<>nil, Format(SErrFuncNotFound, ['mysql_get_proto_info']) );
  @mysql_list_dbs		:= GetProcAddress(hSqlLibModule, 'mysql_list_dbs');  		ASSERT( @mysql_list_dbs	       	<>nil, Format(SErrFuncNotFound, ['mysql_list_dbs']) );
  @mysql_list_tables		:= GetProcAddress(hSqlLibModule, 'mysql_list_tables');  	ASSERT( @mysql_list_tables     	<>nil, Format(SErrFuncNotFound, ['mysql_list_tables']) );
  @mysql_list_fields		:= GetProcAddress(hSqlLibModule, 'mysql_list_fields');  	ASSERT( @mysql_list_fields     	<>nil, Format(SErrFuncNotFound, ['mysql_list_fields']) );
  @mysql_list_processes		:= GetProcAddress(hSqlLibModule, 'mysql_list_processes');  	ASSERT( @mysql_list_processes  	<>nil, Format(SErrFuncNotFound, ['mysql_list_processes']) );
  @mysql_store_result		:= GetProcAddress(hSqlLibModule, 'mysql_store_result');  	ASSERT( @mysql_store_result    	<>nil, Format(SErrFuncNotFound, ['mysql_store_result']) );
  @mysql_use_result		:= GetProcAddress(hSqlLibModule, 'mysql_use_result');  		ASSERT( @mysql_use_result      	<>nil, Format(SErrFuncNotFound, ['mysql_use_result']) );
  @mysql_options		:= GetProcAddress(hSqlLibModule, 'mysql_options');  		ASSERT( @mysql_options	       	<>nil, Format(SErrFuncNotFound, ['mysql_options']) );
  @mysql_free_result		:= GetProcAddress(hSqlLibModule, 'mysql_free_result');  	ASSERT( @mysql_free_result	<>nil, Format(SErrFuncNotFound, ['mysql_free_result']) );
  @mysql_data_seek		:= GetProcAddress(hSqlLibModule, 'mysql_data_seek');  		ASSERT( @mysql_data_seek	<>nil, Format(SErrFuncNotFound, ['mysql_data_seek']) );
  @mysql_row_seek		:= GetProcAddress(hSqlLibModule, 'mysql_row_seek');  		ASSERT( @mysql_row_seek	       	<>nil, Format(SErrFuncNotFound, ['mysql_row_seek']) );
  @mysql_field_seek		:= GetProcAddress(hSqlLibModule, 'mysql_field_seek');  		ASSERT( @mysql_field_seek      	<>nil, Format(SErrFuncNotFound, ['mysql_field_seek']) );
  @mysql_fetch_row		:= GetProcAddress(hSqlLibModule, 'mysql_fetch_row');  		ASSERT( @mysql_fetch_row       	<>nil, Format(SErrFuncNotFound, ['mysql_fetch_row']) );
  @mysql_fetch_lengths		:= GetProcAddress(hSqlLibModule, 'mysql_fetch_lengths');  	ASSERT( @mysql_fetch_lengths   	<>nil, Format(SErrFuncNotFound, ['mysql_fetch_lengths']) );
  @mysql_fetch_field		:= GetProcAddress(hSqlLibModule, 'mysql_fetch_field');  	ASSERT( @mysql_fetch_field     	<>nil, Format(SErrFuncNotFound, ['mysql_fetch_field']) );
  @mysql_escape_string		:= GetProcAddress(hSqlLibModule, 'mysql_escape_string');  	ASSERT( @mysql_escape_string   	<>nil, Format(SErrFuncNotFound, ['mysql_escape_string']) );
  @mysql_real_escape_string    	:= GetProcAddress(hSqlLibModule, 'mysql_real_escape_string');
  @mysql_debug			:= GetProcAddress(hSqlLibModule, 'mysql_debug');  		ASSERT( @mysql_debug	       	<>nil, Format(SErrFuncNotFound, ['mysql_debug']) );
  @myodbc_remove_escape		:= GetProcAddress(hSqlLibModule, 'myodbc_remove_escape');  	ASSERT( @myodbc_remove_escape  	<>nil, Format(SErrFuncNotFound, ['myodbc_remove_escape']) );
  @mysql_thread_safe		:= GetProcAddress(hSqlLibModule, 'mysql_thread_safe');  	ASSERT( @mysql_thread_safe     	<>nil, Format(SErrFuncNotFound, ['mysql_thread_safe']) );

  @mysql_server_init   	 	:= GetProcAddress(hSqlLibModule, 'mysql_server_init');
  @mysql_server_end    		:= GetProcAddress(hSqlLibModule, 'mysql_server_end');
  @mysql_thread_init   		:= GetProcAddress(hSqlLibModule, 'mysql_thread_init');
  @mysql_thread_end    		:= GetProcAddress(hSqlLibModule, 'mysql_thread_end');
{$ENDIF}
end;

procedure ResetProcAddresses;
begin
{$IFNDEF SD_CLR}
  @mysql_num_rows		:= nil;
  @mysql_num_fields		:= nil;
  @mysql_eof			:= nil;
  @mysql_fetch_field_direct	:= nil;
  @mysql_fetch_fields		:= nil;
  @mysql_row_tell		:= nil;
  @mysql_field_tell		:= nil;
  @mysql_field_count		:= nil;
  @mysql_affected_rows		:= nil;
  @mysql_insert_id		:= nil;
  @mysql_errno			:= nil;
  @mysql_error			:= nil;
  @mysql_info			:= nil;
  @mysql_thread_id		:= nil;
  @mysql_character_set_name	:= nil;
  @mysql_init			:= nil;
  @mysql_ssl_set		:= nil;
  @mysql_ssl_cipher		:= nil;
  @mysql_ssl_clear		:= nil;
  @mysql_connect		:= nil;
  @mysql_change_user		:= nil;
  @mysql_real_connect		:= nil;
  @mysql_close			:= nil;
  @mysql_select_db		:= nil;
  @mysql_query			:= nil;
  @mysql_send_query		:= nil;
  @mysql_read_query_result	:= nil;
  @mysql_real_query		:= nil;
  @mysql_create_db		:= nil;
  @mysql_drop_db		:= nil;
  @mysql_shutdown		:= nil;
  @mysql_dump_debug_info	:= nil;
  @mysql_refresh		:= nil;
  @mysql_kill			:= nil;
  @mysql_ping			:= nil;
  @mysql_stat			:= nil;
  @mysql_get_server_info	:= nil;
  @mysql_get_client_info	:= nil;
  @mysql_get_host_info		:= nil;
  @mysql_get_proto_info		:= nil;
  @mysql_list_dbs		:= nil;
  @mysql_list_tables		:= nil;
  @mysql_list_fields		:= nil;
  @mysql_list_processes		:= nil;
  @mysql_store_result		:= nil;
  @mysql_use_result		:= nil;
  @mysql_options		:= nil;
  @mysql_free_result		:= nil;
  @mysql_data_seek		:= nil;
  @mysql_row_seek		:= nil;
  @mysql_field_seek		:= nil;
  @mysql_fetch_row		:= nil;
  @mysql_fetch_lengths		:= nil;
  @mysql_fetch_field		:= nil;
  @mysql_escape_string		:= nil;
  @mysql_real_escape_string    	:= nil;
  @mysql_debug			:= nil;
  @myodbc_remove_escape		:= nil;
  @mysql_thread_safe		:= nil;

  @mysql_server_init   	 	:= nil;
  @mysql_server_end    		:= nil;
  @mysql_thread_init   		:= nil;
  @mysql_thread_end    		:= nil;
{$ENDIF}
end;

procedure LoadSqlLib;
begin
  SqlLibLock.Acquire;
  try
    if (SqlLibRefCount = 0) then begin
      hSqlLibModule := HelperLoadLibrary( SqlApiDLL );
      if (hSqlLibModule = 0) then
        raise ESDSqlLibError.CreateFmt(SErrLibLoading, [ SqlApiDLL ]);
      Inc(SqlLibRefCount);
      SetProcAddresses;
	// It starts up the embedded server and initialises any subsystems
      if IsAvailFunc('mysql_server_init') then begin
        // embedded MySQL 4.0.12 produces "External exception C0000008" in the this call
        mysql_server_init(0, nil, nil);
      end;
    end else
      Inc(SqlLibRefCount);
  finally
    SqlLibLock.Release;
  end;
end;

procedure FreeSqlLib;
begin
  if SqlLibRefCount = 0 then
    Exit;

  SqlLibLock.Acquire;
  try
    if (SqlLibRefCount = 1) then begin
	// It shuts down the embedded server
      if IsAvailFunc('mysql_server_end') then
        mysql_server_end;

      if FreeLibrary(hSqlLibModule) then
        hSqlLibModule := 0
      else
        raise ESDSqlLibError.CreateFmt(SErrLibUnloading, [ SqlApiDLL ]);
      Dec(SqlLibRefCount);
      ResetProcAddresses;
    end else
      Dec(SqlLibRefCount);
  finally
    SqlLibLock.Release;
  end;
end;


{ TIMyDatabase }
constructor TIMyDatabase.Create(ADbParams: TStrings);
begin
  inherited Create(ADbParams);
  FHandle	:= nil;
  FIsClientVer3 := False;
	// by default IsEnableMoney = False
  FIsEnableMoney := UpperCase( Trim( Params.Values[szENABLEMONEY] ) ) = STrueString;
end;

destructor TIMyDatabase.Destroy;
begin
  inherited;
end;

function TIMyDatabase.CreateSqlCommand: TISqlCommand;
begin
  Result := TIMyCommand.Create( Self );
end;

procedure TIMyDatabase.Check(mysql: PMYSQL);
var
  E: ESDMySQLError;
  szErrMsg: TSDCharPtr;
  ErrNo: Integer;
  sMsg: string;
begin
  ResetIdleTimeOut;

  if Assigned( mysql ) then
    Exit;
  ResetBusyState;

  ErrNo := mysql_errno( MySQLPtr );
  szErrMsg := mysql_error( MySQLPtr );
  sMsg := HelperPtrToString(szErrMsg);

  E := ESDMySQLError.Create(ErrNo, ErrNo, sMsg, 0);
  raise E;
end;

function TIMyDatabase.GetAutoIncSQL: string;
begin
  Result := MySql_SelectAutoIncField;	// MySQL 4 returns as largeint (64-bit)
end;

function TIMyDatabase.GetClientVersion: LongInt;
var
  szVer: TSDCharPtr;
begin
  szVer := mysql_get_client_info;
  Result := VersionStringToDWORD( HelperPtrToString(szVer) );
end;

function TIMyDatabase.GetServerVersion: LongInt;
var
  szVer: TSDCharPtr;
begin
  szVer := mysql_get_server_info( MySQLPtr );
  Result := VersionStringToDWORD( HelperPtrToString(szVer) );
end;

function TIMyDatabase.GetVersionString: string;
var
  szSrv, szHost: TSDCharPtr;
begin
  szSrv := mysql_get_server_info( MySQLPtr );
  szHost := mysql_get_host_info( MySQLPtr );
  Result := HelperPtrToString(szSrv) + '/' + HelperPtrToString(szHost);