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进行Oracle数据库操作-Update Delete Insert

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

VB封装DLL实例(一)

正 文: 一、  DLL基本概念 (一)概念 DLL即动态链接库(Dynamic Link Library),是由可被其它程序调用的函数集合组成的可执行文件模块。DLL不是应用程序的组成部分,而是运行...
  • miaoyangzhi
  • miaoyangzhi
  • 2017年02月11日 17:30
  • 449

VB6基本数据库应用(一):数据库基础

这是本套教程的第一课,讲述的是数据库结构的基础。学好数据库就必须了解清楚数据库的结构,其实并不困难。本套教程将从最基础的开始来讲述VB6的基础数据库操作。...
  • JiLuoXingRen
  • JiLuoXingRen
  • 2013年07月24日 17:14
  • 9823

关于VB方法返回值为值类型时,出现要求对象的理解

今天写代码时,要写一个带返回值的方法,如下: '更新数据库操作 Public Function ExecuteCommand(ByVal strSql As String, _ ...
  • yanzhibo
  • yanzhibo
  • 2013年03月26日 15:56
  • 3172

VB封装DLL实例(二)

正 文: 上文中我们已经就DLL的基本概念,以及如何将VBA代码封装为DLL,如何引用该生成的DLL动态链接库,进行了初步的讲解,我想大家对于VB封装DLL应该有了一个初步的了解。 下面主要就DL...
  • miaoyangzhi
  • miaoyangzhi
  • 2017年02月11日 17:37
  • 882

VB6多线程探秘

VB6稳定多线程,一直是争论很大的的。 比较稳定的多线程,一般使用 set MT=CreateObject("VbMT.MT") 但其他单元线程之间,是无法访问的,只有在创建者中,才可使用该对象...
  • test2002
  • test2002
  • 2016年09月08日 17:33
  • 1233

VB6 正则表达式提取内容

今天帮同事做一个数据对接,从返回的数据中提取想要的部分。返回的是一个WebService结果,由外圈的XML标记和中间的有效内容组成,现在要把有效内容取出来,VB6.0实现。 下面是返回的内容: ...
  • zhouyingge1104
  • zhouyingge1104
  • 2015年12月07日 14:00
  • 4505

浅谈VB6中的自定义类的使用

[SHR]浅谈VB6中的自定义类的使用    PS:除非特别声明,本文所说VB指的是VB6,而非VB.NET。    大家都知道,VB是一种半面向对象(也有人称之为“伪面向对象”)的语言,...
  • chinajobs
  • chinajobs
  • 2015年06月30日 11:28
  • 2597

【VB6】实现VB6中类的静态方法

原创文章,欢迎支持 在VB的使用过程中,较为高级和较为具有兼容性的编程方式是创建类模块。 比如创建了一个数组创建类,专门用来创建特定类型的数组,它被存在一个“ArrayHelper.cls”文件中...
  • greatbody
  • greatbody
  • 2016年02月13日 19:52
  • 1242

VB封装DLL文件讲解---3

VB中的模块,类,ActiveX与API的使用 一、模块 (Module)   在VB中,模块会优先执行,其实说白了,模块就象是全局的过程和函数调用。这是初步的提高代码可复用性的途径。...
  • yiyiyicz
  • yiyiyicz
  • 2013年12月04日 09:20
  • 3185
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:Vb对Oo4o的封装
举报原因:
原因补充:

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