高手留步，帮我看看在VB中调用的Delphi写的COM组件如何在VC中调用,明天请吃肯德基

Question

Public Function Enroll(ByVal Str_Pid As String, Enrollx As X02EnrollDlgExportX) As Boolean       Dim Xagent As New BioXAgent  //Delphi写的com组件XAgent.dll的一部分       Dim Str_Enrollcount As String   '用户数量       Dim Str_UserID As String     '用户ID编号       Dim Int_Resultcode As Integer    'OnError事件发生后，处理结果信息代号       Dim Str_XagentData As String    'OnError 事件发生后，处理结果信息内容       Str_UserID = Str_Pid    '赋值给Str_UserID       Set Xagent = CreateObject("XAgent.BioXAgent")   '创建XAgent对象
       '设定相应Xagent的常量       '-------------------------------------------------------       Xagent.SetServerIP ("111.111.111.111")       Xagent.SetProductID ("STR111")       Xagent.SetDeviceType (12)       '--------------------------------------------------------       Xagent.GetEnrolledFinger (Str_UserID)  '取得已注册用户信息       Int_Resultcode = Xagent.GetResultCode  '取得处理结果代码       If Int_Resultcode = 0 Then  '0 代表操作成功
          MsgBox "使用者帐号重覆!", vbInformation, "提示信息"
   
          Set Xagent = Nothing
   
          Enroll = False
   
          Exit Function       End If       If (Int_Resultcode <> 56) And (Int_Resultcode <> 62) And (Int_Resultcode <> 14) Then  '不符合其中一个，即错误处理          MsgBox "异常出错 " & Int_Resultcode & "！", vbInformation, "错误代号"
   
          Enroll = False
   
          Exit Function
   
       End If       Str_XagentData = Xagent.GetXAgentData         Enrollx.SetXAgentData (Str_XagentData)   '输入Xagent系统参数值，资料由上一步操作取得       Enrollx.UserID = Str_UserID        '指定用户ID
       If Enrollx.Enroll = True Then          Xagent.SetData Enrollx.PacketUserData, Enrollx.PacketTemplateData  
          
          'Add By Kurt          Int_Resultcode = Xagent.GetResultCode  '取得处理结果代码
                    
          If Int_Resultcode = 0 Then
          
            'MsgBox "您已经注册成功，请登录系统", vbInformation, "提示信息"
            Enroll = True                          
          End If
          
          'End By Kurt
          
          Set Xagent = Nothing       Else          'MsgBox Enrollx.ResultMessage, vbCritical, "提示信息"
   
          Enroll = False
   
          Exit Function
   
       End IfEnd Function

Answer 1

一个帮助函数：
HRESULT AutoWrap(int autoType, VARIANT *pvResult, IDispatch *pDisp, LPOLESTR ptName, int cArgs...) {
    // Begin variable-argument list...
    va_list er;
    va_start(er, cArgs);    if(!pDisp) {
        MessageBox(NULL, "NULL IDispatch passed to AutoWrap()", "Error", 0x10010);
        _exit(0);
    }    // Variables used...
    DISPPARAMS dp = { NULL, NULL, 0, 0 };
    DISPID dispidNamed = DISPID_PROPERTYPUT;
    DISPID dispID;
    HRESULT hr;
    char buf[200];
    char szName[200];
    
    // Convert down to ANSI
    WideCharToMultiByte(CP_ACP, 0, ptName, -1, szName, 256, NULL, NULL);
    
    // Get DISPID for name passed...
    hr = pDisp->GetIDsOfNames(IID_NULL, &ptName, 1, LOCALE_USER_DEFAULT, &dispID);
    if(FAILED(hr)) {
        sprintf(buf, "IDispatch::GetIDsOfNames(\"%s\") failed w/err 0x%08lx", szName, hr);
        MessageBox(NULL, buf, "AutoWrap()", 0x10010);
        _exit(0);
        return hr;
    }
    
    // Allocate memory for arguments...
    VARIANT *pArgs = new VARIANT[cArgs+1];
    // Extract arguments...
    for(int i=0; i<cArgs; i++) {
        pArgs[i] = va_arg(er, VARIANT);
    }
    
    // Build DISPPARAMS
    dp.cArgs = cArgs;
    dp.rgvarg = pArgs;
    
    // Handle special-case for property-puts!
    if(autoType & DISPATCH_PROPERTYPUT) {
        dp.cNamedArgs = 1;
        dp.rgdispidNamedArgs = &dispidNamed;
    }
    
    // Make the call!
    hr = pDisp->Invoke(dispID, IID_NULL, LOCALE_SYSTEM_DEFAULT, autoType, &dp, pvResult, NULL, NULL);
    if(FAILED(hr)) {
        sprintf(buf, "IDispatch::Invoke(\"%s\"=%08lx) failed w/err 0x%08lx", szName, dispID, hr);
        MessageBox(NULL, buf, "AutoWrap()", 0x10010);
        _exit(0);
        return hr;
    }
    // End variable-argument section...
    va_end(er);
    
    delete [] pArgs;
    
    return hr;
}

