最近我们写的一些组件出了个问题。在服务器端,这些组件无论是调试还是通过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

解决方案 »

  1.   

    返回的HRESULT是失败的,RPC层报告的对象死亡
      

  2.   

    在客户端也重新注册一下1、将编译时生成的VBR文件(如果没有生成VBR文件,则在VB环境中选择工程属性,将属性页中“组件”页的“远程服务器文件”选择框选上,然后重新编译,就会生成VBR文件)拷贝到客户机上,然后用clireg32.exe打开。
    2、在弹出的对话窗口中选择“DCOM”项,并在IP地址栏输入服务器的IP地址!