跨数据库事务提交问题!!

飞鸿踏雪2018 2003-10-15 09:00:11

在VB中通过调用COM+实现跨数据库的事务提交(引用COM+ Services Type Library)，如果这两个数据库在同一网段内，则能正常运行，如果这两个数据库不在同一网段，则事务不能提交，每次都要回滚。其中一个函数的代码如下：

Public Function Set_DownFwFromDc(ByVal chrzzjgbm As String, ByVal DcZzjgbm As String, ByVal intgwlsh As Long, ByVal strConnOa As String, ByVal strConnDc As String)

On Error GoTo ErrHandle:

Dim ConnDc As New ADODB.Connection
Dim ConnOa As New ADODB.Connection
Dim RsDc As New ADODB.Recordset
Dim RsDc2 As New ADODB.Recordset
Dim RsOa As New ADODB.Recordset
Dim RsOa2 As New ADODB.Recordset
Dim strSql As String
Dim intOagwlsh As Long
Dim intgwfjlsh As Long

#If value = 1 Then
Dim objContext As COMSVCSLib.ObjectContext
Set objContext = GetObjectContext()
objContext.EnableCommit
#End If

If ConnOa.State <> 0 Then ConnOa.Close
If ConnDc.State <> 0 Then ConnDc.Close
ConnOa.Open strConnOa
ConnDc.Open strConnDc

'1、将重庆市工商局zfw、fjb表中的记录取到本单位OA的sbw、fjb中
'1.1添加到sbw
strSql = "select * from zfw where intgwlsh=" & CStr(intgwlsh)
RsDc.Open strSql, ConnDc, adOpenForwardOnly, adLockReadOnly
If Not RsDc.EOF Then
'先取得sbw表的流水号
strSql = "Execute prcGetAllLsh 'gwlsh'"
Set RsOa2 = ConnOa.Execute(strSql)
intOagwlsh = RsOa2.Fields(0).value
RsOa2.Close

strSql = "Select top 0 * from sbw"
RsOa.Open strSql, ConnOa, 1, 3
RsOa.AddNew
RsOa.Fields("intgwlsh").value = intOagwlsh
RsOa.Fields("chrgwz").value = RsDc.Fields("chrgwz").value
RsOa.Fields("intgwnh").value = RsDc.Fields("intgwnh").value
RsOa.Fields("intgwqh").value = RsDc.Fields("intgwqh").value
RsOa.Fields("chrzzjgbm").value = Trim(DcZzjgbm)
RsOa.Fields("dtmlwrq").value = Format(Now, "yyyy-mm-dd hh:mm")
RsOa.Fields("chrlwbt").value = Trim(RsDc.Fields("chrgwbt").value)
RsOa.Fields("intlwfs").value = 1
RsOa.Fields("intmjbm").value = RsDc.Fields("intmjbm").value
RsOa.Fields("intflbm").value = 0
RsOa.Fields("chrlwsy").value = ""
'RsOa.Fields("txtzw").value = Null
RsOa.Fields("intsxh").value = 0
'RsOa.Fields("chrsjr").value = Null
'RsOa.Fields("chrcbcs").value = Null
'RsOa.Fields("chrcbr").value = Null
'RsOa.Fields("txtcljg").value = Null
'RsOa.Fields("dtmbjrq").value = Null
If IsNull(RsDc.Fields("chrztc")) = False Then
RsOa.Fields("chrztc").value = Trim(RsDc.Fields("chrztc").value)
End If
'RsOa.Fields("txtlbyj").value = Null
RsOa.Fields("inthjcdbm").value = RsDc.Fields("inthjcdbm").value
RsOa.Fields("chrtzfs").value = "1"
RsOa.Fields("chrzzdz").value = "2"
RsOa.Fields("chrqbbz").value = "1"
'RsOa.Fields("chrlwqfr").value = Null
'RsOa.Fields("chrtsfjbz").value = Null
RsOa.Fields("chrGdbz").value = "0"
RsOa.Update
RsOa.Close
End If
RsDc.Close

'1.2添加到fjb
'正文稿的最后一稿
strSql = "select top 1 * from fjb where intgwlsh=" & CStr(intgwlsh) & " and intfjbh=1 order by intbbbh desc"
RsDc.Open strSql, ConnDc, adOpenForwardOnly, adLockReadOnly
Do While Not RsDc.EOF
'先取得附件的流水号
strSql = "Execute prcGetAllLsh 'intgwfjlsh'"
Set RsOa2 = ConnOa.Execute(strSql)
intgwfjlsh = RsOa2.Fields(0).value
RsOa2.Close

strSql = "Select top 0 * from fjb"
RsOa.Open strSql, ConnOa, 1, 3
RsOa.AddNew
RsOa.Fields("intgwfjlsh").value = intgwfjlsh
RsOa.Fields("intgwlsh").value = intOagwlsh
RsOa.Fields("chrfjlxbm").value = RsDc.Fields("chrfjlxbm").value
RsOa.Fields("intfjbh").value = RsDc.Fields("intfjbh").value
RsOa.Fields("chrfjmc").value = Trim(RsDc.Fields("chrfjmc").value)
RsOa.Fields("txtfj").value = RsDc.Fields("txtfj").value
RsOa.Fields("intbbbh").value = 1
RsOa.Update
RsOa.Close
' If IsNull(RsDc.Fields("txtfj").value) = False Then
' strSql = "select * from fjb where intgwfjlsh=" & CStr(intgwfjlsh)
' RsOa.Open strSql, ConnOa, adOpenKeyset, adLockOptimistic
' RsOa.Fields("txtfj").AppendChunk RsDc.Fields("txtfj").value
' RsOa.Update
' RsOa.Close
' End If
RsDc.MoveNext
Loop
RsDc.Close

'2、修改重庆市工商局fw的记录
strSql = "update fw set chrxzbz='1' where intgwlsh=" & CStr(intgwlsh) & " and chrzzjgbm='" & Trim(chrzzjgbm) & "'"
ConnDc.Execute (strSql)

#If value = 1 Then
If Not objContext Is Nothing Then objContext.SetComplete
If Not objContext Is Nothing Then Set objContext = Nothing
#End If

Set_DownFwFromDc = 1

Set RsDc = Nothing
Set RsDc2 = Nothing
Set RsOa = Nothing
Set RsOa2 = Nothing
If ConnOa.State <> 0 Then ConnOa.Close
If ConnDc.State <> 0 Then ConnDc.Close
Set ConnOa = Nothing
Set ConnDc = Nothing

Exit Function

ErrHandle:
WriteWrongLog Now(), Err.Number, Err.Description, strSql, "Set_DownFwFromDc"
Err.Clear
#If value = 1 Then
If Not objContext Is Nothing Then objContext.SetAbort
If Not objContext Is Nothing Then Set objContext = Nothing
#End If

Set_DownFwFromDc = 0

Set RsDc = Nothing
Set RsDc2 = Nothing
Set RsOa = Nothing
Set RsOa2 = Nothing
If ConnOa.State <> 0 Then ConnOa.Close
If ConnDc.State <> 0 Then ConnDc.Close
Set ConnOa = Nothing
Set ConnDc = Nothing

End Function

...全文