(*
/*
// Allows to work with databases via ODBC connection rather then via ADO.
//
// To use this module:
//
// 1. in compiler options, add the first the path to it earlier then other Delphi
//		modules paths;
// 2. add options /$DEFINE=ODBC,KOL_ODBC
// 3. add directives:
//	/COPY %KOLPATH%\kol.pas
//	/COPY %KOLPATH%\kolodbc.pas
//

CLASS {NATIVE_DB|_Delphi_KOLODBC_to_use_with_VCL}, NATIVE,
ABSTRACT:

FUN Check_blobs_are_supported ==> BOOL,
    UNSUPPORTED('BLOBS are not supported in ODBC version of {DB}') : .

*/
*)

unit NATIVE_DB;
//{$I EXTERNAL_DEFINES.inc}

interface uses Windows, AL4, KOLODBC, SysUtils, Classes;

type

    TExODBCDataBase = class(TODBCDataBase)
        function DSNConnect2(const DSN, User, Pwd: String): Boolean;
    end;
    
    TExODBCQuery = class(TODBCQuery)
        function GetBoolFieldN(N: Integer): Boolean;
    end;

    TNATIVE_DB = class
    public 
        use_DSN: Boolean;
        Connection_string: String;
        S_c: TODBCDataBase;
        Sql: TExODBCQuery;
        User: String;
        destructor Destroy; override;
    end;

function DB_Create_connection(const Connection, User: String;
         Provider_2_useDSN: Integer): Integer;
procedure DB_Destroy_connection(Handle: Integer);
function DB_Connect(Handle: Integer; const Password: String): Boolean;
procedure DB_Disconnect(Handle: Integer);
function DB_Is_connected(Handle: Integer): Boolean;
procedure DB_Begin_transaction(Handle: Integer);
procedure DB_End_transaction(Handle: Integer; Commited: Boolean);
//
procedure DB_Close(Handle: Integer);
function DB_Execute(Handle: Integer; const Sql_text: String): Integer;
function DB_Open(Handle: Integer; const Sql_text: String): Boolean;
function DB_Next(Handle: Integer): Boolean;
//
function DB_Count_fields(Handle: Integer): Integer;
function DB_Field_name_by_index(Handle, Indx: Integer): String;
function DB_Integer(Handle, Indx: Integer): Integer;
function DB_Real(Handle, Indx: Integer): Double;
procedure DB_Id(Handle, Indx: Integer; Value: DynAInt);
function DB_Date_time(Handle, Indx: Integer): TDateTime;
function DB_Boolean(Handle, Indx: Integer): Boolean;
function DB_Is_null(Handle, Indx: Integer): Boolean;
function DB_String(Handle, Indx: Integer): String;

implementation

type SQLResult = Word;

const ODBC32 = 'ODBC32';

const
  SQL_HANDLE_ENV  = 1;
  SQL_HANDLE_DBC  = 2;
  SQL_HANDLE_STMT = 3;
  SQL_HANDLE_DESC = 4;

function SQLAllocHandle(
  HandleType            : SmallInt;
  InputHandle           : THandle;
  OutputHandlePtr       : PHandle
  ): SQLResult; stdcall;
  external ODBC32 name 'SQLAllocHandle';
  
function SQLFreeHandle(
  HandleType           : SmallInt;
  Handle               : THandle
  ): SQLResult; stdcall;
  external ODBC32 name 'SQLFreeHandle';

function SQLConnect(
  ConnectionHandle  : THandle;
  ServerName        : PChar;
  NameLength1       : SmallInt;
  UserName          : PChar;
  NameLength2       : SmallInt;
  Authentication    : PChar;
  NameLength3       : SmallInt
  ): SQLResult; stdcall;
  external ODBC32 name 'SQLConnect';

function TExODBCDatabase.DSNConnect2(
	const DSN, User, Pwd: String): Boolean;
var R: Word;
begin
  Result := TRUE;
  if Connected then Exit;
  R := SQLAllocHandle( SQL_HANDLE_DBC, fEnvHandle, @ fConnHandle );
  if R > 1 then
    raise EODBC.CreateEnvError( fEnvHandle, R, 'Could not allocate connection '
    + 'handle, DSN(' + DSN + ')' );
  R := SQLConnect( fConnHandle, PChar( DSN ), Length( DSN ),
    PChar( User ), Length( User ), PChar( Pwd ), Length( Pwd ) );
  if R <= 1 then
  begin
    fConnected := TRUE;
    //Async := FAsync;
  end
  else
  begin
    TRY
      raise EODBC.CreateConnError( fConnHandle, R,
        'Could not connect using DSN(' +
        DSN + '), User(' + User +')' );
    FINALLY
      SQLFreeHandle( SQL_HANDLE_DBC, fConnHandle );
      fConnHandle := 0;
    END;
  end;
  Result := fConnected;