Answer 2

VARIANT root[64] = {0}; // Generic IDispatchs
    VARIANT parm[64] = {0}; // Generic Parameters
    VARIANT rVal = {0}; // Temporary result holder
    int level=0; // Current index into root[]    // Initialize the OLE Library...
    OleInitialize(NULL);    // Line 1: Public Function Enroll ByVal Str_Pid As String , Enrollx As X02EnrollDlgExportX As Boolean 
    VARIANT Public = {0};
    VariantCopy(&Public, &rVal);    // Line 2: Dim Xagent As New BioXAgent 
    VARIANT Xagent = {0};    // Line 3: Dim Str_Enrollcount As String 
    VARIANT Str_Enrollcount = {0};    // Line 4: Dim Str_UserID As String 
    VARIANT Str_UserID = {0};    // Line 5: Dim Int_Resultcode As Integer 
    VARIANT Int_Resultcode = {0};    // Line 6: Dim Str_XagentData As String 
    VARIANT Str_XagentData = {0};    // Line 7: Str_UserID = Str_Pid 
    VariantCopy(&rVal, &Str_Pid);
    VariantCopy(&Str_UserID, &rVal);
    VariantClear(&rVal);    // Line 8: Set Xagent = CreateObject XAgent.BioXAgent 
    {
        CLSID clsid;
        CLSIDFromProgID(L"XAgent.BioXAgent", &clsid);
        HRESULT hr = CoCreateInstance(clsid, NULL, CLSCTX_LOCAL_SERVER|CLSCTX_INPROC_SERVER, IID_IDispatch, (void **)&rVal.pdispVal);
        if(FAILED(hr)) {
            char buf[256];
            sprintf(buf, "CoCreateInstance() for \"XAgent.BioXAgent\" failed. Err=%08lx", hr);
            ::MessageBox(NULL, buf, "Error", 0x10010);
            _exit(0);
        }
        rVal.vt = VT_DISPATCH;
    }
    VariantCopy(&Xagent, &rVal);
    VariantClear(&rVal);    // Line 9: Xagent . SetServerIP 111.111.111.111 
    VariantCopy(&root[++level], &Xagent);
    parm[0].vt = VT_BSTR; parm[0].bstrVal = ::SysAllocString(L"111.111.111.111");
    AutoWrap(DISPATCH_METHOD, NULL, root[level].pdispVal, L"SetServerIP", 1, parm[0]);
    VariantClear(&parm[0]);
    VariantClear(&root[level--]);    // Line 10: Xagent . SetProductID STR111 
    VariantCopy(&root[++level], &Xagent);
    parm[0].vt = VT_BSTR; parm[0].bstrVal = ::SysAllocString(L"STR111");
    AutoWrap(DISPATCH_METHOD, NULL, root[level].pdispVal, L"SetProductID", 1, parm[0]);
    VariantClear(&parm[0]);
    VariantClear(&root[level--]);    // Line 11: Xagent . SetDeviceType 12 
    VariantCopy(&root[++level], &Xagent);
    parm[0].vt = VT_I4; parm[0].lVal = 12;
    AutoWrap(DISPATCH_METHOD, NULL, root[level].pdispVal, L"SetDeviceType", 1, parm[0]);
    VariantClear(&parm[0]);
    VariantClear(&root[level--]);    // Line 12: Xagent . GetEnrolledFinger Str_UserID 
    VariantCopy(&root[++level], &Xagent);
    VariantCopy(&parm[0], &Str_UserID);
    AutoWrap(DISPATCH_METHOD, NULL, root[level].pdispVal, L"GetEnrolledFinger", 1, parm[0]);
    VariantClear(&parm[0]);
    VariantClear(&root[level--]);    // Line 13: Int_Resultcode = Xagent . GetResultCode 
    VariantCopy(&root[++level], &Xagent);
    AutoWrap(DISPATCH_PROPERTYGET|DISPATCH_METHOD, &rVal, root[level].pdispVal, L"GetResultCode", 0);
    VariantClear(&root[level--]);
    VariantCopy(&Int_Resultcode, &rVal);
    VariantClear(&rVal);    // Line 14: If Int_Resultcode = 0 Then 
    {
        VariantCopy(&rVal, &Int_Resultcode);
        VARIANT tmp = {0};
        VariantCopy(&tmp, &rVal);
        VariantClear(&rVal);
        rVal.vt = VT_I4;
        rVal.lVal = 0;
        VariantChangeType(&tmp, &tmp, 0, VT_R8);
        VariantChangeType(&rVal, &rVal, 0, VT_R8);
        int exp = tmp.dblVal == rVal.dblVal;
        if(exp) {
            VariantClear(&rVal);            // Line 15: MsgBox &Ecirc;&sup1;&Oacute;&Atilde;&Otilde;&szlig;&Otilde;&Ecirc;&ordm;&Aring;&Ouml;&Oslash;&cedil;&sup2;! , vbInformation , &Igrave;á&Ecirc;&frac34;&ETH;&Aring;&Iuml;&cent; 
            ::MessageBox(NULL, "&Ecirc;&sup1;&Oacute;&Atilde;&Otilde;&szlig;&Otilde;&Ecirc;&ordm;&Aring;&Ouml;&Oslash;&cedil;&sup2;!", "MsgBox", MB_SETFOREGROUND);            // Line 16:             // Line 17: Set Xagent = Nothing 
            VariantClear(&Xagent);            // Line 18:             // Line 19: Enroll = 0 
            rVal.vt = VT_I4;
            rVal.lVal = 0;
            VARIANT Enroll = {0};
            VariantCopy(&Enroll, &rVal);
            VariantClear(&rVal);            // Line 20:             // Line 21: Exit Function 
            VARIANT Exit = {0};
            VariantCopy(&Exit, &rVal);            // Line 22: End If 
        }
    }    // Line 23: If Int_Resultcode <> 56 And Int_Resultcode <> 62 And Int_Resultcode <> 14 Then 
    {
        VariantCopy(&rVal, &Int_Resultcode);
        VARIANT tmp = {0};
        VariantCopy(&tmp, &rVal);
        VariantClear(&rVal);
        rVal.vt = VT_I4;
        rVal.lVal = 56;
        VariantChangeType(&tmp, &tmp, 0, VT_R8);
        VariantChangeType(&rVal, &rVal, 0, VT_R8);
        int exp = tmp.dblVal != rVal.dblVal;
        if(exp) {
            VariantClear(&rVal);            // Line 24: MsgBox &Ograve;ì&sup3;&pound;&sup3;&ouml;&acute;í  Int_Resultcode &pound;&iexcl; , vbInformation , &acute;í&Icirc;ó&acute;ú&ordm;&Aring; 
            ::MessageBox(NULL, "&Ograve;ì&sup3;&pound;&sup3;&ouml;&acute;í ", "MsgBox", MB_SETFOREGROUND);            // Line 25:             // Line 26: Enroll = 0 
            rVal.vt = VT_I4;
            rVal.lVal = 0;
            VariantCopy(&Enroll, &rVal);
            VariantClear(&rVal);            // Line 27:             // Line 28: Exit Function 
            VariantCopy(&Exit, &rVal);            // Line 29:             // Line 30: End If 
        }
    }

