* Windows System DSN sample code;
* Richard A. DeVenezia;
* http://www.devenezia.com;
*
* Obtain ODBC Data Sources Names as listed by odbc administrator;

filename SASCBTBL catalog 'WORK.WINAPI.SASCBTBL.SOURCE';

data _null_;
  file SASCBTBL;
  input ;
  put _infile_;
cards4;
routine SQLAllocHandle
   module=ODBC32
   minarg=3
   maxarg=3
   stackpop=called
   returns=short
;
arg 1 input  num format=ib2.  byvalue  ;  * SQLSMALLINT   HandleType;
arg 2 input  num format=pib4. byvalue  ;  * SQLHANDLE     InputHandle;
arg 3 output num format=pib4. byaddr   ;  * SQLHANDLE *   OutputHandlePtr;


routine SQLSetEnvAttr
   module=ODBC32
   minarg=4
   maxarg=4
   stackpop=called
   returns=short
;
arg 1 input num format=pib4. byvalue; *     SQLHENV     EnvironmentHandle;
arg 2 input num format=pib4. byvalue; *     SQLINTEGER     Attribute;
arg 3 input num format=pib4. byvalue; *     SQLPOINTER     ValuePtr (use Addr() if Attribute Value is string);
arg 4 input num format=pib4. byvalue; *     SQLINTEGER     StringLength;


routine SQLFreeHandle
   module=ODBC32
   minarg=2
   maxarg=2
   stackpop=called
   returns=short
;
arg 1 input num format = pib2. byvalue ; *  SQLSMALLINT   HandleType;
arg 2 input num format = pib4. byvalue ; *  SQLHANDLE     Handle;


routine SQLDataSources
   module=ODBC32
   minarg=8
   maxarg=8
   stackpop=called
   returns=short
;
arg 1 input num format = pib4.        byvalue;    *     SQLHENV     EnvironmentHandle;
arg 2 input num format = pib2.        byvalue;    *     SQLUSMALLINT     Direction;
arg 3 output char format = $cstr200.  byaddr ;    *     SQLCHAR *     ServerName;
arg 4 input num format = pib2.        byvalue;    *     SQLSMALLINT     BufferLength1;
arg 5 output num format = pib2.       byaddr ;    *     SQLSMALLINT *     NameLength1Ptr;
arg 6 output char format = $cstr200.  byaddr ;    *     SQLCHAR *     Description;
arg 7 input num format = pib2.        byvalue;    *     SQLSMALLINT     BufferLength2;
arg 8 output num format = pib2.       byaddr ;    *     SQLSMALLINT *     NameLength2Ptr;

routine SQLGetDiagRec
   module=ODBC32
   minarg=8
   maxarg=8
   stackpop=called
   returns=short
;
arg 1 input num format = pib2. byvalue ;      *    SQLSMALLINT     HandleType;
arg 2 input num format = pib4. byvalue ;      *    SQLHANDLE       Handle;
arg 3 input num format = pib2. byvalue ;      *    SQLSMALLINT     RecNumber;
arg 4 output char format = $cstr200.  byaddr; *    SQLCHAR *     Sqlstate;
arg 5 output num format = pib4. byaddr;       *     SQLINTEGER *     NativeErrorPtr;
arg 6 output char format = $cstr200.  byaddr; *    SQLCHAR *     MessageText;
arg 7 input num format = pib2. byvalue ;      *     SQLSMALLINT     BufferLength;
arg 8 input num format = pib2. byaddr  ;      *     SQLSMALLINT *     TextLengthPtr;
;;;;

options linesize=132;

data _null_;
  retain
    SQL_SUCCESS     0
    SQL_HANDLE_ENV  1
    SQL_NULL_HANDLE 0
    SQL_FETCH_NEXT  1
    SQL_FETCH_FIRST        2
    SQL_FETCH_FIRST_USER   31
    SQL_FETCH_FIRST_SYSTEM 32
    SQL_ATTR_ODBC_VERSION 200
    SQL_OV_ODBC3 3
    SQL_NO_DATA 100
  ;

  length state $5 error 8 message $200 msglen 8;
  length dsName dsDesc $200;
  length dsNameLen dsDescLen 8;
  dsNameLen = 0;
  dsDescLen = 0;

  rc = modulen ('SQLAllocHandle', SQL_HANDLE_ENV, SQL_NULL_HANDLE, hEnv);
  link diagnose;

  rc = modulen ('SQLSetEnvAttr', hEnv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0 );
  link diagnose;

  rc = modulen ('SQLDataSources', hEnv, SQL_FETCH_FIRST_SYSTEM, dsName, 199, dsNameLen, dsDesc, 199, dsDescLen);
  put 'SYSTEM DSNs';
  link getdsns;

  rc = modulen ('SQLDataSources', hEnv, SQL_FETCH_FIRST_USER, dsName, 199, dsNameLen, dsDesc, 199, dsDescLen);
  put 'USER DSNs';
  link getdsns;

  rc = modulen ('SQLDataSources', hEnv, SQL_FETCH_FIRST, dsName, 199, dsNameLen, dsDesc, 199, dsDescLen);
  put 'ALL DSNs';
  link getdsns;

  rc = modulen ('SQLFreeHandle', SQL_HANDLE_ENV, hEnv);
  link diagnose;

  STOP;

getdsns:
  n = 0;
  do while (1);
    n+1;
    put n= dsName= dsDesc= dsNameLen= dsDescLen=;
    rc = modulen ('SQLDataSources', hEnv, SQL_FETCH_NEXT, dsName, 199, dsNameLen, dsDesc, 199, dsDescLen);
    if rc ^= 0 then LEAVE;
  end;
  if rc ^= SQL_NO_DATA then link diagnose;
return;

diagnose:
  if rc = 0 then return;
  call module ('SQLGetDiagRec', SQL_HANDLE_ENV, hEnv, 1, state, error, message, 199, msglen);
  put rc= state= error= message=;
  return;
run;