end;

const 
  SQL_NULL_DATA    = -1;
  SQL_UNKNOWN_TYPE = 0;
  SQL_CHAR         = 1;
  SQL_NUMERIC      = 2;
  SQL_DECIMAL      = 3;
  SQL_INTEGER      = 4;
  SQL_SMALLINT     = 5;
  SQL_FLOAT        = 6;
  SQL_REAL         = 7;
  SQL_DOUBLE       = 8;
  SQL_BOOLEAN      = 16;
  SQL_BIT          = -7;
  

function TExODBCQuery.GetBoolFieldN(
	N: Integer): Boolean;
var FD: PFieldDescription;
    s: String;
begin
  Result := FALSE;
  FD := Pointer( fColumns.Objects[ N ] );
  if FD.StrLenInd^ <> SQL_NULL_DATA then
  CASE FD.DataType OF
  {SQL_NUMERIC:
    Result := Trunc( NumericToExtended( PSqlNumeric( FD.BindPtr )^ ) );}
  SQL_INTEGER:
    Result := PInteger( FD.BindPtr )^ <> 0;
  SQL_SMALLINT:
    Result := PSmallInt( FD.BindPtr )^ <> 0;
  SQL_DOUBLE,
  SQL_FLOAT:
    Result := Trunc( PDouble( FD.BindPtr )^ ) <> 0;
  SQL_REAL:
    Result := Trunc( PSingle( FD.BindPtr )^ ) <> 0;
  SQL_BIT, SQL_BOOLEAN:
    Result := PByte( FD.BindPtr )^ <> 0;
  else
    raise EODBC.Create( {$IFDEF KOL}e_custom,{$ENDIF}
      'Unknown data type for boolean' + fColumns{$IFDEF KOL}.Items{$ENDIF}[ N ] );
  END;
end;



destructor TNATIVE_DB.Destroy;
begin
    User := '';
    inherited;
end;

var All_odbc_connections: array of TNATIVE_DB;

function DB_Create_connection(
	const Connection, User: String;
         Provider_2_useDSN: Integer): Integer;
var db: TNATIVE_DB;
	i: Integer;
begin
    db := TNATIVE_DB.Create;
    db.Connection_string := Connection;
    db.User := User;
    db.use_Dsn := (Provider_2_useDSN = 2) 
    	//and (pos(';dsn', LowerCase(Connection)) > 0)
    	;
	
    RESULT := -1;
    FOR i := 0 TO Length(All_odbc_connections)-1 DO
        if All_odbc_connections[i] = nil then
        begin
        	RESULT := i;
        	BREAK;
        end;
	if RESULT < 0 then
	begin
    	RESULT := Length(All_odbc_connections);
    	SetLength(All_odbc_connections, Length(All_odbc_connections)+1);
	end;
	All_odbc_connections[RESULT] := db;
	inc(RESULT);
end;

procedure DB_Destroy_connection(
	Handle: Integer);
var db: TNATIVE_DB;
begin
    db := All_odbc_connections[Handle-1];
    try
        if db.Sql <> nil then
            FreeAndNil(db.Sql);
        if db.S_c <> nil then
            FreeAndNil(db.S_c);
        db.Free;
        All_odbc_connections[Handle-1] := nil;
    except on E: Exception do
           begin
                Any_Exception(E);
           end;
    end;
end;


function DB_Connect(
	Handle: Integer; const Password: String): Boolean;
var db: TNATIVE_DB;
    c_s: String;
begin
    RESULT := TRUE;
    db := All_odbc_connections[Handle-1];
    try
        c_s := db.Connection_string;
        
        if db.S_c = nil then
            db.S_c := TODBCDataBase.Create;
        if db.S_c.Connected then Exit;
        
        //if Applet = nil then
        //begin
        //    Applet := NewApplet('');
        //    Applet.Visible := FALSE;
        //end;
        if db.use_DSN then
            TExODBCDataBase(db.S_c).DSNConnect2(c_s, db.User, Password)
        else begin 
            if db.User <> '' then c_s := c_s + ';User=' + db.User;
            if Password <> '' then c_s := c_s + ';Password=' + Password ;
            db.S_c.ConnectionString := c_s;
            db.S_c.Connect;
        end;
        RESULT := db.S_c.Connected;
    except on E: Exception do
           begin
                Any_Exception(E);
                RESULT := FALSE;
           end;
    end;
end;

procedure DB_Disconnect(
	Handle: Integer);
var db: TNATIVE_DB;
begin
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        db.S_c.Disconnect;
    except on E: Exception do
           begin
                Any_Exception(E);
           end;
    end;
end;

function DB_Is_connected(
	Handle: Integer): Boolean;
