会delphi的朋友请进：关于调用vc组件含safearray参数的方法，帮忙up也一定送分！

Question

C的是不是这个
typedef struct tagSAFEARRAYBOUND {
   unsigned long cElements;
   long lLbound;
} SAFEARRAYBOUND;typedef struct FARSTRUCT tagSAFEARRAY {
   unsigned short cDims;       // Count of dimensions in this array.
   unsigned short fFeatures;   // Flags used by the SafeArray
                        // routines documented below.
#if defined(WIN32)
   unsigned long cbElements;   // Size of an element of the array.
                        // Does not include size of
                        // pointed-to data.
   unsigned long cLocks;      // Number of times the array has been
                        // locked without corresponding unlock.
#else
   unsigned short cbElements;
   unsigned short cLocks;
   unsigned long handle;      // Used on Macintosh only.
#endif
   void HUGEP* pvData;             // Pointer to the data.
   SAFEARRAYBOUND rgsabound[1];      // One bound for each dimension.
} SAFEARRAY;To Delphi:type
  PSafeArrayBound = ^TSafeArrayBound;
  tagSafeArrayBound = record
    cElements: DWORD;
    lLbound: LongInt;
  end;
  TSafeArrayBound = tagSafeArrayBound;  PSafeArray = ^TSafeArray;
  tagSafeArray = record
    cDims: Word;
    fFeatures: Word;
  {$IFDEF WIN32}
    cbElements: DWORD;
    cLocks: DWORD;
  {$ELSE}
    cbElements: Word;
    cLocks: Word;
    Handle: DWORD;
  {$ENDIF}
    pvData: Pointer;
    rgsabound: array [0..0] of TSafeArrayBound;
  end;
  TSafeArray = tagSafeArray;

Answer 1

好的，该vc组件源代码如下：
******************************************************************
******************************************************************
结构所在的idl文件user.idl：import "oaidl.idl";
import "ocidl.idl";typedef enum IDENTITY{administrator,sellor,stocker,storager,comptroller}IDENTITY;
typedef  [uuid(15B73CAC-5556-4425-BE89-5FB95FC2AA93),               
          version(1.0),
          helpstring("USER 1.0 Type Library")
]
struct USER
{
      [helpstring("Special  User ID")] BSTR UserID;
  [helpstring("Special Password")] BSTR Password;
          [helpstring("Special Identity")] IDENTITY Identity;
}USER;
******************************************************************
******************************************************************

Answer 2

******************************************************************
******************************************************************
组件的idl文件bmsserver.idl：
import "H:\Microsoft Visual Studio .NET\Vc7\PlatformSDK\include\prsht.idl";
import "H:\Microsoft Visual Studio .NET\Vc7\PlatformSDK\include\mshtml.idl";
import "h:\microsoft visual studio .net\vc7\platformsdk\include\dimm.idl";
import "H:\Microsoft Visual Studio .NET\Vc7\PlatformSDK\include\mshtmhst.idl";
import "h:\microsoft visual studio .net\vc7\platformsdk\include\docobj.idl";
import "H:\Microsoft Visual Studio .NET\Vc7\PlatformSDK\include\exdisp.idl";
import "H:\Microsoft Visual Studio .NET\Vc7\PlatformSDK\include\objsafe.idl";
import "h:\bms\bmsserver\user.idl";[
object,
uuid(7A5C0D98-1DDA-4E66-80D9-EE55A317668C),
dual,
helpstring("IMSSQLServer 接口"),
pointer_default(unique)
] 
#line 14 "h:\\bms\\bmsserver\\mssqlserver.h"
interface IMSSQLServer : IDispatch {
};[
object,
uuid(95453B5E-BE07-4BF0-A508-4C47E588A1BE),
dual,
helpstring("IOracleServer 接口"),
pointer_default(unique)
] 
#line 14 "h:\\bms\\bmsserver\\oracleserver.h"
interface IOracleServer : IDispatch {
#line 16 "h:\\bms\\bmsserver\\oracleserver.h"
[id(1),helpstring("方法ConnectToOracle")] HRESULT  ConnectToOracle([out,retval] VARIANT_BOOL *ConnectResult);
[id(2),helpstring("方法DisConnectToOracle")] HRESULT  DisConnectToOracle([out,retval] VARIANT_BOOL *DisConnectResult);
#line 19 "h:\\bms\\bmsserver\\oracleserver.h"
[id(3),helpstring("方法Validate")] HRESULT  Validate([in] SAFEARRAY(USER) psaUser, [out,retval] VARIANT_BOOL *ValidateResult);
};
[ version(1.0), uuid(3DF25342-C02A-4449-8C4A-0764F70A75D3), helpstring("BMSServer 1.0 类型库") ]
library BMSServer
{
importlib("stdole2.tlb");
importlib("olepro32.dll"); [
version(1.0),
uuid(71290C88-5A6E-41E9-BA5D-E1B6587C3063),
helpstring("MSSQLServer Class")
] 
#line 31 "h:\\bms\\bmsserver\\mssqlserver.h"
coclass CMSSQLServer {
interface IMSSQLServer;
}; [
version(1.0),
uuid(2DDBB679-D766-410C-9B88-BF1341589CBC),
helpstring("OracleServer Class")
] 
#line 35 "h:\\bms\\bmsserver\\oracleserver.h"
coclass COracleServer {
interface IOracleServer;
};}
***********************************************************
***********************************************************

