sdmysql.pas

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

end;

function TIMyDatabase.GetHandle: TSDPtr;
begin
  Result := FHandle;
end;

procedure TIMyDatabase.SetHandle(AHandle: TSDPtr);
{$IFDEF SD_CLR}
var
  r1, r2: TIMyConnInfo;
{$ENDIF}
begin
  LoadSqlLib;

  AllocHandle;

{$IFDEF SD_CLR}
  r1 := TIMyConnInfo( Marshal.PtrToStructure( FHandle, TypeOf(TIMyConnInfo) ) );
  r2 := TIMyConnInfo( Marshal.PtrToStructure( AHandle, TypeOf(TIMyConnInfo) ) );
  r1.MySQLPtr := r2.MySQLPtr;
  Marshal.StructureToPtr( r1, FHandle, False );
{$ELSE}
  TIMyConnInfo(FHandle^).MySQLPtr := TIMyConnInfo(AHandle^).MySQLPtr;
{$ENDIF}
end;

function TIMyDatabase.GetMySQLPtr: PMYSQL;
begin
  ASSERT( Assigned(FHandle), 'TIMyDatabase.GetMySQLPtr' );
{$IFDEF SD_CLR}
  Result := TIMyConnInfo( Marshal.PtrToStructure( FHandle, TypeOf(TIMyConnInfo) ) ).MySQLPtr;
{$ELSE}
  Result := TIMyConnInfo(FHandle^).MySQLPtr;
{$ENDIF}
end;

procedure TIMyDatabase.AllocHandle;
var
  rec: TIMyConnInfo;
begin
  ASSERT( not Assigned(FHandle), 'TIMyDatabase.AllocHandle' );

  FHandle := SafeReallocMem(nil, SizeOf(rec));
  SafeInitMem( FHandle, SizeOf(rec), 0 );

  rec.ServerType := Ord( istMySQL );

{$IFDEF SD_CLR}
  Marshal.StructureToPtr( rec, FHandle, False );
{$ELSE}
  TIMyConnInfo(FHandle^) := rec;
{$ENDIF}
end;

procedure TIMyDatabase.FreeHandle;
begin
  if Assigned(FHandle) then
    FHandle := SafeReallocMem( FHandle, 0 );
end;

procedure TIMyDatabase.DoConnect(const sRemoteDatabase, sUserName, sPassword: string);
var
{$IFDEF SD_CLR}
  rec: TIMyConnInfo;
  ptr: TSDPtr;
{$ENDIF}
  sSrvName, sDbName: string;
  szSrv, szDb, szUseDb, szUser, szPwd: TSDCharPtr;
  IntValue, ConnFlags: Integer;
begin
  LoadSqlLib;

  AllocHandle;

  sSrvName := ExtractServerName(sRemoteDatabase);
  sDbName := ExtractDatabaseName(sRemoteDatabase);
  try
{$IFDEF SD_CLR}
    rec := TIMyConnInfo( Marshal.PtrToStructure( FHandle, TypeOf(TIMyConnInfo) ) );
    rec.MySQLPtr := mysql_init( nil );
    Marshal.StructureToPtr( rec, FHandle, False );
    szSrv := Marshal.StringToHGlobalAnsi( sSrvName );
    szDb  := Marshal.StringToHGlobalAnsi( sDbName );
    szUser:= Marshal.StringToHGlobalAnsi( sUserName );
    szPwd := Marshal.StringToHGlobalAnsi( sPassword );
{$ELSE}
    TIMyConnInfo(FHandle^).MySQLPtr := mysql_init( nil );
    szSrv := TSDCharPtr( sSrvName );
    szDb  := TSDCharPtr( sDbName );
    szUser:= TSDCharPtr( sUserName );
    szPwd := TSDCharPtr( sPassword );
{$ENDIF}
  	// set login timeout before connect
    if Trim( Params.Values[szLOGINTIMEOUT] ) <> '' then begin
      IntValue := StrToIntDef( Trim( Params.Values[szLOGINTIMEOUT] ), 0 );
{$IFDEF SD_CLR}
      ptr := SafeReallocMem(nil, SizeOf(IntValue));
      try
        HelperMemWriteInt32(ptr, 0, IntValue);
        mysql_options( MySQLPtr, MYSQL_OPT_CONNECT_TIMEOUT, ptr);
      finally
        SafeReallocMem(ptr, 0);
      end;
{$ELSE}
      mysql_options( MySQLPtr, MYSQL_OPT_CONNECT_TIMEOUT, @IntValue);
{$ENDIF}
    end;
    	// set compressed protocol if it is not turn off
    if Trim( Params.Values[szCOMPRESSEDPROT] ) <> SFalseString then
      mysql_options( MySQLPtr, MYSQL_OPT_COMPRESS, nil);

	// gets the custom server port
    IntValue := StrToIntDef( Params.Values[szSERVERPORT], 0 );

    if IsAvailFunc('mysql_real_connect') then begin
      ConnFlags := CLIENT_FOUND_ROWS;
      if sDbName <> '' then
        ConnFlags := ConnFlags or CLIENT_CONNECT_WITH_DB;
      Check( mysql_real_connect( MySQLPtr, szSrv, szUser, szPwd, szDb, IntValue, nil, ConnFlags ) )
    end else begin
      ASSERT( IsAvailFunc('mysql_connect') ); // mysql_connect is not supported since MySQL v.4.0.x
      Check( mysql_connect( MySQLPtr, szSrv, szUser, szPwd ) );
      if sDbName <> '' then begin
        sDbName := 'use ' + sDbName;
{$IFDEF SD_CLR}
        szUseDb := Marshal.StringToHGlobalAnsi( sDbName );
{$ELSE}
        szUseDb := TSDCharPtr( sDbName );
{$ENDIF}
        if mysql_query( MySQLPtr, szUseDb ) <> 0 then
          Check( MySQLPtr );
      end;
    end;
  finally
{$IFDEF SD_CLR}
    if Assigned( szSrv ) then
      Marshal.FreeHGlobal( szSrv );
    if Assigned( szDb ) then
      Marshal.FreeHGlobal( szDb );
    if Assigned( szUser ) then
      Marshal.FreeHGlobal( szUser );
    if Assigned( szPwd ) then
      Marshal.FreeHGlobal( szPwd );
    if Assigned( szUseDb ) then
      Marshal.FreeHGlobal( szUseDb );
{$ENDIF}
  end;
  FIsClientVer3 := GetMajorVer( GetClientVersion ) <= 3;

  SetDefaultOptions;