var db: TNATIVE_DB;
begin
    RESULT := FALSE;
    db := All_odbc_connections[Handle-1];
    if db.S_c = nil then Exit;
    RESULT := db.S_c.Connected;
end;

procedure DB_Begin_transaction(
	Handle: Integer);
var db: TNATIVE_DB;
begin
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        db.S_c.BeginTrans;
    except on E: Exception do
           begin
                Any_Exception(E);
           end;
    end;
end;
    
procedure DB_End_transaction(
	Handle: Integer; Commited: Boolean);
var db: TNATIVE_DB;
begin
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if Commited then db.S_c.CommitTrans
                    else db.S_c.RollbackTrans;
    except on E: Exception do
           begin
                Any_Exception(E);
           end;
    end;
end;

function SQLRowCount(
  StatementHandle: THandle;
  RowCountPointer: PInteger
  ): Word; stdcall;
  external ODBC32 name 'SQLRowCount';

function DB_Execute(
	Handle: Integer; const Sql_text: String): Integer;
var db: TNATIVE_DB;
begin
    RESULT := 0;
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then
        begin
            DefaultODBCDataSource := db.S_c;
            db.Sql := TExODBCQuery(TODBCQuery.Create(nil));
        end;
        db.Sql.Close;
        db.Sql.SQL.Clear;
        db.Sql.SQL.Add(Sql_text);
        db.Sql.ExecSQL;
        SqlRowCount(db.Sql.fHandle, @RESULT);
    except on E: Exception do
           begin
                Any_Exception(E);
           end;
    end;
end;

function DB_Open(
	Handle: Integer; const Sql_text: String): Boolean;
var db: TNATIVE_DB;
begin
    RESULT := FALSE;
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then
        begin
            DefaultODBCDataSource := db.S_c;
            db.Sql := TExODBCQuery(TODBCQuery.Create(nil));
        end;
        db.Sql.Close;
        db.Sql.SQL.Clear;
        db.Sql.SQL.Add(Sql_text);
        db.Sql.Open;
        //db.Sql.Next;
        RESULT := not db.Sql.Eof;
    except on E: Exception do
           begin
                Any_Exception(E);
           end;
    end;
end;

procedure DB_Close(Handle: Integer);
var db: TNATIVE_DB;
begin
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then Exit;
        db.Sql.Close;
    except on E: Exception do
           begin
                Any_Exception(E);
           end;
    end;
end;

function DB_Next(
	Handle: Integer): Boolean;
var db: TNATIVE_DB;
begin
    RESULT := false;
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then Exit;
        if db.Sql.Eof then Exit;
        db.Sql.Next;
        RESULT := not db.Sql.Eof;
    except on E: Exception do
           begin
                Any_Exception(E);
           end;
    end;
end;

function DB_Count_fields(
	Handle: Integer): Integer;
var db: TNATIVE_DB;
begin
    RESULT := 0;
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then Exit;
        //if db.Sql.Eof then Exit;
        RESULT := db.Sql.FieldCount;
    except on E: Exception do
           begin
                Any_Exception(E);
           end;
    end;
end;

function DB_Field_name_by_index(
	Handle, Indx: Integer): String;
var db: TNATIVE_DB;
begin
    RESULT := '';
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then Exit;
        //if db.Sql.Eof then Exit;
        if (Indx < 0) or (Indx >= db.Sql.FieldCount) then Exit;
        RESULT := db.Sql.FieldNames[Indx];
    except on E: Exception do
           begin
                //Any_Exception(E);
           end;
    end;
end;

function DB_Integer(
	Handle, Indx: Integer): Integer;
var db: TNATIVE_DB;
begin
    RESULT := 0;
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then Exit;
        if db.Sql.Eof then Exit;
        if (Indx < 0) or (Indx >= db.Sql.FieldCount) then Exit;
        RESULT := db.Sql.IFieldN[Indx];
    except on E: Exception do
           begin
                //Any_Exception(E);
           end;
    end;
end;

function DB_Real(
	Handle, Indx: Integer): Double;
var db: TNATIVE_DB;
begin
    RESULT := 0;
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then Exit;
        if db.Sql.Eof then Exit;
        if (Indx < 0) or (Indx >= db.Sql.FieldCount) then Exit;
        RESULT := db.Sql.FFieldN[Indx];
    except on E: Exception do
           begin
                //Any_Exception(E);
           end;
    end;
end;

procedure DB_Id(Handle, Indx: Integer; Value: DynAInt);
var db: TNATIVE_DB;
	X: Integer;
begin
	db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then Exit;
        if db.Sql.Eof then Exit;
        if (Indx < 0) or (Indx >= db.Sql.FieldCount) then Exit;
        X := db.Sql.IFieldN[Indx];

        Value.SetIntegers(0, x);
        if x < 0 then Value.SetIntegers(1, -1)
        else Value.SetIntegers(1, 0);
    except on E: Exception do
           begin
                //Any_Exception(E);
           end;
    end;
