Public Dcnn As ADODB.Connection  '数据中心数据库连接   

Public Function ConnectToDB(ByVal DCCnn As String) As Boolean
'******************************
'函数名：
'       ConnectToDB
'函数说明：
'       建立与本地数据库的连接
'参数：
'******************************

    On Error GoTo ex:
    Set Rcnn = New ADODB.Connection
    Set Dcnn = New ADODB.Connection
   

'连本地ACCESS配置文件
    Rcnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.path & "csc.mdb;Mode=Read|Write|Share Deny None;Persist Security Info=False"
    'Rcnn.ConnectionString = "Provider=MSDAORA.1;Password=c;User ID=calldb;Data Source=calldb;Persist Security Info=True"
    Rcnn.CursorLocation = adUseClient
    Rcnn.ConnectionTimeout = 200
    Rcnn.Open
   

'连ORACLE[如果连接报错的朋友，请换MS的驱动MSDAORA.1]
    Dcnn.ConnectionString = "Provider=OraOLEDB.Oracle.1;Password=" & DCPassword & ";Persist Security Info=True;User ID=" & DCUserID & ";Data Source=" & DCDataSource
    Dcnn.CursorLocation = adUseClient
    Dcnn.ConnectionTimeout = 200
    Dcnn.Open
   
    ConnectToDB = True
    Exit Function
ex:
   
    MsgBox "连接数据库失败！" & Err.Description, , "提示"
    ConnectToDB = False
End Function

Public Function CmdDExecuteProc(ByVal procedureName As String, ByVal request As String, ByRef response As String) As Boolean
'******************************
'函数名：
'       CmdDExecuteProc
'函数说明：
'       执行存储过程，对数据中心数据库进行操作
'参数：
'       procedureName 存储过程名称
'       request 传入包
'       response 传出包
'******************************
On Error GoTo ErrHandle
    Dim cmd As New ADODB.Command
    Dim parRequest As New ADODB.Parameter
    Dim parResponse As New ADODB.Parameter
   
    cmd.CommandType = adCmdStoredProc
    cmd.ActiveConnection = Dcnn
   
    parRequest.Type = adBSTR
    parRequest.Direction = adParamInput
    parRequest.name = "@request"
    parRequest.Value = request
   
    parResponse.Type = adBSTR
    parResponse.Direction = adParamOutput
    parResponse.name = "@response"
   
    cmd.Parameters.Append parRequest
    cmd.Parameters.Append parResponse
   
    cmd.CommandText = procedureName
    cmd.Execute
    response = parResponse.Value
   
    Set cmd = Nothing
    CmdDExecuteProc = True
    Exit Function
ErrHandle:
    MsgBox "数据库操作时，意外错误发生，请稍后再试！", vbOKOnly
    WriteErrLog "CmdDExecuteProc", Err.Description, "存储过程名称:" & procedureName
    CmdDExecuteProc = False
End Function