COMとVB・VBScript 2次元（n次元）配列
COMの作成とVB/VBSのn次元渡し。
作成環境：VC++2010 Express + SDK + ATL
テスト環境：コマンドプロンプト(VBScript)、ＶＢ
基本事項
32bitモジュールから64bitのＣＯＭは呼べない、64bitモジュールから32bitＣＯＭは呼べない。
最終的にＣＯＭを呼び出すモジュールのbit数に合ったＣＯＭを登録して呼び出す。
64bitプロンプトから32bitのＣＯＭを動かす場合は
c:\windows\syswow64\cscript.exe test1.vbs
間違えると「オブジェクトがありません」のエラーが発生します。
ＣＯＭが無いと話にならないのでＣＯＭを作成するところから・・・
全言語から配列を扱うＣＯＭにするにはVARIANT型のポインターで受け渡しを宣言する。
文字や数値でVARIANT型以外の配列にした場合は配列数も引数でもらわないといけないのと、
他の型を渡したいと思った時にメソッド自体を追加しないと使えないＣＯＭになるので駄目では
ないですがここでは対象外とします。
呼び出し言語の違いを無くす
// .IDLファイル
[id(1), helpstring("配列受信")] HRESULT Method1 ( [in, out] VARIANT *Val );
// C++コード：
STDMETHODIMP CClass::Method1 (VARIANT *Val)
{
SAFEARRAY *pArray = NULL;
// ＣＯＭを呼び出す言語により配列がセットされている変数が違う
if ((VT_BYREF|VT_VARIANT) == Val->vt){
if ((VT_BYREF|VT_ARRAY|VT_VARIANT) == Val->pvarVal->vt){
pArray = *Val->pvarVal->pparray;
}
}else if ((VT_BYREF|VT_ARRAY|VT_VARIANT) == Val->vt){
pArray = *Val->pparray;
}else if ((VT_ARRAY|VT_VARIANT) == Val->vt){
pArray = Val->parray;
}
if (NULL == pArray){
return S_FALSE; // エラー
}
・・・pArrayが配列へのポインターなのでpArrayを操作する
}
戻り値を安全に返す
// .IDLファイル
[id(2), helpstring("戻り値1")] HRESULT Method2 ( [out,retval] VARIANT *nRetval ); //安全
[id(3), helpstring("戻り値2")] HRESULT Method3 ( [out,retval] long *nRetval ); //安全でない
// C++コード：
STDMETHODIMP CClass::Method2 (VARIANT *nRetval)
{
// これが安全です。
nRetval->vt = VT_I4;
nRetval->lVal = -2147024843;
return (S_OK == nRetval->lVal ? S_OK : S_FALSE);
}
STDMETHODIMP CClass::Method3 (long *nRetval)
{
HRESULT hr;
hr = -2147024843;
*nRetval = hr; // かなり危険です。
return hr;
}
以上を踏まえてＣＯＭを作成
◎ 配列の元の値を維持して任意の次元を伸張するメソッドです。
/////////////////////////////////////////////////////////////////////
．ＩＤＬファイル
[id(4), helpstring("配列伸長:３次元まで対応")] HRESULT ReDimEx(
[in,out]VARIANT* YourArray,
[in,defaultvalue(0)]long AddRow, [in,defaultvalue(0)]long AddColumn,
[in,defaultvalue(0)]long AddPage, [out,retval]VARIANT* Result);
/////////////////////////////////////////////////////////////////////
．Hファイル
STDMETHOD( ReDimEx )(VARIANT* YourArray, long AddRow, long AddColumn, long AddPage, VARIANT* Result);
/////////////////////////////////////////////////////////////////////
．CPPファイル
//
// べたなコードですが３次元までの伸長。
STDMETHODIMP CClass::ReDimEx(
VARIANT* YourArray, /* [in, out] 配列 */
long AddRow, /* [in] 増減させる行数：１次元目 */
long AddColumn, /* [in] 増減させる列数：２次元目 */
long AddPage, /* [in] 増減させる頁数：３次元目 */
VARIANT* Result /* [out, retval] 戻り値 */
)
{
HRESULT hr = S_OK;
V_VT(Result) = VT_I4;
V_I4(Result) = S_FALSE;
SAFEARRAY *pArray = NULL, *pNewArray = NULL;
VARIANT *pData1;
SAFEARRAYBOUND rgb[3] = {{0,0},{0,0},{0,0}};
long rgIndices[3], idim;
long imin1 =0, imax1 =0, inum1 =0, iadd1 =0;
long imin2 =0, imax2 =0, inum2 =0, iadd2 =0;
long imin3 =0, imax3 =0, inum3 =0, iadd3 =0;
if (0 == AddRow && 0 == AddColumn && 0 == AddPage){
V_I4(Result) = 8; //引数エラー
return S_FALSE;
}
if ((VT_BYREF|VT_VARIANT) == YourArray->vt){
if ((VT_BYREF|VT_ARRAY|VT_VARIANT) == YourArray->pvarVal->vt){
pArray = *YourArray->pvarVal->pparray;
}
}else if ((VT_BYREF|VT_ARRAY|VT_VARIANT) == YourArray->vt){
pArray = *YourArray->pparray;
}else if ((VT_ARRAY|VT_VARIANT) == YourArray->vt){
pArray = YourArray->parray;
}
if (NULL == pArray && (VT_ARRAY & YourArray->vt)){
//空っぽの場合は作って返す
if (0 < AddRow && 0 < AddColumn && 0 < AddPage){
idim = 3;
rgb[0].cElements = AddRow;
rgb[1].cElements = AddColumn;
rgb[2].cElements = AddPage;
}else if (0 < AddRow && 0 < AddColumn){
idim = 2;
rgb[0].cElements = AddRow;
rgb[1].cElements = AddColumn;
}else if (0 < AddRow){
idim = 1;
rgb[0].cElements = AddRow;
}else{
V_I4(Result) = 8; //引数エラー
return S_FALSE;
}
pNewArray = SafeArrayCreate(VT_VARIANT, idim, rgb);
if (NULL != pNewArray){
V_VT(YourArray) = VT_ARRAY|VT_VARIANT;
V_ARRAY(YourArray) = pNewArray;
V_I4(Result) = S_OK;
return S_OK;
}else{
V_I4(Result) = 7; //メモリー不足
return S_FALSE;
}
}
if (NULL == pArray){
V_I4(Result) = 1; //変数宣言が配列でない
return S_FALSE;
}
if (3 < (idim = SafeArrayGetDim(pArray))){
V_I4(Result) = 2; //４次元以上だ
return S_FALSE;
}
if (3 <= idim){
hr = SafeArrayGetLBound(pArray, 3, &imin3);
if (S_OK==hr) hr=SafeArrayGetUBound(pArray, 3, &imax3);
}
if (S_OK == hr && 2 <= idim){
hr = SafeArrayGetLBound(pArray, 2, &imin2);
if (S_OK==hr) hr=SafeArrayGetUBound(pArray, 2, &imax2);
}
if (S_OK == hr && 1 <= idim){
hr = SafeArrayGetLBound(pArray, 1, &imin1);
if (S_OK==hr) hr=SafeArrayGetUBound(pArray, 1, &imax1);
}
if (S_OK != hr){
V_I4(Result) = hr; //APIエラー
return S_FALSE;
}
if (1 <= idim){
inum1 = labs((imax1 - imin1)) + 1;
iadd1 = inum1 + AddRow;
if (1 > iadd1){
V_I4(Result) = 4; //１次元要素が無くなる
return S_FALSE;
}
rgb[0].cElements = iadd1;
}
if (2 <= idim){
inum2 = labs((imax2 - imin2)) + 1;
iadd2 = inum2 + AddColumn;
if (1 > iadd2){
V_I4(Result) = 5; //２次元要素が無くなる
return S_FALSE;
}
rgb[1].cElements = iadd2;
}
if (3 <= idim){
inum3 = labs((imax3 - imin3)) + 1;
iadd3 = inum3 + AddPage;
if (1 > iadd3){
V_I4(Result) = 6; //３次元要素が無くなる
return S_FALSE;
}
rgb[2].cElements = iadd3;
}
pNewArray = SafeArrayCreate( VT_VARIANT, idim, rgb );
if (NULL == pNewArray){
V_I4(Result) = 7; //メモリー不足
return S_FALSE;
}
if (1 == idim)
{
hr = SafeArrayAccessData(pArray, (void**)&pData1);
if (S_OK == hr) hr=SafeArrayLock(pNewArray);
if (S_OK == hr) {
rgIndices[1] = 0; rgIndices[2] = 0;
for (long i = 0; (i < inum1 && i < iadd1); i++){
rgIndices[0] = i;
if (S_OK != (hr=SafeArrayPutElement(pNewArray,
rgIndices, (void*)&pData1[i]))) break;
}
}
SafeArrayUnlock(pNewArray);
SafeArrayUnaccessData(pArray);
}
if (2 == idim)
{
hr = SafeArrayLock(pArray);
if (S_OK == hr) hr=SafeArrayLock(pNewArray);
if (S_OK == hr){
rgIndices[2] = 0;
for (long i = 0; (i < inum1 && i < iadd1); i++){
for (long j = 0; (j < inum2 && j < iadd2); j++){
rgIndices[0] = i; rgIndices[1] = j;
if (S_OK != (hr=SafeArrayPtrOfIndex(pArray,
rgIndices, (void**)&pData1))) break;
if (S_OK != (hr=SafeArrayPutElement(pNewArray,
rgIndices, (void*)pData1))) break;
}
if (S_OK != hr) break;
}
}
SafeArrayUnlock(pNewArray);
SafeArrayUnlock(pArray);
}
if (3 == idim)
{
hr = SafeArrayLock(pArray);
if (S_OK == hr) hr=SafeArrayLock(pNewArray);
if (S_OK == hr){
for (long i = 0; (i < inum1 && i < iadd1); i++){
for (long j = 0; (j < inum2 && j < iadd2); j++){
for (long k = 0; (k < inum3 && k < iadd3); k++){
rgIndices[0] = i; rgIndices[1] = j; rgIndices[2] = k;
if (S_OK != (hr=SafeArrayPtrOfIndex(pArray,
rgIndices, (void**)&pData1))) break;
if (S_OK != (hr=SafeArrayPutElement(pNewArray,
rgIndices, (void*)pData1))) break;
}
if (S_OK != hr) break;
}
if (S_OK != hr) break;
}
}
SafeArrayUnlock(pNewArray);
SafeArrayUnlock(pArray);
}
if (S_OK == hr){
SafeArrayDestroy(pArray);
V_VT(YourArray) = VT_ARRAY|VT_VARIANT;
V_ARRAY(YourArray) = pNewArray;
}else{
SafeArrayDestroy(pNewArray);
}
V_I4(Result) = hr;
return (S_OK == hr ? S_OK : S_FALSE);
}
■テストＶＢＳ
配列の入れ子の入れ子もがあってもちゃんと動くようですね
ＶＢは似たようなコードになるので省略しました
VB,VBSの添え字がゼロからか１からか迷走する人がいますけど、特に制限が無いならゼロからです
Dim Mydim(2)と宣言したら配列の添え字は０，１，２の３個が使えます。Dim Mydim(0 to 2)の意味です
Option Explicit
Dim MyObject, Ret, Mydim(1,2,3), Mydim2(1,2), Subdim(2), SubSubdim(2)
Set MyObject = WScript.CreateObject("TestCom.Class")
Subdim(0) = 12345
Subdim(1) = "あかさなた"
Subdim(2) = 6789
Mydim(0,0,0) = "あいうえお"
Mydim(0,0,1) = 2
Mydim(0,0,2) = 3
Mydim(0,0,3) = 4
Mydim(0,1,0) = 11
Mydim(0,1,1) = "かきくけこ"
Mydim(0,1,2) = 13
Mydim(0,1,3) = 14
Mydim(0,2,0) = 21
Mydim(0,2,1) = 22
Mydim(0,2,2) = "さしすせそ"
Mydim(0,2,3) = 24
Mydim(1,0,0) = 31
Mydim(1,0,1) = 32
Mydim(1,0,2) = 33
Mydim(1,0,3) = 34
Mydim(1,1,0) = 41
Mydim(1,1,1) = Subdim
Mydim(1,1,2) = 43
Mydim(1,1,3) = 44
Mydim(1,2,0) = Subdim
Mydim(1,2,1) = Subdim
Mydim(1,2,2) = Subdim
Mydim(1,2,3) = 54
''●３次元のばす
''PrintOut3 Mydim
Ret = MyObject.ReDimEx(Mydim, 2)
WScript.Echo "ReDimEx = " & Ret & ", NewCount = " & UBound(Mydim,1) & "," & UBound(Mydim,2) & "," & UBound(Mydim,3)
PrintOut3 Mydim
''●３次元ちじめる
Ret = MyObject.ReDimEx(Mydim, -3, -1, -1)
WScript.Echo "ReDimEx = " & Ret & ", NewCount = " & UBound(Mydim,1) & "," & UBound(Mydim,2) & "," & UBound(Mydim,3)
PrintOut3 Mydim
''●１次元
SubSubdim(0) = 3999
SubSubdim(1) = "１次元"
SubSubdim(2) = 7777
Subdim(1) = SubSubdim
Ret = MyObject.ReDimEx(Subdim, 2)
WScript.Echo "ReDimEx = " & Ret & ", NewCount = " & UBound(Subdim,1)
PrintOut1 Subdim
''●２次元
Mydim2(0,0) = "２次元1"
Mydim2(0,1) = SubSubdim
Mydim2(0,2) = "２次元3"
Mydim2(1,0) = "２次元4"
Mydim2(1,1) = "２次元5"
Mydim2(1,2) = Subdim
''PrintOut2 Mydim2
Ret = MyObject.ReDimEx(Mydim2, 0, 2)
WScript.Echo "ReDimEx = " & Ret & ", NewCount = " & UBound(Mydim2,1) & "," & UBound(Mydim2,2)
PrintOut2 Mydim2
WScript.Quit(Err.Number)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' 内容表示
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub PrintOut3(VSA)
Dim ValWork, ValWork2, idx1, idx2, idx3, idx4, idx5
WScript.Echo "VarType = " & VarType(VSA) & ", IsArray = " & IsArray(VSA)
For idx1 = LBound(VSA, 1) To UBound(VSA, 1)
WScript.Echo "----------------------------------- "
For idx2 = LBound(VSA, 2) To UBound(VSA, 2)
For idx3 = LBound(VSA, 3) To UBound(VSA, 3)
ValWork = VSA(idx1,idx2,idx3)
If False= IsArray(ValWork) Then
WScript.Echo "(" & idx1 & "," & idx2 & "," & idx3 & ") = " & _
ValWork & ", (VarType:" & VarType(ValWork) & ")"
Else
For idx4 = LBound(ValWork, 1) To UBound(ValWork, 1)
ValWork2 = ValWork(idx4)
If False= IsArray(ValWork(idx4)) Then
WScript.Echo "(" & idx1 & "," & idx2 & "," & idx3 & ") = " & _
"Sub(" & idx4 & ") : " & ValWork2 & ", (VarType:" & VarType(ValWork2) & ")"
Else
For idx5 = LBound(ValWork2, 1) To UBound(ValWork2, 1)
WScript.Echo "(" & idx1 & "," & idx2 & "," & idx3 & ") = " & _
"Sub(" & idx4 & ") : SubSub(" & idx5 & ") : " & ValWork2(idx5) & ", (VarType:" & VarType(ValWork2(idx5)) & ")"
Next
End If
Next
End If
Next
Next
Next
WScript.Echo
End Sub
Sub PrintOut2(VSA)
Dim ValWork, ValWork2, idx1, idx2, idx3, idx4, idx5
WScript.Echo "VarType = " & VarType(VSA) & ", IsArray = " & IsArray(VSA)
For idx1 = LBound(VSA, 1) To UBound(VSA, 1)
WScript.Echo "----------------------------------- "
For idx2 = LBound(VSA, 2) To UBound(VSA, 2)
ValWork = VSA(idx1,idx2)
If False= IsArray(ValWork) Then
WScript.Echo "(" & idx1 & "," & idx2 & ") = " & _
ValWork & ", (VarType:" & VarType(ValWork) & ")"
Else
For idx4 = LBound(ValWork, 1) To UBound(ValWork, 1)
ValWork2 = ValWork(idx4)
If False= IsArray(ValWork(idx4)) Then
WScript.Echo "(" & idx1 & "," & idx2 & ") = " & _
"Sub(" & idx4 & ") : " & ValWork2 & ", (VarType:" & VarType(ValWork2) & ")"
Else
For idx5 = LBound(ValWork2, 1) To UBound(ValWork2, 1)
WScript.Echo "(" & idx1 & "," & idx2 & ") = " & _
"Sub(" & idx4 & ") : SubSub(" & idx5 & ") : " & ValWork2(idx5) & ", (VarType:" & VarType(ValWork2(idx5)) & ")"
Next
End If
Next
End If
Next
Next
WScript.Echo
End Sub
Sub PrintOut1(VSA)
Dim ValWork, idx1, idx2, idx3, idx4
WScript.Echo "VarType = " & VarType(VSA) & ", IsArray = " & IsArray(VSA)
For idx1 = LBound(VSA, 1) To UBound(VSA, 1)
WScript.Echo "----------------------------------- "
ValWork = VSA(idx1)
If False= IsArray(ValWork) Then
WScript.Echo "(" & idx1 & ") = " & _
ValWork & ", (VarType:" & VarType(ValWork) & ")"
Else
For idx4 = LBound(ValWork, 1) To UBound(ValWork, 1)
WScript.Echo "(" & idx1 & ") = " & _
"Sub(" & idx4 & "):" & ValWork(idx4) & ", (VarType:" & VarType(ValWork(idx4)) & ")"
Next
End If
Next
WScript.Echo
End Sub
■そして実行結果--------------------------------------------------------------------
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.
ReDimEx = 0, NewCount = 3,2,3
VarType = 8204, IsArray = True
-----------------------------------
(0,0,0) = あいうえお, (VarType:8)
(0,0,1) = 2, (VarType:2)
(0,0,2) = 3, (VarType:2)
(0,0,3) = 4, (VarType:2)
(0,1,0) = 11, (VarType:2)
(0,1,1) = かきくけこ, (VarType:8)
(0,1,2) = 13, (VarType:2)
(0,1,3) = 14, (VarType:2)
(0,2,0) = 21, (VarType:2)
(0,2,1) = 22, (VarType:2)
(0,2,2) = さしすせそ, (VarType:8)
(0,2,3) = 24, (VarType:2)
-----------------------------------
(1,0,0) = 31, (VarType:2)
(1,0,1) = 32, (VarType:2)
(1,0,2) = 33, (VarType:2)
(1,0,3) = 34, (VarType:2)
(1,1,0) = 41, (VarType:2)
(1,1,1) = Sub(0) : 12345, (VarType:2)
(1,1,1) = Sub(1) : あかさなた, (VarType:8)
(1,1,1) = Sub(2) : 6789, (VarType:2)
(1,1,2) = 43, (VarType:2)
(1,1,3) = 44, (VarType:2)
(1,2,0) = Sub(0) : 12345, (VarType:2)
(1,2,0) = Sub(1) : あかさなた, (VarType:8)
(1,2,0) = Sub(2) : 6789, (VarType:2)
(1,2,1) = Sub(0) : 12345, (VarType:2)
(1,2,1) = Sub(1) : あかさなた, (VarType:8)
(1,2,1) = Sub(2) : 6789, (VarType:2)
(1,2,2) = Sub(0) : 12345, (VarType:2)
(1,2,2) = Sub(1) : あかさなた, (VarType:8)
(1,2,2) = Sub(2) : 6789, (VarType:2)
(1,2,3) = 54, (VarType:2)
-----------------------------------
(2,0,0) = , (VarType:0)
(2,0,1) = , (VarType:0)
(2,0,2) = , (VarType:0)
(2,0,3) = , (VarType:0)
(2,1,0) = , (VarType:0)
(2,1,1) = , (VarType:0)
(2,1,2) = , (VarType:0)
(2,1,3) = , (VarType:0)
(2,2,0) = , (VarType:0)
(2,2,1) = , (VarType:0)
(2,2,2) = , (VarType:0)
(2,2,3) = , (VarType:0)
-----------------------------------
(3,0,0) = , (VarType:0)
(3,0,1) = , (VarType:0)
(3,0,2) = , (VarType:0)
(3,0,3) = , (VarType:0)
(3,1,0) = , (VarType:0)
(3,1,1) = , (VarType:0)
(3,1,2) = , (VarType:0)
(3,1,3) = , (VarType:0)
(3,2,0) = , (VarType:0)
(3,2,1) = , (VarType:0)
(3,2,2) = , (VarType:0)
(3,2,3) = , (VarType:0)
ReDimEx = 0, NewCount = 0,1,2
VarType = 8204, IsArray = True
-----------------------------------
(0,0,0) = あいうえお, (VarType:8)
(0,0,1) = 2, (VarType:2)
(0,0,2) = 3, (VarType:2)
(0,1,0) = 11, (VarType:2)
(0,1,1) = かきくけこ, (VarType:8)
(0,1,2) = 13, (VarType:2)
ReDimEx = 0, NewCount = 4
VarType = 8204, IsArray = True
-----------------------------------
(0) = 12345, (VarType:2)
-----------------------------------
(1) = Sub(0):3999, (VarType:2)
(1) = Sub(1):１次元, (VarType:8)
(1) = Sub(2):7777, (VarType:2)
-----------------------------------
(2) = 6789, (VarType:2)
-----------------------------------
(3) = , (VarType:0)
-----------------------------------
(4) = , (VarType:0)
ReDimEx = 0, NewCount = 1,4
VarType = 8204, IsArray = True
-----------------------------------
(0,0) = ２次元1, (VarType:8)
(0,1) = Sub(0) : 3999, (VarType:2)
(0,1) = Sub(1) : １次元, (VarType:8)
(0,1) = Sub(2) : 7777, (VarType:2)
(0,2) = ２次元3, (VarType:8)
(0,3) = , (VarType:0)
(0,4) = , (VarType:0)
-----------------------------------
(1,0) = ２次元4, (VarType:8)
(1,1) = ２次元5, (VarType:8)
(1,2) = Sub(0) : 12345, (VarType:2)
(1,2) = Sub(1) : SubSub(0) : 3999, (VarType:2)
(1,2) = Sub(1) : SubSub(1) : １次元, (VarType:8)
(1,2) = Sub(1) : SubSub(2) : 7777, (VarType:2)
(1,2) = Sub(2) : 6789, (VarType:2)
(1,2) = Sub(3) : , (VarType:0)
(1,2) = Sub(4) : , (VarType:0)
(1,3) = , (VarType:0)
(1,4) = , (VarType:0)
投稿日: 2012/01/21 | カテゴリー: ソフトウェア、ハードウェア, テスト | パーマリンク コメントする.
＠ぐるぐるのスペース 
コメントする
0件のコメント