How to use multidimensional SafeArrays

> Hello,
>
> I am trying to send a 2 dimensional SafeArray from a Visaul Basic COM
> Client to a Dolphin Smalltalk COM Server object and return a modified
> 2 dimensional SafeArray back.
>
> The MIDL is:
> ....
> HRESULT test([in] SAFEARRAY (BSTR) input, [out, retval] SAFEARRAY
> (BSTR)* result);
> };
>...

> "Wolfgang Wunderlich" <[hidden email]> wrote in message
> news:[hidden email]...
> > Hello,
> >
> > I am trying to send a 2 dimensional SafeArray from a Visaul Basic COM
> > Client to a Dolphin Smalltalk COM Server object and return a modified
> > 2 dimensional SafeArray back.
> >
> > The MIDL is:
> > ....
> > HRESULT test([in] SAFEARRAY (BSTR) input, [out, retval] SAFEARRAY
> > (BSTR)* result);
> > };
> >...
>
> Hmmm, not sure you can actually call that from VB. I have a feeling that VB
> can only pass SAFEARRAYs (i.e. its own arrays) by reference, so the input
> parameter needs another level of indirection, even though it is in-only.
> Either way, it doesn't really make a lot of difference to Dolphin.
>
> > ...
> > Can anybody provide me with a small example of accessing the SafeArray
> > elements and creating, filling and returning a SafeArray.
> >...
>
> See the attached, which I hope will also be useful to anyone else struggling
> with SAFEARRAYs. Handling multiple dimensions is left as an exercise for the
> reader.
>
> Regards
>
> Blair
>
> ------------------------------------
> | package |
> package := Package name: 'SafeArrayExample'.
> package paxVersion: 0;
>  basicComment: 'Example of receiving and returning SAFEARRAY parameters'.
>
> package basicScriptAt: #postinstall put: 'STExample register;
> registerClassFactory'.
> package basicScriptAt: #preuninstall put: 'STExample revokeClassFactories'.
>
> package classNames
>  add: #ISTExample;
>  add: #STExample;
>  yourself.
>
> package globalNames
>  add: #STExampleLib;
>  yourself.
>
> package binaryGlobalNames: (Set new
>  add: #STExampleLib;
>  yourself).
>
> package globalAliases: (Set new
>  yourself).
>
> package allResourceNames: (Set new
>  yourself).
>
> package setPrerequisites: (IdentitySet new
>  add: 'Object Arts\Dolphin\ActiveX\Automation\ActiveX Automation';
>  add: 'Object Arts\Dolphin\ActiveX\COM\OLE COM';
>  yourself).
>
> package!
>
> "Class Definitions"!
>
> AXDualImp subclass: #STExample
>  instanceVariableNames: ''
>  classVariableNames: ''
>  poolDictionaries: ''
>  classInstanceVariableNames: ''!
> IDispatch subclass: #ISTExample
>  instanceVariableNames: ''
>  classVariableNames: ''
>  poolDictionaries: ''
>  classInstanceVariableNames: ''!
>
> "Global Aliases"!
>
>
> "Loose Methods"!
>
> "End of package definition"!
>
> "Source Globals"!
>
> "Classes"!
>
> STExample guid: (GUID fromString: '{DDEBF20A-84A9-458A-9707-84FD19CC2DFC}')!
> STExample comment: ''!
> !STExample categoriesForClass!COM-Implementations! !
> !STExample methodsFor!
>
> interfaceClass
>  ^ISTExample!
>
> Test: input result: result
>  "Note that the VM will already have wrapped the input argument as a
> SAFEARRAY,
>  however I don't think VB can call this method as it can only pass arrays by
> reference.
>
>  HRESULT __stdcall test(
>    [in] SAFEARRAY(BSTR) input,
>    [out, retval] SAFEARRAY(BSTR)* result);"
>
>  | in answer |
>  answer := SAFEARRAY length: input size elementClass: BSTR.
>  input keysAndValuesDo: [:i :each | answer at: i put: each asString
> asUppercase].
>  "We must ensure we don't leave the input array locked"
>  input unaccessData.
>  result value: answer detach.
>  ^S_OK!
>
> Test2: inStrings ppsaOut: ppsaOut
>  "Because inStrings is doubly-indirected, it will arrive as an LPVOID
> object, and we
>  must manually wrap this up into a SAFEARRAY.
>
>   HRESULT __stdcall test2(
>    [in] SAFEARRAY(BSTR)* InStrings,
>    [out, retval] SAFEARRAY(BSTR)* ppsaOut);"
>
>  | in answer |
>  in := SAFEARRAY fromAddress: inStrings elementClass: BSTR owner: inStrings.
>  answer := SAFEARRAY length: in size elementClass: BSTR.
>  in keysAndValuesDo: [:i :each | answer at: i put: each asString
> capitalized].
>  "We must ensure we don't leave the input array locked"
>  in unaccessData.
>  ppsaOut value: answer detach.
>  ^S_OK
> ! !
> !STExample categoriesFor: #interfaceClass!accessing!public! !
> !STExample categoriesFor: #Test:result:!COM Interfaces-ISTExample!public! !
> !STExample categoriesFor: #Test2:ppsaOut:!COM Interfaces-ISTExample!public!
> !
>
> STExample methodProtocol: #'STExample.ISTExample' attributes: #() selectors:
> #(#Test:result: #Test2:ppsaOut:)!
>
> !STExample class methodsFor!
>
> clsid
>  ^ISTExample clsid!
>
> example
>  | test inStrings result result2 offset strings |
>  test := ISTExample new.
>  strings := #('abc' 'def' 'ghi').
>  inStrings := SAFEARRAY
>   length: strings size
>   elementClass: BSTR.
>  strings
>   keysAndValuesDo:
>    [:i :each |
>    inStrings
>     at: i
>     put: each asBSTR].
>  result := test test: inStrings.
>  result2 := test test2: inStrings!
>
> progID
>  ^'SafeArrayExample.1'! !
> !STExample class categoriesFor: #clsid!constants!public! !
> !STExample class categoriesFor: #example!examples!public! !
> !STExample class categoriesFor: #progID!constants!public! !
>
> ISTExample guid: (IID fromString: '{59DA5EAA-30C6-4C37-8D35-01CF37C26281}')!
> ISTExample comment: '<ISTExample> is a wrapper class for the COM interface
> ''STExample.ISTExample'' generated from type information in the ''''
> library. It contains methods to invoke the member functions exposed by that
> interface.
>
> The type library contains no documentation for this interface
>
> Warning: This comment was automatically generated from the interface''s type
> information, but any changes made here will not be overwritten if the
> wrapper class is regenerated.
>
> IDL definition follows:
>
> [
>  object,
>  uuid(59DA5EAA-30C6-4C37-8D35-01CF37C26281),
>  dual
> ]
> interface ISTExample : IDispatch {
>  [id(0x60020000)]
>  HRESULT __stdcall test(
>   [in] SAFEARRAY(BSTR) input,
>   [out, retval] SAFEARRAY(BSTR)* result);
>  [id(0x60020001)]
>  HRESULT __stdcall test2(
>   [in] SAFEARRAY(BSTR)* InStrings,
>   [out, retval] SAFEARRAY(BSTR)* ppsaOut);
> };
> '!
> !ISTExample categoriesForClass!COM-Interfaces!STExample-Interfaces! !
> !ISTExample methodsFor!
>
> test: input
>  "Answer the <SAFEARRAY> result of invoking the test() method of the COM
> object."
>
>  | answer |
>  answer := SAFEARRAY newPointer.
>  self
>   Test: input asSAFEARRAY
>   result: answer.
>  ^answer asObject
> !
>
> Test: input result: result
>  "Private - Invoke the test() method of the COM object.
>
>   HRESULT __stdcall test(
>    [in] SAFEARRAY(BSTR) input,
>    [out, retval] SAFEARRAY(BSTR)* result);"
>
>  <virtual stdcall: hresult 8 SAFEARRAY* SAFEARRAY**>
>  ^self invalidCall
> !
>
> test2: inStrings
>  "Answer the <SAFEARRAY> result of invoking the test2() method of the COM
> object."
>
>  | answer |
>  answer := SAFEARRAY newPointer.
>  self
>   Test2: inStrings asSAFEARRAY
>   ppsaOut: answer.
>  ^answer asObject
> !
>
> Test2: inStrings ppsaOut: ppsaOut
>  "Private - Invoke the test2() method of the COM object.
>
>   HRESULT __stdcall test2(
>    [in] SAFEARRAY(BSTR)* InStrings,
>    [out, retval] SAFEARRAY(BSTR)* ppsaOut);"
>
>  <virtual stdcall: hresult 9 SAFEARRAY** SAFEARRAY**>
>  ^self invalidCall
> ! !
> !ISTExample categoriesFor: #test:!**auto generated**!methods!public! !
> !ISTExample categoriesFor: #Test:result:!**auto generated**!COM
> Interfaces-ISTExample!private! !
> !ISTExample categoriesFor: #test2:!**auto generated**!methods!public! !
> !ISTExample categoriesFor: #Test2:ppsaOut:!**auto generated**!COM
> Interfaces-ISTExample!private! !
>
> ISTExample methodProtocol: #'STExample.ISTExample' attributes: #()
> selectors: #(#Test:result: #Test2:ppsaOut:)!
>
> !ISTExample class methodsFor!
>
> clsid
>  "Private - Answer the CLSID of the coclass (Example) for which the receiver
> is the default interface."
>
>  ^CLSID fromString: '{679EA2A8-860F-4C49-9761-E9540418865D}'
> !
>
> defineFunctions
>  "Declare the virtual function table for the COM interface
> 'STExample.ISTExample'
>   ISTExample defineTemplate"
>
>  self
>   defineFunction: #Test:result:
>    argumentTypes: 'SAFEARRAY* SAFEARRAY**';
>   defineFunction: #Test2:ppsaOut:
>    argumentTypes: 'SAFEARRAY** SAFEARRAY**'
> !
>
> initializeTypeLib
>  "Private - Establish a connection to the receiver's type library.
>   ISTExample initializeTypeLib"
>
>  typeLib := STExampleLib! !
> !ISTExample class categoriesFor: #clsid!**auto
> generated**!constants!private! !
> !ISTExample class categoriesFor: #defineFunctions!**auto
> generated**!initializing!public! !
> !ISTExample class categoriesFor: #initializeTypeLib!**auto
> generated**!initializing!private! !
>
> "Binary Globals"!
>
> STExampleLib := Object fromBinaryStoreBytes:
> (ByteArray fromHexString:
> '2153544220312046091500010000004158547970654C696272617279416E616C797A6572000
> 000000602090049547970654C69623200000000000000000000000006010800544C494241545
> 45200000000720000002000000012A1E09CFB8579478D15F2EF197C5F0200000000010000000
> 100000008000000520000000000000041000000520000000900000053544578616D706C65BA0
> 0000000000000520000000C00000053544578616D706C654C696200020000EA0000000000000
> 0F00000006200000002000000520000000400000047554944BA0000000000000052000000040
> 000004755494400000000')!
>
> "Resources"!