Answer 3

// Line 31: Str_XagentData = Xagent . GetXAgentData 
    VariantCopy(&root[++level], &Xagent);
    AutoWrap(DISPATCH_PROPERTYGET|DISPATCH_METHOD, &rVal, root[level].pdispVal, L"GetXAgentData", 0);
    VariantClear(&root[level--]);
    VariantCopy(&Str_XagentData, &rVal);
    VariantClear(&rVal);    // Line 32: Enrollx . SetXAgentData Str_XagentData 
    VariantCopy(&parm[1], &Str_XagentData);
    AutoWrap(DISPATCH_METHOD, NULL, root[level].pdispVal, L".", 2, parm[1], parm[0]);
    VariantClear(&parm[0]);
    VariantClear(&parm[1]);    // Line 33: Enrollx . UserID = Str_UserID 
    VariantCopy(&rVal, &Str_UserID);
    AutoWrap(DISPATCH_PROPERTYPUT, NULL, root[level].pdispVal, L".", 2, rVal, parm[0]);
    VariantClear(&parm[0]);
    VariantClear(&rVal);    // Line 34: If Enrollx . Enroll = 1 Then 
    {
        VariantCopy(&parm[0], &Enroll);
        AutoWrap(DISPATCH_PROPERTYGET|DISPATCH_METHOD, &rVal, root[level].pdispVal, L".", 1, parm[0]);
        VariantClear(&parm[0]);
        VARIANT tmp = {0};
        VariantCopy(&tmp, &rVal);
        VariantClear(&rVal);
        rVal.vt = VT_I4;
        rVal.lVal = 1;
        VariantChangeType(&tmp, &tmp, 0, VT_R8);
        VariantChangeType(&rVal, &rVal, 0, VT_R8);
        int exp = tmp.dblVal == rVal.dblVal;
        if(exp) {
            VariantClear(&rVal);            // Line 35: Xagent . SetData Enrollx . PacketUserData , Enrollx . PacketTemplateData 
            VariantCopy(&root[++level], &Xagent);
            AutoWrap(DISPATCH_PROPERTYGET|DISPATCH_METHOD, &root[level+1], root[level++].pdispVal, L"SetData", 1, parm[0]);
            VariantClear(&parm[0]);
            parm[0].vt = VT_ERROR; parm[0].scode = DISP_E_PARAMNOTFOUND;
            AutoWrap(DISPATCH_PROPERTYGET|DISPATCH_METHOD, &root[level+1], root[level++].pdispVal, L"PacketUserData", 2, parm[1], parm[0]);
            VariantClear(&parm[0]);
            VariantClear(&parm[1]);
            AutoWrap(DISPATCH_METHOD, NULL, root[level].pdispVal, L"PacketTemplateData", 0);
            VariantClear(&root[level--]);
            VariantClear(&root[level--]);
            VariantClear(&root[level--]);            // Line 36:             // Line 37: Int_Resultcode = Xagent . GetResultCode 
            VariantCopy(&root[++level], &Xagent);
            AutoWrap(DISPATCH_PROPERTYGET|DISPATCH_METHOD, &rVal, root[level].pdispVal, L"GetResultCode", 0);
            VariantClear(&root[level--]);
            VariantCopy(&Int_Resultcode, &rVal);
            VariantClear(&rVal);            // Line 38:             // Line 39: If Int_Resultcode = 0 Then 
            {
                VariantCopy(&rVal, &Int_Resultcode);
                VARIANT tmp = {0};
                VariantCopy(&tmp, &rVal);
                VariantClear(&rVal);
                rVal.vt = VT_I4;
                rVal.lVal = 0;
                VariantChangeType(&tmp, &tmp, 0, VT_R8);
                VariantChangeType(&rVal, &rVal, 0, VT_R8);
                int exp = tmp.dblVal == rVal.dblVal;
                if(exp) {
                    VariantClear(&rVal);                    // Line 40:                     // Line 41: Enroll = 1 
                    rVal.vt = VT_I4;
                    rVal.lVal = 1;
                    VariantCopy(&Enroll, &rVal);
                    VariantClear(&rVal);                    // Line 42:                     // Line 43: End If 
                }
            }            // Line 44:             // Line 45:             // Line 46: Set Xagent = Nothing 
            VariantClear(&Xagent);            // Line 47: Else 
            VARIANT Else = {0};
            VariantCopy(&Else, &rVal);            // Line 48:             // Line 49: Enroll = 0 
            rVal.vt = VT_I4;
            rVal.lVal = 0;
            VariantCopy(&Enroll, &rVal);
            VariantClear(&rVal);            // Line 50:             // Line 51: Exit Function 
            VariantCopy(&Exit, &rVal);            // Line 52:             // Line 53: End If 
        }
    }    // Line 54: End Function     // Clearing variables
    VariantClear(&Public);
    VariantClear(&Xagent);
    VariantClear(&Str_Enrollcount);
    VariantClear(&Str_UserID);
    VariantClear(&Int_Resultcode);
    VariantClear(&Str_XagentData);
    VariantClear(&Enroll);
    VariantClear(&Exit);
    VariantClear(&Else);    // Close the OLE Library...
    OleUninitialize();

Answer 4

Many Thanks! but could you give a sample for this item