Answer 3

***********************************************************
***********************************************************
组件头文件oracleserver.h：
// OracleServer.h : COracleServer 的声明#pragma once
#include "resource.h"       // 主符号
#import "msado15.dll" no_namespace rename("EOF","ADOEOF")// IOracleServer
[
object,
uuid("95453B5E-BE07-4BF0-A508-4C47E588A1BE"),
dual, helpstring("IOracleServer 接口"),
pointer_default(unique)
]
__interface IOracleServer : IDispatch
{
[id(1), helpstring("方法ConnectToOracle")] HRESULT ConnectToOracle([out,retval] VARIANT_BOOL* ConnectResult);
[id(2), helpstring("方法DisConnectToOracle")] HRESULT DisConnectToOracle([out,retval] VARIANT_BOOL* DisConnectResult);
                                                          //GetArray([out]SAFEARRAY(struct VT_POINT)* LinePoints)
[id(3), helpstring("方法Validate")] HRESULT Validate([in, satype(USER)] SAFEARRAY * psaUser, [out,retval] VARIANT_BOOL* ValidateResult);
};// COracleServer[
coclass,
threading("apartment"),
vi_progid("BMSServer.OracleServer"),
progid("BMSServer.OracleServer.1"),
version(1.0),
uuid("2DDBB679-D766-410C-9B88-BF1341589CBC"),
helpstring("OracleServer Class")
]
class ATL_NO_VTABLE COracleServer : 
public IOracleServer
{
public:
COracleServer()
{
}
DECLARE_PROTECT_FINAL_CONSTRUCT() HRESULT FinalConstruct()
{
return S_OK;
}

void FinalRelease() 
{
}   CComPtr<IUnknown> m_pUnkMarshalerORA;   _ConnectionPtr m_spADOConnectionORA;
   _RecordsetPtr m_spADORecordsetORA;
   _CommandPtr m_spADOCommandORA;
public: STDMETHOD(ConnectToOracle)(VARIANT_BOOL* ConnectResult);
STDMETHOD(DisConnectToOracle)(VARIANT_BOOL* DisConnectResult);

STDMETHOD(Validate)(SAFEARRAY * psaUser, VARIANT_BOOL* ValidateResult);
};
******************************************************************
******************************************************************

Answer 4

type
  TIdentity = (administrator, sellor, stocker, storager, comptroller);
  TUser = record
    UserID: WideString;
    Password: WideString;
    Identity: TIdentity;
  end;function Validate(const psaUser: TUser; out ValidateResult: LongBool);根本不用SafeArray,就这样定义就行了

Answer 5

******************************************************************
******************************************************************
组件实现文件oracleserver.app：
/ OracleServer.cpp : COracleServer 的实现#include "stdafx.h"
#include "user.h"
//#include "_BMSServer.h"
#include "OracleServer.h"
// COracleServer
STDMETHODIMP COracleServer::ConnectToOracle(VARIANT_BOOL* ConnectResult)
{
// TODO: 在此添加实现代码USES_CONVERSION; HRESULT hrORA=S_OK; _bstr_t bstrConnectString;
_bstr_t bstrUserID;
_bstr_t bstrPassword;
   
    try
{     
 bstrConnectString=L"Provider=OraOLEDB.Oracle;Data Source=bms.oracle;User Id=jiemi; Password=jiemi";
 bstrUserID=L"jiemi";
 bstrPassword=L"jiemi";  hrORA=m_spADOConnectionORA.CreateInstance(__uuidof(Connection), NULL);
 if FAILED(hrORA) 
 {   
 *ConnectResult=false;

 }
 //hrORA=m_spADOConnectionORA->Open("Provider=OraOLEDB.Oracle;Data Source=bms.oracle;User Id=jiemi;Password=jiemi;","","",0);
 hrORA=m_spADOConnectionORA->Open(bstrConnectString,bstrUserID,bstrPassword,adOptionUnspecified);
 if FAILED(hrORA) 
 
 *ConnectResult=false;
 else
 *ConnectResult=true;
}
catch(_com_error &err)
{
//下面这段异常处理代码来自msdn文档，可是会严重出错。不用。
// TCHAR szBuf[2056];
// _tcscpy(szBuf,_T(""));
// _tcscat(szBuf,err.ErrorMessage());
// _bstr_t bstrSource(err.Source());
// _bstr_t bstrDesc(err.Description());
// _tcscat(szBuf,(char*)bstrSource);
// _tcscat(szBuf,(char*)bstrDesc);
//
//#ifdef _DEBUG
//    OutputDebugString(szBuf);
//#endif //_DEBUG
// return E_FAIL;
}
//*ConnectResult=true;
return S_OK;
}STDMETHODIMP COracleServer::DisConnectToOracle(VARIANT_BOOL* DisConnectResult)
{
// TODO: 在此添加实现代码
    //m_spADOConnectionORA->Close();
*DisConnectResult=true;
return S_OK;
}

