最近我们写的一些组件出了个问题。在服务器端,这些组件无论是调试还是通过EXE程序调用都没有任何问题,但是在客户端的机器上就出现了 “462--远程服务不存在或找不到”的问题。
比如今天对一个组件新加了两个接口,这两个接口在服务器端调用是没有问题的,但是在客户端调用这两个接口时就出现了错误。但是对于其他原有的接口无论是服务器端调用还是客户端调用都没有任何问题。该组件修改后在服务器上注册过,并且打包生成了一个客户端安装包,在客户端也成功安装过。
恳请各位路过的高人给指点指点。
代码如下:新增接口=====================
Public Function CaseEnd(ByVal BillSeq_o As Variant, Optional ByVal MtrlNo_o As Variant _
, Optional ByVal EndMan As Variant, Optional ByVal Comments As Variant) As String
On Error GoTo errhandle
Dim errMsg As String
errMsg = "01_"
Dim objMtrlIsuOrd As dbMtrlIsuOrd.clsdbMtrlIsuOrd
Set objMtrlIsuOrd = CreateObject("dbMtrlIsuOrd.clsdbMtrlIsuOrd")
errMsg = "02_"Dim rs As New ADODB.RecordsetSet rs = objMtrlIsuOrd.Query(BillSeq_o, MtrlNo_o)
errMsg = "03_"If rs.RecordCount = 0 Then
Err.Number = 50000
Err.Description = "没有查到要结案的单椐!"
errMsg = "没有查到要结案的单椐!"
GoTo errhandle
End Ifrs.MoveFirst
Do While Not rs.EOF
If rs.Fields("AddUpQty").Value = 0 Then
Err.Number = 50000
Err.Description = "无后续动作,请使用删除功能!"
errMsg = "无后续动作,请使用删除功能!"
GoTo errhandle
End If
rs.MoveNext
Looprs.MoveFirst
Do While Not rs.EOF
Call objMtrlIsuOrd.Update(rs.Fields("BillSeq"), rs.Fields("MtrlNo") _
, , , , , , , , , , , , , , , , , , , 2, Comments, , EndMan)
errMsg = "04_" rs.MoveNext
Loop
GetObjectContext.SetComplete
Set objMtrlIsuOrd = NothingExit Function
errhandle:
MsgBox Modname & ".CaseEnd" & errMsg & Error
strErrDesc = Err.Description
GetObjectContext.SetAbort
Err.Raise Err.Number, Err.Source, Err.Description
Set objMtrlIsuOrd = Nothing
End Function
原来接口
==================
Public Function Delete(ByVal BillSeq As Variant, Optional ByVal MtrlNo As Variant _
, Optional ByVal AssetID As Variant, Optional ByVal basOrdNo As Variant, Optional ByVal basBillNo As Variant _
, Optional ByVal basNo As Variant, Optional ByVal PlnType As Variant, Optional ByVal RequitDate As Variant _
, Optional ByVal StdUnit As Variant, Optional ByVal PlnQty As Variant, Optional ByVal AddUpQty As Variant _
, Optional ByVal DeptID As Variant, Optional ByVal SftGrpID As Variant, Optional ByVal ManID As Variant _
, Optional ByVal DeptChk As Variant, Optional ByVal DeptDate As Variant, Optional ByVal CmpyChk As Variant _
, Optional ByVal CmpyDate As Variant, Optional ByVal Status As Variant, Optional ByVal Comments As Variant _
, Optional ByVal PerdNo As Variant, Optional ByVal Creater As Variant, Optional ByVal CrtTime As Variant) As Integer
On Error GoTo errhandle
Dim errMsg As String
Dim ChkFlag As Integer
ChkFlag = 0errMsg = "01_"Dim objMtrlIsuOrd As dbMtrlIsuOrd.clsdbMtrlIsuOrd
Set objMtrlIsuOrd = CreateObject("dbMtrlIsuOrd.clsdbMtrlIsuOrd")Dim rs As New ADODB.Recordset
Set rs = objMtrlIsuOrd.Query(BillSeq, MtrlNo)
If rs.RecordCount = 0 Then
Err.Number = 50000
Err.Description = "没有查到要删除的单据!"
errMsg = "没有查到要删除的单据!"
GoTo errhandle
End Ifrs.MoveFirst
Do While Not rs.EOF
If rs.Fields("AddUpQty") > 0 Then
Err.Number = 50000
Err.Description = "已有后续动作,不能删除!"
errMsg = "已有后续动作,不能删除!"
GoTo errhandle
End If
rs.MoveNext
Loop
errMsg = "02_"rs.MoveFirst
Do While Not rs.EOF
Call objMtrlIsuOrd.Delete(CStr(rs.Fields("BillSeq")), CStr(rs.Fields("MtrlNo")))
rs.MoveNext
LoopGetObjectContext.SetComplete
Set objMtrlIsuOrd = NothingExit Function
errhandle:
MsgBox Modname & ".delete" & errMsg & Error
strErrDesc = Err.Description
GetObjectContext.SetAbort
Err.Raise Err.Number, Err.Source, Err.Description
Set objMtrlIsuOrd = Nothing
End Function
========================================
客户端调用如下:
=========================================
调用新添加的结案接口
Private Sub cmdEndCase_Click()
On Error GoTo err_exit
If Me.grdRcpt_qry.ApproxCount = 0 Then
MsgBox "请首先查询结案记录!"
Exit Sub
End If
If MsgBox("单据号:" + CStr(Me.grdRcpt_qry.Columns("BillSeq")) + ",料号:" + CStr(Me.grdRcpt_qry.Columns("MtrlNo")) + "要结案吗?", vbYesNo) = vbNo Then
Exit Sub
End If
Dim objMtrlIsuOrd As busMtrlIsuOrd.clsbusMtrlIsuOrd
Set objMtrlIsuOrd = CreateObject("busMtrlIsuOrd.clsbusMtrlIsuOrd")
Call objMtrlIsuOrd.CaseEnd(Me.grdRcpt_qry.Columns("BillSeq"), Me.grdRcpt_qry.Columns("MtrlNo"), frmLogin.txtUserName)
MsgBox "结案成功!"
Exit Sub
err_exit:
Me.MousePointer = vbCustom
MsgBox Err.Source + ":" + Err.Description, , Err.NumberEnd Sub调用原来的删除接口
===================
Private Sub cmdDel_Click()
On Error GoTo err_exit
If MsgBox("确认要删除申领单:" + Me.grdRcpt_qry.Columns("BillSeq") + "吗?", vbYesNo) vbNo Then
Exit Sub
End If
Dim objMtrlIsuOrd As busMtrlIsuOrd.clsbusMtrlIsuOrd
Set objMtrlIsuOrd = CreateObject("busMtrlIsuOrd.clsbusMtrlIsuOrd")
Dim rs As New ADODB.Recordset
Set rs = objMtrlIsuOrd.Query(CStr(Me.grdRcpt_qry.Columns("BillSeq")), , , , , , , , , , , , , , , , , , , , , , , " and AddUpQty>0 ")
If rs.RecordCount > 0 Then
MsgBox "已收料,不能删除!"
Exit Sub
End If
Call objMtrlIsuOrd.Delete(CStr(Me.grdRcpt_qry.Columns("BillSeq")))
Set objMtrlIsuOrd = Nothing
Set Me.grdRcpt_qry.DataSource = Nothing
MsgBox "删除成功!"
Exit Sub
err_exit:
Set objMtrlIsuOrd = Nothing
MsgBox Err.Source + ":" + Err.Description, , Err.Number
End Sub
比如今天对一个组件新加了两个接口,这两个接口在服务器端调用是没有问题的,但是在客户端调用这两个接口时就出现了错误。但是对于其他原有的接口无论是服务器端调用还是客户端调用都没有任何问题。该组件修改后在服务器上注册过,并且打包生成了一个客户端安装包,在客户端也成功安装过。
恳请各位路过的高人给指点指点。
代码如下:新增接口=====================
Public Function CaseEnd(ByVal BillSeq_o As Variant, Optional ByVal MtrlNo_o As Variant _
, Optional ByVal EndMan As Variant, Optional ByVal Comments As Variant) As String
On Error GoTo errhandle
Dim errMsg As String
errMsg = "01_"
Dim objMtrlIsuOrd As dbMtrlIsuOrd.clsdbMtrlIsuOrd
Set objMtrlIsuOrd = CreateObject("dbMtrlIsuOrd.clsdbMtrlIsuOrd")
errMsg = "02_"Dim rs As New ADODB.RecordsetSet rs = objMtrlIsuOrd.Query(BillSeq_o, MtrlNo_o)
errMsg = "03_"If rs.RecordCount = 0 Then
Err.Number = 50000
Err.Description = "没有查到要结案的单椐!"
errMsg = "没有查到要结案的单椐!"
GoTo errhandle
End Ifrs.MoveFirst
Do While Not rs.EOF
If rs.Fields("AddUpQty").Value = 0 Then
Err.Number = 50000
Err.Description = "无后续动作,请使用删除功能!"
errMsg = "无后续动作,请使用删除功能!"
GoTo errhandle
End If
rs.MoveNext
Looprs.MoveFirst
Do While Not rs.EOF
Call objMtrlIsuOrd.Update(rs.Fields("BillSeq"), rs.Fields("MtrlNo") _
, , , , , , , , , , , , , , , , , , , 2, Comments, , EndMan)
errMsg = "04_" rs.MoveNext
Loop
GetObjectContext.SetComplete
Set objMtrlIsuOrd = NothingExit Function
errhandle:
MsgBox Modname & ".CaseEnd" & errMsg & Error
strErrDesc = Err.Description
GetObjectContext.SetAbort
Err.Raise Err.Number, Err.Source, Err.Description
Set objMtrlIsuOrd = Nothing
End Function
原来接口
==================
Public Function Delete(ByVal BillSeq As Variant, Optional ByVal MtrlNo As Variant _
, Optional ByVal AssetID As Variant, Optional ByVal basOrdNo As Variant, Optional ByVal basBillNo As Variant _
, Optional ByVal basNo As Variant, Optional ByVal PlnType As Variant, Optional ByVal RequitDate As Variant _
, Optional ByVal StdUnit As Variant, Optional ByVal PlnQty As Variant, Optional ByVal AddUpQty As Variant _
, Optional ByVal DeptID As Variant, Optional ByVal SftGrpID As Variant, Optional ByVal ManID As Variant _
, Optional ByVal DeptChk As Variant, Optional ByVal DeptDate As Variant, Optional ByVal CmpyChk As Variant _
, Optional ByVal CmpyDate As Variant, Optional ByVal Status As Variant, Optional ByVal Comments As Variant _
, Optional ByVal PerdNo As Variant, Optional ByVal Creater As Variant, Optional ByVal CrtTime As Variant) As Integer
On Error GoTo errhandle
Dim errMsg As String
Dim ChkFlag As Integer
ChkFlag = 0errMsg = "01_"Dim objMtrlIsuOrd As dbMtrlIsuOrd.clsdbMtrlIsuOrd
Set objMtrlIsuOrd = CreateObject("dbMtrlIsuOrd.clsdbMtrlIsuOrd")Dim rs As New ADODB.Recordset
Set rs = objMtrlIsuOrd.Query(BillSeq, MtrlNo)
If rs.RecordCount = 0 Then
Err.Number = 50000
Err.Description = "没有查到要删除的单据!"
errMsg = "没有查到要删除的单据!"
GoTo errhandle
End Ifrs.MoveFirst
Do While Not rs.EOF
If rs.Fields("AddUpQty") > 0 Then
Err.Number = 50000
Err.Description = "已有后续动作,不能删除!"
errMsg = "已有后续动作,不能删除!"
GoTo errhandle
End If
rs.MoveNext
Loop
errMsg = "02_"rs.MoveFirst
Do While Not rs.EOF
Call objMtrlIsuOrd.Delete(CStr(rs.Fields("BillSeq")), CStr(rs.Fields("MtrlNo")))
rs.MoveNext
LoopGetObjectContext.SetComplete
Set objMtrlIsuOrd = NothingExit Function
errhandle:
MsgBox Modname & ".delete" & errMsg & Error
strErrDesc = Err.Description
GetObjectContext.SetAbort
Err.Raise Err.Number, Err.Source, Err.Description
Set objMtrlIsuOrd = Nothing
End Function
========================================
客户端调用如下:
=========================================
调用新添加的结案接口
Private Sub cmdEndCase_Click()
On Error GoTo err_exit
If Me.grdRcpt_qry.ApproxCount = 0 Then
MsgBox "请首先查询结案记录!"
Exit Sub
End If
If MsgBox("单据号:" + CStr(Me.grdRcpt_qry.Columns("BillSeq")) + ",料号:" + CStr(Me.grdRcpt_qry.Columns("MtrlNo")) + "要结案吗?", vbYesNo) = vbNo Then
Exit Sub
End If
Dim objMtrlIsuOrd As busMtrlIsuOrd.clsbusMtrlIsuOrd
Set objMtrlIsuOrd = CreateObject("busMtrlIsuOrd.clsbusMtrlIsuOrd")
Call objMtrlIsuOrd.CaseEnd(Me.grdRcpt_qry.Columns("BillSeq"), Me.grdRcpt_qry.Columns("MtrlNo"), frmLogin.txtUserName)
MsgBox "结案成功!"
Exit Sub
err_exit:
Me.MousePointer = vbCustom
MsgBox Err.Source + ":" + Err.Description, , Err.NumberEnd Sub调用原来的删除接口
===================
Private Sub cmdDel_Click()
On Error GoTo err_exit
If MsgBox("确认要删除申领单:" + Me.grdRcpt_qry.Columns("BillSeq") + "吗?", vbYesNo) vbNo Then
Exit Sub
End If
Dim objMtrlIsuOrd As busMtrlIsuOrd.clsbusMtrlIsuOrd
Set objMtrlIsuOrd = CreateObject("busMtrlIsuOrd.clsbusMtrlIsuOrd")
Dim rs As New ADODB.Recordset
Set rs = objMtrlIsuOrd.Query(CStr(Me.grdRcpt_qry.Columns("BillSeq")), , , , , , , , , , , , , , , , , , , , , , , " and AddUpQty>0 ")
If rs.RecordCount > 0 Then
MsgBox "已收料,不能删除!"
Exit Sub
End If
Call objMtrlIsuOrd.Delete(CStr(Me.grdRcpt_qry.Columns("BillSeq")))
Set objMtrlIsuOrd = Nothing
Set Me.grdRcpt_qry.DataSource = Nothing
MsgBox "删除成功!"
Exit Sub
err_exit:
Set objMtrlIsuOrd = Nothing
MsgBox Err.Source + ":" + Err.Description, , Err.Number
End Sub
2、在弹出的对话窗口中选择“DCOM”项,并在IP地址栏输入服务器的IP地址!