home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 4611 / fw16d.ins / SOURCE / CLASSES / DBODBC.PRG < prev    next >
Text File  |  1994-05-12  |  5KB  |  200 lines
  1. #include "FiveWin.ch"
  2.  
  3. #define SQL_SUCCESS   0
  4. #define SQL_DROP      1
  5.  
  6. //----------------------------------------------------------------------------//
  7.  
  8. CLASS TDbOdbc
  9.  
  10.    DATA   hEnv, hDbc, hStmt                   AS NUMERIC PROTECTED
  11.    DATA   cConnect, cDSN, cUser, cPassword
  12.    DATA   aFields
  13.  
  14.    METHOD New( cDSN, cUser, cPassword, cConnect, lDlg ) CONSTRUCTOR
  15.  
  16.    METHOD Execute( cCommand ) INLINE ;
  17.                    If( SQLExecDirect( ::hStmt, cCommand ) != SQL_SUCCESS,;
  18.                    MsgInfo( "Cannot execute that command" ),)
  19.  
  20.    METHOD FieldName( nField ) INLINE  ::aFields[ nField ][ 1 ]
  21.    METHOD Field( nField )     INLINE  ::aFields[ nField ][ 1 ]
  22.    METHOD FieldType( nField ) INLINE  ::aFields[ nField ][ 2 ]
  23.    METHOD FieldLen( nField )  INLINE  ::aFields[ nField ][ 3 ]
  24.    METHOD FieldDec( nField )  INLINE  ::aFields[ nField ][ 4 ]
  25.  
  26.    MESSAGE FCount METHOD _FCount()
  27.  
  28.    METHOD End()
  29.  
  30.    METHOD FieldGet( nField )
  31.  
  32.    METHOD InitFields()
  33.  
  34.    METHOD LastError()
  35.  
  36.    METHOD Skip()  INLINE  If( SQLFetch( ::hStmt ) != SQL_SUCCESS,;
  37.                   MsgAlert( "Impossible to Skip" + CRLF + ::LastError() ),)
  38.  
  39. ENDCLASS
  40.  
  41. //----------------------------------------------------------------------------//
  42.  
  43. METHOD New( cDSN, cUser, cPassword, cConnect, lDlg ) CLASS TDbOdbc
  44.  
  45.    local hEnv, hDbc, hStmt
  46.  
  47.    DEFAULT lDlg := .f.           // Dialog Box connection
  48.  
  49.    ::cDSN      = cDSN
  50.    ::cUser     = cUser
  51.    ::cPassword = cPassword
  52.  
  53.    if SQLAllocEnv( @hEnv ) == SQL_SUCCESS
  54.       ::hEnv = hEnv
  55.    else
  56.       MsgStop( "Unable to create the enviroment for the ODBC Object" )
  57.       return nil
  58.    endif
  59.  
  60.    if SQLAllocConnect( hEnv, @hDbc ) == SQL_SUCCESS
  61.       ::hDbc = hDbc
  62.    else
  63.       MsgStop( "Unable to create the Connection for the ODBC Object" )
  64.       return nil
  65.    endif
  66.  
  67.    if ! Empty( cConnect )
  68.       if SQLDriverConnect( hDbc, @cConnect, lDlg ) != SQL_SUCCESS
  69.          MsgStop( "Unable to perform the ODBC connection" )
  70.          return nil
  71.       else
  72.          ::cConnect = cConnect
  73.          ::cDSN     = SubStr( cConnect, 1, At( ";", cConnect ) - 1 )
  74.          ::cDSN     = SubStr( ::cDSN, At( "=", ::cDSN ) + 1 )
  75.       endif
  76.    else
  77.       if SQLConnect( hDbc, cDSN, cUser, cPassword ) != SQL_SUCCESS
  78.          MsgStop( "Unable to perform the ODBC connection" )
  79.          return nil
  80.       endif
  81.    endif
  82.  
  83.    if SQLAllocStmt( hDbc, @hStmt ) == SQL_SUCCESS
  84.       ::hStmt = hStmt
  85.    else
  86.       MsgStop( "Unable to create a statement for the ODBC Object" )
  87.       return nil
  88.    endif
  89.  
  90.    ::Execute( "SELECT * FROM " + ::cDSN )
  91.    ::InitFields()
  92.    ::Skip()                    // Go to first element selected ???
  93.  
  94. return nil
  95.  
  96. //----------------------------------------------------------------------------//
  97.  
  98. METHOD _FCount() CLASS TDbOdbc
  99.  
  100.    local nFields
  101.  
  102.    if SQLNumResultCols( ::hStmt, @nFields ) != SQL_SUCCESS
  103.       MsgStop( "Error calculating number fo fields" )
  104.       return 0
  105.    endif
  106.  
  107. return nFields
  108.  
  109. //----------------------------------------------------------------------------//
  110.  
  111. METHOD _FieldName( nField ) CLASS TdbOdbc
  112.  
  113.    local cName, nType, nLen, nDec
  114.  
  115.    SQLDescribeCol( ::hStmt, nField, @cName, @nType, @nLen, @nDec )
  116.  
  117. return cName
  118.  
  119. //----------------------------------------------------------------------------//
  120.  
  121. METHOD End() CLASS TDbOdbc
  122.  
  123.    SQLFreeStmt( ::hStmt, SQL_DROP )
  124.    SQLDisconnect( ::hDbc )
  125.    SQLFreeConnect( ::hDbc )
  126.    SQLFreeEnv( ::hEnv )
  127.  
  128.    ::hEnv  = 0
  129.    ::hDbc  = 0
  130.    ::hStmt = 0
  131.  
  132. return nil
  133.  
  134. //----------------------------------------------------------------------------//
  135.  
  136. METHOD InitFields() CLASS TDbOdbc
  137.  
  138.    local n, nFields := ::FCount()
  139.    local cName, nType, nLen, nDec, lNull
  140.  
  141.    ::aFields = {}
  142.  
  143.    for n = 1 to nFields
  144.       SQLDescribeCol( ::hStmt, n, @cName, @nType, @nLen, @nDec, @lNull )
  145.       AAdd( ::aFields, { cName, cSQLType( nType ), nLen, nDec, lNull } )
  146.    next
  147.  
  148. return nil
  149.  
  150. //----------------------------------------------------------------------------//
  151.  
  152. METHOD FieldGet( nField ) CLASS TDbOdbc
  153.  
  154.    // local cType := ::FieldType( nField )
  155.    local cData
  156.  
  157.    if SQLGetData( ::hStmt, nField, 0, ::FieldLen( nField ), @cData ) != ;
  158.       SQL_SUCCESS
  159.       MsgAlert( "Impossible retrieve Field Data" + CRLF + ::LastError() )
  160.    endif
  161.  
  162. return cData
  163.  
  164. //----------------------------------------------------------------------------//
  165.  
  166. function cSQLType( nType )
  167.  
  168.    local cType := "U"
  169.  
  170.    do case
  171.       case nType == 1
  172.            cType = "C"
  173.  
  174.       case nType == -7
  175.            cType = "L"
  176.  
  177.       case nType == 8
  178.            cType = "N"
  179.  
  180.       case nType == 9
  181.            cType = "D"
  182.  
  183.       case nType == -1
  184.            cType = "M"
  185.    endcase
  186.  
  187. return cType
  188.  
  189. //----------------------------------------------------------------------------//
  190.  
  191. METHOD LastError() CLASS TDbOdbc
  192.  
  193.    local cClassError, nType, cMsgError
  194.  
  195.    SQLError( ::hEnv, ::hDbc, ::hStmt, @cClassError, @nType, @cMsgError )
  196.  
  197. return cMsgError
  198.  
  199. //----------------------------------------------------------------------------//
  200.