' odbc.sbp #ifndef _INC_SQLEXT #include #endif '=========================================================== ' IOdbcConnection インターフェイス Dim IID_IOdbcConnection = [&HE0FC6F3C,&HDD4C,&H40f6,[&H82,&H8F,&H42,&H90,&H67,&H27,&H9C,&HDC]] As GUID Interface IOdbcConnection Inherits IUnknown Function Connect(lpszDataSource As LPSTR) As SQLRETURN Function Disconnect() As SQLRETURN Function CreateCommand() As *COdbcCommand End Interface Function OdbcConnection_CreateInstance() As *IOdbcConnection Dim pobj_OdbcConnection As *COdbcConnection pobj_OdbcConnection=New COdbcConnection() pobj_OdbcConnection->QueryInterface(IID_IOdbcConnection,VarPtr(OdbcConnection_CreateInstance)) End Function ' ここまで '=========================================================== Class COdbcConnection m_ref As Long '参照カウンタ hEnv As SQLHENV '環境ハンドル hDbc As SQLHDBC '接続ハンドル Public Sub COdbcConnection() '環境ハンドルを取得 SQLAllocHandle( SQL_HANDLE_ENV, 0 , hEnv ) SQLSetEnvAttr ( hEnv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3 As SQLPOINTER, 0 ) '接続ハンドルを取得 SQLAllocHandle( SQL_HANDLE_DBC, hEnv, hDbc ) End Sub Sub ~COdbcConnection() '切断 Disconnect() '接続ハンドルを解放 SQLFreeHandle( SQL_HANDLE_DBC, hDbc ) '環境ハンドルを解放 SQLFreeHandle( SQL_HANDLE_ENV, hEnv ) End Sub Function GetEnvHandle() As SQLHENV GetEnvHandle = hEnv End Function Function GetDbcHandle() As SQLHDBC GetDbcHandle = hDbc End Function '------------------------------------------------------- ' COMインターフェイス用IUnknownメソッド Virtual Function QueryInterface(ByRef riid As IID, ppvObj As *VoidPtr) As HRESULT If IsEqualIID(riid,IID_IOdbcConnection)<>0 or IsEqualIID(riid,IID_IUnknown)<>0 Then Set_LONG_PTR(ppvObj,VarPtr(This) As LONG_PTR) AddRef() QueryInterface=S_OK Else Set_LONG_PTR(ppvObj,0) QueryInterface=E_NOINTERFACE End If End Function Virtual Function AddRef() As DWord m_ref++ AddRef=m_ref End Function Virtual Function Release() As DWord m_ref-- If m_ref=0 Then Delete VarPtr(This) End If Release=m_ref End Function ' ここまで '------------------------------------------------------- '------------------------------------------------------- ' 接続を確立 '------------------------------------------------------- Virtual Function Connect(lpszDataSource As LPSTR) As SQLRETURN Dim szConnStrOut[ELM(1024)] As Byte Dim cbConnStrOut As SQLSMALLINT 'データベースへ接続する Dim ret As SQLRETURN ret=SQLDriverConnect(hDbc, 0, lpszDataSource, SQL_NTS, szConnStrOut, 1024, cbConnStrOut, SQL_DRIVER_COMPLETE_REQUIRED) Connect=ret End Function '------------------------------------------------------- ' 切断 '------------------------------------------------------- Virtual Function Disconnect() As SQLRETURN Disconnect = SQLDisconnect(hDbc) End Function '-------------------------------- ' コマンド インスタンスを生成 '-------------------------------- Virtual Function CreateCommand() As *COdbcCommand Dim pobj_Command As *COdbcCommand pobj_Command=New COdbcCommand(VarPtr(This)) Return pobj_Command End Function /* Function ExecDirect(lpszSQL As LPSTR) As SQLRETURN '前回のステートメントハンドルを解放 StmtFreeHandle() 'ステートメントハンドルを取得する SQLAllocHandle( SQL_HANDLE_STMT, hDbc, hStmt ) 'SQL文を発行 ExecDirect = SQLExecDirect( hStmt, lpszSQL, SQL_NTS ) End Function Function Prepare(lpszSQL As LPSTR) As SQLRETURN '前回のステートメントハンドルを解放 StmtFreeHandle() 'ステートメントハンドルを取得する SQLAllocHandle( SQL_HANDLE_STMT, hDbc, hStmt ) Prepare = SQLPrepare( hStmt, lpszSQL, SQL_NTS ) 'SQL文を設定する End Function Function Execute() As SQLRETURN Execute = SQLExecute( hStmt ) End Function*/ End Class Class COdbcCommand Public pobj_Connection As *COdbcConnection hStmt As SQLHSTMT CommandText As String Sub COdbcCommand(pobj_Connection As *COdbcConnection) This.pobj_Connection=pobj_Connection End Sub Sub ~COdbcCommand() If hStmt Then SQLFreeHandle( SQL_HANDLE_STMT, hStmt ) hStmt=0 End If End Sub Function ExecuteReader() As *COdbcDataReader 'DataReaderを構築 Dim pobj_DataReader As *COdbcDataReader pobj_DataReader=New COdbcDataReader(VarPtr(This)) Return pobj_DataReader End Function Function Release() As DWord Delete VarPtr(This) End Function End Class Class COdbcData Public lpszName As LPSTR iType As SQLSMALLINT iSize As SQLINTEGER lpszValue As LPSTR Sub COdbcData(lpszName As LPSTR, iType As SQLSMALLINT, iSize As SQLINTEGER) This.lpszName=malloc(lstrlen(lpszName)+1) lstrcpy(This.lpszName,lpszName) This.iType=iType This.iSize=iSize lpszValue=malloc(iSize+1) End Sub Sub ~COdbcData() free(lpszName) lpszName=0 free(lpszValue) lpszValue=0 End Sub End Class Class COdbcDataReader pobj_Command As *COdbcCommand Item As **COdbcData iColNum As SQLSMALLINT bFirstRead As BOOL hStmt As SQLHSTMT Public Sub COdbcDataReader(pobj_Command As *COdbcCommand) This.pobj_Command=pobj_Command 'ステートメントハンドルを取得する SQLAllocHandle( SQL_HANDLE_STMT, pobj_Command->pobj_Connection->GetDbcHandle(), hStmt ) 'SQL文を発行 SQLExecDirect( hStmt, pobj_Command->CommandText, SQL_NTS ) '列数を取得 SQLNumResultCols(hStmt, iColNum) '列データ格納領域を確保 Item=malloc(iColNum*SizeOf(*COdbcData)) Dim i As SQLSMALLINT Dim szColName[255] As Byte Dim acc_bytes As SQLSMALLINT Dim iType As SQLSMALLINT, iSize As SQLINTEGER, scale As SQLSMALLINT, nullable As SQLSMALLINT Dim displaysize As SQLINTEGER For i=0 To ELM(iColNum) '列属性を取得 SQLDescribeCol(hStmt, i+1, szColName,255,acc_bytes, iType, iSize, scale, nullable) '文字列に換算したときの長さを取得 SQLColAttributes (hStmt, i+1, SQL_COLUMN_DISPLAY_SIZE, NULL, 0, ByVal NULL, displaysize) If displaysizelpszValue, iSize, idummy) Next bFirstRead=1 End Sub Sub ~COdbcDataReader() Dim i As Long For i=0 To ELM(iColNum) Delete Item[i] Next free(Item) Item=0 If hStmt Then SQLFreeHandle( SQL_HANDLE_STMT, hStmt ) hStmt=0 End If End Sub Function GetFieldType(i As Long) As SQLSMALLINT If i>=iColNum Then Return 0 Return Item[i]->iType End Function Function GetName(i As Long) As LPSTR If i>=iColNum Then Return 0 Return Item[i]->lpszName End Function Function GetStrPtr(i As Long) As LPSTR If i>=iColNum Then Return 0 Return Item[i]->lpszValue End Function Function Read() As BOOL Dim ret As SQLRETURN If bFirstRead Then '先頭行へ移動する SQLFetchScroll( hStmt, SQL_FETCH_FIRST, 0 ) ret = SQLFetch( hStmt ) If (ret = SQL_NO_DATA) Then Return 0 bFirstRead=0 Else '次の行へ移動する ret = SQLFetchScroll( hStmt, SQL_FETCH_NEXT, 0 ) If (ret = SQL_NO_DATA) Then Return 0 End If Return 1 End Function Virtual Function Release() As DWord Delete VarPtr(This) End Function End Class