ODBC access from Ada

with Win32.Sql; use Win32.Sql;
with Win32.SqlExt; use Win32.SqlExt;
with Interfaces.C; use Interfaces.C;
with Ada.Text_Io; use Ada.Text_Io;
with Ada.Unchecked_Conversion;
with System;


pragma Linker_Options("-lodbc32");


procedure Odbcex is

   function To_Puchar is new Ada.Unchecked_Conversion (System.Address,
      Win32.Puchar);
   Odbcexception : exception;

   Odbc_Handle_Env       : aliased Henv;
   Odbc_Connect_Handle   : aliased Hdbc;
   Odbc_Statement_Handle : aliased Hstmt;


   procedure Rok ( Retvalue : Retcode ) is
   begin

      if Retvalue /= Sql_Success then
         raise Odbcexception;
      end if;

   exception

      when E : others =>
         Put("ODBC Error: ");
         declare
            Sql_State        : Win32.Puchar;
            Sql_Native_Error : aliased Sdword;
            Errormsg         : Char_Array ( 1 .. 255);
            Msgsize          : aliased Sword;
            Tempvalue        : Retcode;
         begin
            Tempvalue := Sqlerror(Odbc_Handle_Env, Odbc_Connect_Handle, Odbc_Statement_Handle,
               Sql_State, Sql_Native_Error'access, To_Puchar(Errormsg'Address), 255, Msgsize'access);
            Put_Line(To_Ada(Errormsg));
            raise;
         end;
   end;

   ConnectString : Char_Array := To_C("DSN=AdaTest2");
   QueryString   : Char_Array := To_C("Select * from CallList");

   RetString     : Char_Array(1..255);
   RetLength     : aliased Sword;
   Retvalue      : Retcode;
   Numcols       : aliased Sword;
   Retsize       : aliased Sdword;
   
begin
   Rok( Sqlallocenv(Odbc_Handle_Env'access) );

   Rok( Sqlallocconnect(Odbc_Handle_Env, Odbc_Connect_Handle'access) );

   Rok( Sqldriverconnect( Odbc_Connect_Handle, System.Null_Address,
      To_puchar(connectstring'Address), Sql_Nts,
      To_puchar(Retstring'Address), 255, Retlength'access,
      Sql_Driver_Complete) );

   Rok( Sqlallocstmt(Odbc_Connect_Handle, Odbc_Statement_Handle'access) );

   Rok( Sqlprepare(Odbc_Statement_Handle, To_puchar(QueryString'Address), Sql_Nts) );

   Rok( Sqlexecute(Odbc_Statement_Handle) );
   
   Rok( Sqlnumresultcols ( Odbc_Statement_Handle, Numcols'access ) );

   loop
      Retvalue := Sqlfetch( Odbc_Statement_Handle);
      exit when Retvalue /= Sql_Success;
      for I in 1 .. Numcols loop
         Rok( Sqlgetdata ( Odbc_Statement_Handle, UWORD(I), Sql_C_Char, Retstring'Address, 254, Retsize'access ) );
         Put("|");
         if RetSize>0 then
            Put( To_Ada(Retstring(1..size_t(RetSize)), False) );
         end if;
         Put("|");
      end loop;
      
   New_Line;

   end loop;
   
   Rok( Sqlfreestmt(Odbc_Statement_Handle, Sql_Drop) );
   
   Rok( Sqldisconnect(Odbc_Connect_Handle) );

   Rok( Sqlfreeconnect(Odbc_Connect_Handle) );

   Rok( Sqlfreeenv(Odbc_Handle_Env) );

end Odbcex;