end;

function DB_Date_time(
	Handle, Indx: Integer): TDateTime;
var db: TNATIVE_DB;
begin
    RESULT := 0;
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then Exit;
        if db.Sql.Eof then Exit;
        if (Indx < 0) or (Indx >= db.Sql.FieldCount) then Exit;
        RESULT := (db.Sql.DFieldN[Indx]) * 24.0 * 3600000;
    except on E: Exception do
           begin
                //Any_Exception(E);
           end;
    end;
end;

function DB_Boolean(
	Handle, Indx: Integer): Boolean;
var db: TNATIVE_DB;
begin
    RESULT := FALSE;
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then Exit;
        if db.Sql.Eof then Exit;
        if (Indx < 0) or (Indx >= db.Sql.FieldCount) then Exit;
        RESULT := db.Sql.GetBoolFieldN(Indx);
    except on E: Exception do
           begin
                //Any_Exception(E);
           end;
    end;
end;

function DB_Is_null(
	Handle, Indx: Integer): Boolean;
var db: TNATIVE_DB;
begin
    RESULT := TRUE;
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then Exit;
        if db.Sql.Eof then Exit;
        if (Indx < 0) or (Indx >= db.Sql.FieldCount) then Exit;
        RESULT := db.Sql.NullFieldN[Indx];
    except on E: Exception do
           begin
                //Any_Exception(E);
           end;
    end;
end;

function DB_String(
	Handle, Indx: Integer): String;
var db: TNATIVE_DB;
begin
    RESULT := '';
    db := All_odbc_connections[Handle-1];
    try
        if db.S_c = nil then Exit;
        if not db.S_c.Connected then Exit;
        if db.Sql = nil then Exit;
        if db.Sql.Eof then Exit;
        if (Indx < 0) or (Indx >= db.Sql.FieldCount) then Exit;
        RESULT := db.Sql.SFieldN[Indx];
    except on E: Exception do
           begin
                //Any_Exception(E);
           end;
    end;
end;
    
(*
/*

    
CONST STR:
    NATIVE_DB_import = "uses NATIVE_DB;"
    
    NATIVE_DB_Create_connection = @
    "   RESULT := DB_Create_connection(X_Connection, X_User, "
    "       X_Provider);"

    NATIVE_DB_Destroy_connection = @
    "   DB_Destroy_connection(X_Handle);"

    NATIVE_DB_Connect = @
    "   RESULT := DB_Connect(X_Handle, X_Password);"
    
    NATIVE_DB_Disconnect = @
    "   DB_Disconnect(X_handle);"

	NATIVE_DB_Is_connected = @
    "   RESULT := DB_Is_connected(X_handle);"
    
    NATIVE_DB_Begin_transaction = @
    "   DB_Begin_transaction(X_Handle);"

    NATIVE_DB_End_transaction = @
    "   DB_End_transaction(X_Handle, X_Commited);"

    NATIVE_DB_Commit_transaction = @
    ""

    NATIVE_DB_Rollback_transaction = @
    ""

    NATIVE_DB_Execute = @
    "RESULT := DB_Execute(X_handle,X_SQL);"

    NATIVE_DB_Open = @
    "RESULT := not DB_Open(X_handle,X_SQL);"

    NATIVE_DB_Close = @
    "   DB_Close(X_handle);"

    NATIVE_DB_Next = @
    "   RESULT := DB_Next(X_handle);"

    NATIVE_DB_Count_fields = @
    "   RESULT := DB_Count_fields(X_handle);"

    NATIVE_DB_Field_by_index = @
    "   RESULT := DB_Field_name_by_index(X_handle, X_Ind);"

    NATIVE_DB_Integer = @
    "   RESULT := DB_Integer(X_handle, X_Ind);"

    NATIVE_DB_Real = @
    "   RESULT := DB_Real(X_handle, X_Ind);"

    NATIVE_DB_Id = @
    "   NATIVE_DB.DB_Id(X_Handle, X_Ind, X_Value);"     

    NATIVE_DB_Date_time = @
    "   RESULT := DB_Date_time(X_handle, X_Ind);"

    NATIVE_DB_Boolean = @
    "   RESULT := DB_Boolean(X_handle, X_Ind);"

    NATIVE_DB_Is_null = @
    "   RESULT := DB_Is_null(X_handle, X_Ind);"

    NATIVE_DB_String = @
    "   RESULT := DB_String(X_handle, X_Ind);"
    
    NATIVE_Load_from_blob = ""

    NATIVE_Read_blob = ""
    
    .
        
*/
*)

end .

(*
/*
END
*/
*)