end;

procedure TIMyDatabase.DoDisconnect(Force: Boolean);
{$IFDEF SD_CLR}
var
  rec: TIMyConnInfo;
{$ENDIF}
begin
  if Assigned(FHandle) and Assigned( MySQLPtr ) then begin
    if InTransaction then
      ExecCmd( 'ROLLBACK', False );
    mysql_close( MySQLPtr );
{$IFDEF SD_CLR}
    rec := TIMyConnInfo( Marshal.PtrToStructure( FHandle, TypeOf(TIMyConnInfo) ) );
    rec.MySQLPtr := nil;
    Marshal.StructureToPtr( rec, FHandle, False );
{$ELSE}
    TIMyConnInfo(FHandle^).MySQLPtr := nil;
{$ENDIF}
  end;

  FreeHandle;
  FreeSqlLib;
end;

procedure TIMyDatabase.ExecCmd(const SQL: string; CheckRslt: Boolean);
var
  szCmd: TSDCharPtr;
begin
{$IFDEF SD_CLR}
  szCmd := Marshal.StringToHGlobalAnsi( SQL );
{$ELSE}
  szCmd := TSDCharPtr( SQL );
{$ENDIF}
  try
    if (mysql_query( MySQLPtr, szCmd ) <> 0) and CheckRslt then
      Check( nil );
  finally
{$IFDEF SD_CLR}
    if Assigned( szCmd ) then
      Marshal.FreeHGlobal( szCmd );
{$ENDIF}
  end;
end;

procedure TIMyDatabase.SetAutoCommitOption(Value: Boolean);
begin
end;

procedure TIMyDatabase.SetDefaultOptions;
var
  sValue: string;
begin
  if not AutoCommitDef then begin
    sValue := 'SET AUTOCOMMIT = ';
    if AutoCommit
    then sValue := sValue + '1'
    else sValue := sValue + '0';

    ExecCmd( sValue, True );
  end
end;

procedure TIMyDatabase.DoStartTransaction;
begin
  ExecCmd( 'BEGIN', True );
end;

procedure TIMyDatabase.DoCommit;
begin
  ExecCmd( 'COMMIT', True );
end;

procedure TIMyDatabase.DoRollback;
begin
  ExecCmd( 'ROLLBACK', True );
end;

procedure TIMyDatabase.SetTransIsolation(Value: TISqlTransIsolation);
const
	// there's SERIALIZABLE level also
  TransIsolLevels: array[TISqlTransIsolation] of string = ('READ UNCOMMITTED', 'READ COMMITTED', 'REPEATABLE READ');
begin
  ExecCmd( 'SET SESSION TRANSACTION ISOLATION LEVEL ' + TransIsolLevels[Value], True );
end;

function TIMyDatabase.TestConnected: Boolean;
var
  cmd: TISqlCommand;
begin
  Result := False;
  cmd := GetSchemaInfo(stSysTables, 'DUMMY');
  if Assigned(cmd) then begin
    Result := True;
    cmd.Free;
  end;
end;

function TIMyDatabase.GetSchemaInfo(ASchemaType: TSDSchemaType; AObjectName: string): TISqlCommand;
var
  cmd: TISqlCommand;
begin
  cmd := nil;
  case ASchemaType of
    stTables,
    stSysTables:
      begin
        cmd := TIMyCommandShowTables.Create(Self);
        if AObjectName <> '' then
          TIMyCommandShowTables(cmd).TableNames := AObjectName;
        TIMyCommandShowTables(cmd).IsSysTables := ASchemaType = stSysTables;
      end;
    stColumns:
      begin
        cmd := TIMyCommandShowColumns.Create(Self);
        TIMyCommandShowColumns(cmd).TableName := AObjectName;
      end;
    stIndexes:
      begin
        cmd := TIMyCommandShowIndexes.Create(Self);
        TIMyCommandShowIndexes(cmd).TableName := AObjectName;
      end;
  end;

  if Assigned(cmd) then
  try
    cmd.ExecDirect('');
  except
    cmd.Free;
    raise;
  end;

  Result := cmd;
end;


{ TIMyCommand }
constructor TIMyCommand.Create(ASqlDatabase: TISqlDatabase);
begin
  inherited Create(ASqlDatabase);

  FStmt		:= '';
  FBindStmt	:= '';
  FRowsAffected := -1;
  FAutoIncID    := 0;   // GetAutoIncValue is supported

  FHandle 	:= nil;
  FRow		:= nil;
  FFieldLens	:= nil;
end;

destructor TIMyCommand.Destroy;
begin
  Disconnect(False);

  inherited Destroy;
end;

function TIMyCommand.GetIsOpened: Boolean;
begin
	// FHandle is assigned to a handle of the result set, when it's activated
  Result := Assigned( FHandle );
end;

function TIMyCommand.GetHa