Answer 6

STDMETHODIMP COracleServer::Validate(SAFEARRAY * psaUser, VARIANT_BOOL* ValidateResult)
{
// TODO: 在此添加实现代码  *ValidateResult=false;
 HRESULT hrVALIDATE;     //验证BMS用户
   if (psaUser!=NULL)
   {
   try{    VARTYPE vt;
   SafeArrayGetVartype(psaUser,&vt);
       if (vt!=VT_RECORD)
           return S_FALSE;    long lLBound,lUBound;
       
   SafeArrayGetLBound(psaUser,1,&lLBound);
   SafeArrayGetUBound(psaUser,1,&lUBound);    USER *pUser;    SafeArrayAccessData(psaUser,(void**)&pUser);
       for(long i=lLBound;i<=lUBound;i++)
   {
   _ASSERTE(m_spADOConnectionORA!=NULL);
           
           hrVALIDATE=m_spADOCommandORA.CreateInstance(_uuidof(Command),NULL);    if FAILED(hrVALIDATE)
   return S_FALSE;    hrVALIDATE=m_spADORecordsetORA.CreateInstance(_uuidof(Recordset),NULL);    if FAILED(hrVALIDATE) 
   return S_FALSE;    _variant_t vNULL;
   vNULL.vt=VT_ERROR;
   vNULL.scode=DISP_E_PARAMNOTFOUND;    m_spADOCommandORA->ActiveConnection=m_spADOConnectionORA;
   m_spADOCommandORA->CommandText="select count(*) from USERS where user_id like ? and password like ? ";
   m_spADOCommandORA->Parameters->Append(m_spADOCommandORA->CreateParameter("user_id",adVarChar,adParamInput,40,(*(pUser+i)).UserID));
   m_spADOCommandORA->Parameters->Append(m_spADOCommandORA->CreateParameter("password",adVarChar,adParamInput,40,(*(pUser+i)).Password));
           
   m_spADORecordsetORA=m_spADOCommandORA->Execute(&vNULL,&vNULL,adCmdText);
   _variant_t vtRecordAmount=m_spADORecordsetORA->GetCollect(_variant_t((long)0));
   long lRecordAmount;
   lRecordAmount=vtRecordAmount;    if (lRecordAmount>0)
   *ValidateResult=true;
   else
   *ValidateResult=false;
   break;//只验证一个用户，即数组第一个元素
   }
       SafeArrayUnaccessData(psaUser);   
   return S_OK;
  }
   catch (_com_error e)
   {
   //_AfxMessageBox(e.ErrorMessage());       }   }
  
   return S_OK;
}****************************************************************
****************************************************************

Answer 7

老兄，从Component->Import ActiveX算了，这样看人的东东很累人
先把你的VC组件注册

Answer 8

已经注册了，vc做的胖客户可以很好的使用该组件。只是不知道如何用delphi做客户端，传递一个safearray.

Answer 9

Delphi不是提供这个功能吗？
从Menus->Components->import ActiveXadd you .ocx fileCreate Unit and Install然后就可以使用这个控件了，很简单的

Answer 10

谢谢我已经用 import typelibrary导入类型库生成tlb文件，但我不知道如何传递这个safearraydelphi中如何定义一个safearray呢？

Answer 11

我上面不是写了吗，不过看你的源程序，传的是OleVariant参数(不是TUser),OleVariant只不过保存了TUser的内容，你将TUser记录类型的内容写入一个OleVariant变量，然后将这个OleVariant再传入VC关于怎么写OleVariant，看看这个：
http://www.csdn.net/expert/topic/636/636068.xml?temp=.356106

Answer 12

type
  TIdentity = (administrator, sellor, stocker, storager, comptroller);
  TUser = packed record
    UserID: array of [0..254] of Char;
    Password: array of [0..254] of Char;
    Identity: TIdentity;
  end;
you com interfacefunction Validate(const psaUser: OleVariant; out ValidateResult: LongBool); safecall;SomeProcedure
var
  P: Pointer;
  V: OleVariant;
  UserInfo: TUser;
begin
  FillChar(UserInfo, SizeOf(UserInfo), 0);
  UserInfo.UserID := 'UserID';
  UserInfo.Password := 'password';
  UserInfo.Identity := administrator;
  V := VarArrayCreate([0, SizeOf(UserInfo)], varByte);
  P := VarArrayLock(V);
  try
    //相当于API::MoveMemory
    Move(UserInfo, P^, SizeOf(UserInfo));
  finally
    VarArrayUnLock(V);
  end;
end;

Answer 13

var
  ValidateResult: LongBool;
begin
  ...
  try
    //相当于API::MoveMemory
    Move(UserInfo, P^, SizeOf(UserInfo));
  finally
    VarArrayUnLock(V);
  end;
  //VC Com interface
  Validate(V, ValidateResult);
end;你可以先看看，Delphi导入的TLB文件中Validate(的类型是OleVariant，还是其它什么，可以直接传个UserInfo: TUser参数试试，不行再用这个方法传