前回からとうとう2週間以上も経過してしまいました。ただしこの記事は先週木曜日に書き上げたものの、1週間余りに渡ってハードディスクの肥やしと化していたのです。申し訳ありません。

さてActiveBasic 5では.NET Frameworkを使ったプログラムを書くことができます。例としてSystem.Collections.ArrayListを使ってみます。

まず先にVisual Basic .NET (2003)でのソースコードとコンパイル時のコマンドラインを示しておきます。ABがわかればおぼろげにでもわかると思います。

' test.vb
' vbc /target:winexe /r:mscorlib.dll /r:system.windows.forms.dll test.vb
Module Test
	Public Sub Main()
		Dim l As System.Collections.IList
		l = New System.Collections.ArrayList()
		l.Add(1)
		l.Add(2.5)
		l.Add("Hello")
		Dim collection As System.Collections.ICollection
		Dim count As Long
		collection = l
		count = collection.Count
		Dim i As Long
		For i = 0 To count - 1
			Dim v As System.Object
			v = l.Item(i)
			Call System.Windows.Forms.MessageBox.Show(v)
		Next
	End Sub
End Module

lは動的配列を指しています。そこへ1, 2.5, “Hello”という3つのオブジェクトを追加し、それをForループ内で順に取り出し、メッセージボックスで表示するといういたって単純なプログラムです。

Windows APIを使うには関数や構造体の宣言が必要なように、.NET Frameworkも宣言をする必要があります。ArrayListはIList, ICollection, IEnumerableという3つのインターフェースを実装しています。そのうち今回使うIList, ICollectionを宣言します。

Interface IList
	Inherits IDispatch

	Function get_Item(/*[in]*/ ByVal index As Long, /*[out,retval]*/ ByRef retVal As VARIANT) As HRESULT
	Function putref_Item(/*[in]*/ ByVal index As Long, /*[in]*/ ByVal value As VARIANT) As HRESULT
'	Function Add(/*[in]*/ ByVal value As VARIANT, /*[out,retval]*/ ByRef retVal As Long) As HRESULT
	Function Add(ByVal vHigh As QWord, ByVal vLow As QWord, /*[out,retval]*/ ByRef retVal As Long) As HRESULT
	Function Contains(/*[in]*/ ByVal value As VARIANT, /*[out,retval]*/ ByRef retVal As VARIANT_BOOL) As HRESULT
	Function Clear() As HRESULT
	Function get_IsReadOnly(/*[out,retval]*/ ByRef retVal As VARIANT_BOOL) As HRESULT
	Function get_IsFixedSize(/*[out,retval]*/ ByRef retVal As VARIANT_BOOL) As HRESULT
	Function IndexOf(/*[in]*/ ByVal value As VARIANT, /*[out,retval]*/ ByRef retVal As Long) As HRESULT
	Function Insert(/*[in]*/ ByVal index As Long, /*[in]*/ ByVal value As VARIANT) As HRESULT
	Function Remove(/*[in]*/ ByVal value As VARIANT) As HRESULT
	Function RemoveAt(/*[in]*/ ByVal index As Long) As HRESULT
End Interface

Interface ICollection
	Inherits IDispatch

	Function CopyTo(/*[in]*/ ByVal array As *_Array, /*[in]*/ ByVal index As Long) As HRESULT
	Function get_Count(/*[out,retval]*/ ByRef retVal As Long) As HRESULT
	Function get_SyncRoot(/*[out,retval]*/ ByRef retVal As VARIANT) As HRESULT
	Function get_IsSynchronized(/*[out,retval]*/ ByRef retVal As VARIANT) As HRESULT
End Interface

ついでにラッパを作っておきます。

Class IListPtr
Public
	Ptr As *IList

	Sub ~IListPtr()
		If Ptr <> 0 Then
			Ptr->Release()
		End If
	End Sub

	Function Add(ByRef value As VARIANT) As Long
'		Ptr->Add(value, Add)
		Ptr->Add(GetQWord(VarPtr(value)), GetQWord(VarPtr(value) + SizeOf (QWord)), Add)
	End Function

	Function Item(index As Long) As VARIANT
		Ptr->get_Item(index, Item)
	End Function

	Sub Item(index As Long, ByRef value As VARIANT)
		Ptr->putref_Item(index, value)
	End Sub
End Class

Class ICollectionPtr
Public
	Ptr As *ICollection

	Sub ~ICollectionPtr()
		If Ptr <> 0 Then
			Ptr->Release()
		End If
	End Sub

	Function Count() As Long
		Ptr->get_Count(Count)
	End Function
End Class

