Vb对Oo4o的封装

原创 2004年08月07日 13:02:00

Vb对OO4O的封装

Vb访问Oracle 的数据库,Oracle 本身提供了一组对象Oracle Objects for OLE
这里简称 OO4O ,为了方便,我将他们重新封装成COo4o,全部源代码如下,希望大家调试纠错,注释我就免了,也想看看可读性怎么样大家可以随便使用,但是有改进的地方不要忘记通知我,谢谢
我的email:codeghost@21cn.com
参照:http://cs.cegep-heritage.qc.ca/oracledocs/win.901/a90173/o4o00000.htm
出处:我的Blog
http://www.cnblogs.com/liushui/archive/2004/08/07/30964.aspx




Public Enum OraParamType
  ORAPARM_INPUT 
= 1
  ORAPARM_OUTPUT 
= 2
  ORAPARM_BOTH 
= 3
End Enum

Public Enum OraServerType
  ORATYPE_VARCHAR2 
= 1
  ORATYPE_NUMBER 
= 2
  ORATYPE_VARCHAR 
= 9
  ORATYPE_DATE 
= 12
  ORATYPE_CHAR 
= 96
  ORATYPE_OBJECT 
= 108
  ORATYPE_BLOB 
= 113
  ORATYPE_VARRAY 
= 247
End Enum

Private m_objOraDatabase As Object
Private m_objOraSession As Object
Private m_blnShowMsg As Boolean
Private m_lngDbErrId As Long
Private m_strDbErrMsg As String
Private m_arrParams() As String
Private m_intParams As Integer

Const clngNormal  As Long = 1
Const clngError As Long = 0
Const clngErrTransBegin As Long = -1
Const clngErrTrans As Long = -2
Const clngErrTransRollBack As Long = -3
Const clngErrNullSession As Long = -100
Const ErrNullDB = -200

Public Property Get Database() As Variant
  
Set Database = m_objOraDatabase
End Property

Public Property Get Session() As Variant
  
Set Session = m_objOraSession
End Property

Public Static Property Get DbErrId() As Long
  DbErrId 
= m_lngDbErrId
End Property

Public Static Property Get DbErrMsg() As String
  DbErrMsg 
= m_strDbErrMsg
End Property

Public Static Property Get NullSession() As Long
  NullSession 
= clngErrNullSession
End Property

Public Static Property Get NullDatabase() As Long
  NullDatabase 
= ErrNullDB
End Property

Public Static Property Get RetNormal() As Long
  RetNormal 
= clngNormal
End Property

Public Static Property Get RetError() As Long
  RetError 
= clngError
End Property

Public Static Property Get RetErrTransBegin() As Long
  RetErrTransBegin 
= clngErrTransBegin
End Property

Public Static Property Get RetErrTransRollBack() As Long
  RetErrTransRollBack 
= clngErrTransRollBack
End Property

Public Static Property Get RetErrTrans() As Long
  RetErrTrans 
= clngErrTrans
End Property

Private Sub Class_Initialize()
  m_intParams 
= 0
  
ReDim m_arrParams(0)
  
  m_blnShowMsg 
= True
End Sub

Private Sub Class_Terminate()
  
Call CloseDB
End Sub