なんだか綻びが出てきていると思っても気にしてはいけません。次です。先程からよく見かけるVARIANTの宣言を載せておきます。本当は単なる構造体ですが、手抜きクラス化しています。

TypeDef VARTYPE = Word

Class VARIANT
Public
	vt As VARTYPE
	wReserved1 As Word
	wReserved2 As Word
	wReserved3 As Word

	Val As QWord

	Function bstrVal() As BSTR
		Return Get_LONG_PTR(VarPtr(Val)) As BSTR
	End Function

	Sub SetBStr(bstr As BSTR)
		Set_LONG_PTR(VarPtr(Val), bstr)
		vt = VT_BSTR
	End Sub

	Sub SetLong(l As Long)
		SetDWord(VarPtr(Val), l As DWord)
		vt = VT_I4
	End Sub

	Sub SetDouble(d As Double)
		SetDouble(VarPtr(Val), d)
		vt = VT_R8
	End Sub
End Class

Const Enum VARENUM
	VT_I4 = 3
	VT_R8 = 5
	VT_BSTR = 8
End Enum

TypeDef VARIANTARG = VARIANT

そろそろメインのプログラムに入ります。

CoInitialize(0)
Main()
CoUninitialize()
End

Function Main() As HRESULT
	Dim hr As HRESULT
	Dim v As VARIANT
	Dim l As IListPtr
	hr = CoCreateInstance(CLSID_ArrayList, 0, CLSCTX_ALL, IID_IList, l.Ptr)
	If hr <> S_OK Then Return hr
	VariantInit(v)
	v.SetLong(1)
	l.Add(v)
	v.SetDouble(2.5)
	l.Add(v)
	Dim wsz[5] As WCHAR
	MultiByteToWideChar(CP_ACP, 0, "Hello", -1, wsz, Len(wsz) / SizeOf (WCHAR))
	v.SetBStr(SysAllocString(wsz))
	l.Add(v)
	VariantClear(v)

	Dim collection As ICollectionPtr, count As Long
	l.Ptr->QueryInterface(IID_ICollection, collection.Ptr())
	count = collection.Count
	Dim i As Long
	For i = 0 To ELM(count)
		v = l.Item[i]
		VariantChangeType(v, v, 0, VT_BSTR)
		MessageBoxW(0, v.bstrVal, 0, MB_OK)
		VariantClear(v)
	Next
	Main = S_OK
End Function

もうおわかりでしょうか。実はCOM経由で呼び出しているだけなのでした。.NET Frameworkのオブジェクトは所定の要件を満たせばこのようにCOMコンポーネントとして扱えるのです。勿論ユーザが作成したクラスライブラリも同じです。当然実行には.NET Frameworkが必要ですが、ABで書いた部分はあくまでネイティブコードです。

残りの宣言を追加しておきます。CVSの最新のヘッダとAB5β6を使用していますが、AB5CP3でもコンパイル・実行はできると思います。

Interface ITypeInfo
	Inherits IUnknown
	'省略
End Interface

TypeDef DISPID = Long

Type DISPPARAMS
	' 省略
End Type
Type EXCEPINFO
	' 省略
End Type

TypeDef VARIANT_BOOL = Integer

Dim CLSID_ArrayList = [&h6896b49d, &h7afb, &h34dc, [&h93, &h4e, &h5a, &hdd, &h38, &hee, &hee, &h39]] As CLSID
Dim IID_IList = [&h7bcfa00f, &hf764, &h3113, [&h91, &h40, &h3b, &hbd, &h12, &h7a, &h96, &hbb]] As IID
Dim IID_ICollection = [&hde8db6f8, &hd101, &h3a92, [&h8d, &h1c, &he7, &h2e, &h5f, &h10, &he9, &h92]] As IID

Type _Array
End Type

Declare Sub VariantInit Lib "oleaut32" (ByRef v As VARIANTARG)
Declare Function VariantClear Lib "oleaut32" (ByRef varg As VARIANTARG) As HRESULT

Declare Function SysAllocString Lib "oleaut32" (
    psz As *WCHAR,
) As BSTR

Declare Function MessageBoxW Lib "user32" (
	hwnd As HWND,
	pText As *WCHAR,
	pCaption As *WCHAR,
	uType As DWord) As Long

'#prompt

Declare Function VariantChangeType Lib "oleaut32" (ByRef vargDest As VARIANT, ByRef vargSrc As VARIANT, flags As Word, vt As VARTYPE) As HRESULT
このエントリーをはてなブックマークに追加

スポンサード リンク

この記事のカテゴリ

  • ⇒ ActiveBasic .NET
  • ⇒ ActiveBasic .NET