Public Function ConnectDatabase(ByVal pvstrUser As String, ByVal pvstrPass As String, ByVal pvstrDB As StringAs Boolean
  
On Error GoTo SkipErrCase

  
Set m_objOraSession = CreateObject("OracleInProcServer.XOraSession")
  
Set m_objOraDatabase = m_objOraSession.DbOpenDatabase(pvstrDB,  pvstrUser & "/" & pvstrPass, 0&)
  m_lngDbErrId 
= clngNormal
  
Exit Function
SkipErrCase:
  
Dim lngRet As Long
  lngRet 
= doDbError
  
  
If Err <> 0 Then 'Err.Description
    ConnectDatabase = False
    
Call CloseDB
  
Else
    ConnectDatabase 
= True
  
End If
End Function

Public Function BeginTrans() As Long
  
On Error GoTo SkipErrCase
  m_objOraSession.BeginTrans
  m_lngDbErrId 
= clngNormal
  BeginTrans 
= clngNormal
  
Exit Function
SkipErrCase:
  
'BeginTrans = doDbError
  m_lngDbErrId = clngErrTransBegin
  BeginTrans 
= clngErrTransBegin
End Function

Public Function RollBack() As Long
  
On Error GoTo SkipErrCase
  m_objOraSession.RollBack
  m_lngDbErrId 
= clngNormal
  RollBack 
= clngNormal
  
Exit Function
SkipErrCase:
  
'RollBack = doDbError
  m_lngDbErrId = clngErrTransRollBack
  RollBack 
= clngErrTransRollBack
End Function

Public Function CommitTrans() As Long
  
On Error GoTo SkipErrCase
  m_objOraSession.CommitTrans
  m_lngDbErrId 
= clngNormal
  CommitTrans 
= clngNormal
  
Exit Function
SkipErrCase:
  
'CommitTrans = doDbError
  m_lngDbErrId = clngErrTrans
  CommitTrans 
= clngErrTrans
End Function

Public Function Execute(ByVal strSQL As StringAs Long
  
On Error GoTo SkipErrCase

  
Execute = m_objOraDatabase.ExecuteSQL(strSQL)
  m_lngDbErrId 
= clngNormal
  
Execute = clngNormal
  
Exit Function
SkipErrCase:
  
Execute = doDbError
End Function

Public Function OpenRecordset(ByVal strSQL As String,  Optional ByVal varOption As OraDynType = CLng(0)) As Object
  
  
On Error GoTo SkipErrCase

  
Set OpenRecordset = m_objOraDatabase.DbCreateDynaset(strSQL, varOption)
  m_lngDbErrId 
= clngNormal
  
Exit Function
SkipErrCase:
  
Call doDbError
  
Set OpenRecordset = Nothing
End Function

Public Sub CloseDB()
  
If Not m_objOraDatabase Is Nothing Then
    m_objOraDatabase.Close
    
Set m_objOraDatabase = Nothing
  
End If
  
  
If Not m_objOraSession Is Nothing Then
    
Set m_objOraSession = Nothing
  
End If
End Sub

Public Function ParamsRemove(ByVal Name As StringAs Boolean
  
Dim blnRet As Boolean
  blnRet 
= removeParamsArray(Name)
  
If blnRet = True Then
    
Call m_objOraDatabase.Parameters.Remove(Name)
  
End If
  ParamsRemove 
= blnRet
End Function

Public Function ParamsAdd(ByVal Name As String, ByVal Value As Variant, ByVal ServerType As OraServerType, ByVal Derection As OraParamType) As Boolean
  
Dim blnRet As Boolean
  blnRet 
= addParamsArray(Name)
  
If blnRet = True Then
    
Call m_objOraDatabase.Parameters.Add(Name, Value, ServerType, Derection)
  
End If
  ParamsAdd 
= blnRet
End Function

Public Function ParamsGetValue(ByVal Name As StringAs Variant
  
On Error GoTo SkipErrPos
  ParamsGetValue 
= m_objOraDatabase.Parameters(Name).Value
  
Exit Function
SkipErrPos:
  ParamsGetValue 
= ""
End Function

Public Sub ParamsSetServerType(ByVal Name As String, ByVal ServerType As OraServerType)
  
On Error GoTo SkipErrPos
  m_objOraDatabase.Parameters(Name).ServerType 
= ServerType
End Sub

Private Function doDbError() As Long
  
'Screen.ActiveForm.Name
  If Not m_objOraDatabase Is Nothing Then
    m_lngDbErrId 
= m_objOraDatabase.LastServerErr
    m_strDbErrMsg 
= m_objOraDatabase.LastServerErrText
    doDbError 
= m_lngDbErrId
  
ElseIf Not m_objOraSession Is Nothing Then
    m_lngDbErrId 
= m_objOraSession.LastServerErr
    m_strDbErrMsg 
= m_objOraSession.LastServerErrText
    doDbError 
= m_lngDbErrId
  
Else
    m_lngDbErrId 
= clngError
    doDbError 
= clngErrNullSession
  
End If
End Function

Public Function ParamsGetNum() As Integer
  ParamsGetNum 
= m_intParams
End Function

Public Function ParamsGetNameAt(ByVal pvintIndex As IntegerAs String
  
If pvintIndex > m_intParams Then
    ParamsGetNameAt 
= ""
    Exit Function
  
End If
  ParamsGetNameAt 
= m_arrParams(pvintIndex)
End Function

Private Function addParamsArray(ByVal pvstrParamName As StringAs Boolean
  
Dim intNo As Integer
  
Dim arrTem() As String
  
Dim blgNew As Boolean
  blgNew 
= True
  
ReDim arrTem(m_intParams)
  
For intNo = 1 To m_intParams
    arrTem(intNo) 
= m_arrParams(intNo)
    
If blgNew = True And m_arrParams(intNo) = pvstrParamName Then
      blgNew 
= False
    
End If
  
Next intNo
  
  
If blgNew = True Then
    m_intParams 
= m_intParams + 1
    
ReDim m_arrParams(m_intParams)
    
For intNo = 1 To m_intParams - 1
      m_arrParams(intNo) 
= arrTem(intNo)
    
Next intNo
    m_arrParams(m_intParams) 
= pvstrParamName
  
End If
  
ReDim arrTem(0)
  addParamsArray 
= blgNew
End Function

Private Function removeParamsArray(ByVal pvstrParamName As StringAs Boolean
  
Dim intNo As Integer
  
Dim arrTem() As String
  
Dim blnRet As Boolean
  blnRet 
= False
  
For intNo = 1 To m_intParams
    
If m_arrParams(intNo) = pvstrParamName Then
      blnRet 
= True
      
Exit For
    
End If
  
Next intNo
  
  
If blnRet = True Then
    
ReDim arrTem(m_intParams - 1)
    
Dim intJ As Integer
    intJ 
= 1
    
For intNo = 1 To m_intParams
      
If m_arrParams(intNo) <> pvstrParamName Then
        arrTem(intJ) 
= m_arrParams(intNo)
        intJ 
= intJ + 1
      
End If
    
Next intNo
  
    m_intParams 
= m_intParams - 1
    
ReDim m_arrParams(m_intParams)
    
For intNo = 1 To m_intParams
      m_arrParams(intNo) 
= arrTem(intNo)
    
Next intNo
    
ReDim arrTem(0)
    blnRet 
= True
  
End If
  
  removeParamsArray 
= True
End Function

Public Sub ParamsRemoveAll()
  
On Error GoTo SkipEnd
  
Dim intNo As Integer
  
If m_objOraDatabase Is Nothing Then
    
GoTo SkipEnd
  
End If
  
For intNo = 1 To m_intParams
    
Call m_objOraDatabase.Parameters.Remove(m_arrParams(intNo))
  
Next intNo
SkipEnd:
  
ReDim m_arrParams(0)
  m_intParams 
= 0
End Sub

Vb对OO4O的封装

参照:http://blog.csdn.net/New_bug/archive/2004/08/07/67888.aspxPublic Enum OraParamType ORAPARM_INPUT...
  • jacky01130
  • jacky01130
  • 2008-07-03 13:44:00
  • 646

VB使用ADODB操作数据库

 VB使用ADODB操作数据库下面是我所掌握的使用ADO对数据库操作的一些常用方法,主要是提供给初学者作为参考,有不对的地方请指正。如有补充不胜荣幸准备工作========Dim conn As Ne...
  • zmhdgut
  • zmhdgut
  • 2008-06-12 23:34:00
  • 1870

VB中通过oo4o进行Oracle数据库操作-Update Delete Insert

 VB中通过oo4o更新数据  -  Update Delete Insert******************************************************  通过oo4...
  • smallboy_5
  • smallboy_5
  • 2008-10-06 16:52:00
  • 2249

oo4o 连接数据库操作

通过 oracle的oo4o对 数据库进行open操作的方法。
  • yinzhiqing
  • yinzhiqing
  • 2014-11-14 15:48:44
  • 2415

OO4O

Oracle 8.1.7数据库服务器上OO4O不能执行的问题:现象:1。用OO4O连接数据库的VB程序,在客户机上可以正确执行,但在Oracle 8.1.7的数据库服务器(Win2K)上却无法执行2。...
  • youki_yang
  • youki_yang
  • 2006-07-25 11:29:00
  • 1590

用oo4o访问oracle测试成功

程序访问oracle数据库失败,连接方式用的是ado。跟踪代码发现是ado创建连接时候就失败,上网查发现是win7sp1对ado进行了修改。 因为程序是vc6编写的,无法在win7下vc6,而程序比较...
  • wjb801
  • wjb801
  • 2014-08-28 10:22:43
  • 1105

Oracle oo4o vs2010 c++

废话不多说,直接讲代码 首先准备工作: 1 引用库 :获取方法就是,如果你安装了oracle 就会在:盘符:\app\用户名\product\11.2.0\dbhome_1\oo4o\CPP 目录...
  • cslin0907
  • cslin0907
  • 2015-05-25 10:46:01
  • 578

VB转换VB.net手顺的oo4o方面

  • 2011年09月23日 11:10
  • 1.34MB
  • 下载

oracle oo4o安装包part1

  • 2009年03月04日 12:41
  • 15MB
  • 下载

在vb.net中应用OO4O

先看一段程序:    Public Function excToArr(ByVal sql As String, ByVal ar As ArrayList) As ArrayList        ...
  • microsoftq
  • microsoftq
  • 2008-10-09 11:21:00
  • 977
收藏助手
不良信息举报
您举报文章:Vb对Oo4o的封装
举报原因:
原因补充:

(最多只允许输入30个字)