IonicWind Software

I was working on an example that would show how ActiveX (COM) DLLs written in Visual Basic could be used in Aurora. One thing that I just can't seem to resolve, and it may be simple and I'm just not seeing the forest for the trees, is that if I have a method that is passed a VARIANT parameter, it crashes. If the method just returns a variant, it's no problem.

The VB code looks like this:


Public Sub About()
    MsgBox "The TestClass.About method has been called", vbInformation
End Sub

Public Function Add(ByVal nValue1 As Long, ByVal nValue2 As Long) As Long
    Add = nValue1 + nValue2
End Function

Public Function Subtract(ByVal nValue1 As Long, ByVal nValue2 As Long) As Long
    Subtract = nValue1 - nValue2
End Function

Public Function Message(ByVal nId As Long) As String
    Dim strValue As String
    strValue = "This is message number " + CStr(nId)
    Message = strValue
End Function

Public Function Multiply(ByVal nValue1 As Long, ByVal nValue2 As Long) As Long
    Multiply = nValue1 * nValue2
End Function

Public Function Test() As Variant
    Test = CVar(1234)
End Function

Public Function TestParam(ByVal varValue As Variant) As Variant
    TestParam = CVar(CLng(varValue))
End Function


So we're not talking rocket science here in terms of the interface. Very, very simple stuff. All of the method calls work, except for TestParam which bombs. Here's the Aurora code:


#autodefine "off"
#include "testclass.inc"

global sub main()
{
    OpenConsole();

    // Define standard interface IDs
    GUID IID_NULL;
    DEFINE_GUID(IID_NULL, 0x00000000, 0x0000, 0x0000, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00);

    GUID IID_IUnknown;
    DEFINE_GUID(IID_IUnknown, 0x00000000, 0x0000, 0x0000, 0xC0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x46);

    GUID IID_IClassFactory;
    DEFINE_GUID(IID_IClassFactory, 0x00000001, 0x0000, 0x0000, 0xC0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x46);

    GUID IID_IDispatch;
    DEFINE_GUID(IID_IDispatch, 0x00020400, 0x0000, 0x0000, 0xC0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x46);

    // Initialize the COM subsystem
    HRESULT hr;
    hr = CoInitializeEx(null, COINIT_APARTMENTTHREADED);
    if (FAILED(hr))
    {
        writeln("The CoInitializeEx function returned 0x" + NumToHex(hr) + "\n");
        while GetKey() = "";
        return 0;
    }

    // Define the interface ID for TestClass
    GUID IID_ITestClass;
    DEFINE_GUIDSTRUCT("{1C43F580-38E0-4843-8AD9-F462E85D8D86}", IID_ITestClass);

    // Get the class ID for the control using the ProgID
    LPOLESTR pwszProgID = OLESTR("TestControl.TestClass");
    GUID CLSID_TestClass;
    hr = CLSIDFromProgID(pwszProgID, CLSID_TestClass);
    if (FAILED(hr))
    {
        writeln("The CLSIDFromProgID function returned 0x" + NumToHex(hr) + "\n");
        while GetKey() = "";
        return 0;
    }

    // Create an instance of TestClass using a class factory
    IClassFactory *pFactory = NULL;
    hr = CoGetClassObject(CLSID_TestClass, CLSCTX_INPROC_SERVER, NULL, IID_IClassFactory, &pFactory);
    if (FAILED(hr))
    {
        writeln("The CoGetClassObject function returned 0x" + NumToHex(hr) + "\n");
        while GetKey() = "";
        return 0;
    }

    IUnknown *pUnknown = NULL;
    hr = pFactory->CreateInstance(NULL, IID_IUnknown, &pUnknown);
    if (FAILED(hr))
    {
        writeln("The CreateInstance method returned 0x" + NumToHex(hr) + "\n");
        while GetKey() = "";
        return 0;
    }
    pFactory->Release();

    // Get a pointer to the TestClass interface
    ITestClass *pTestClass = NULL;
    hr = pUnknown->QueryInterface(IID_ITestClass, &pTestClass);
    if (FAILED(hr))
    {
        writeln("The CreateInstance method returned 0x" + NumToHex(hr) + "\n");
        while GetKey() = "";
        return 0;
    }

    writeln("An instance of the TestClass object has been created\n");

    // Call the About method
    pTestClass->About();

    // Call the Add method
    int nResult = 0;
    hr = pTestClass->Add(10, 5, &nResult);
    writeln("The Add method returned 0x" + NumToHex(hr) + ", nResult=" + NumToStr(nResult) + "\n");

    // Call the Multiply method
    nResult = 0;
    hr = pTestClass->Multiply(10, 5, &nResult);
    writeln("The Mutiply method returned 0x" + NumToHex(hr) + ", nResult=" + NumToStr(nResult) + "\n");

    // Call the Subtract method
    nResult = 0;
    hr = pTestClass->Subtract(15, 5, &nResult);
    writeln("The Subtract method returned 0x" + NumToHex(hr) + ", nResult=" + NumToStr(nResult) + "\n");

    // Call the Message method
    BSTR bstrValue = null;
    hr = pTestClass->Message(1234, &bstrValue);
    writeln("The Message method returned 0x" + NumToHex(hr) + ", bstrValue=[" + ANSISTR(bstrValue) + "]\n");

    // Call the Test method
    VARIANT varResult;
    VariantInit(&varResult);
    hr = pTestClass->Test(&varResult);
    writeln("The Test method returned 0x" + NumToHex(hr) + ", varResult=" + NumToStr(varResult.lVal) + "\n");

#ifdef CRASH
    // Call the TestParam method
    VARIANT varValue;
    VariantInit(&varValue);
    VariantClear(&varResult);
    varValue.vt = VT_I4;
    varValue.lVal = 9876;
    hr = pTestClass->TestParam(&varValue, &varResult);
    writeln("The TestParam method returned 0x" + NumToHex(hr) + ", varResult=" + NumToStr(varResult.lVal) + "\n");
#endif

    CoUninitialize();

    while GetKey() = "";
    return 0;
}


From what I can see, everything is typed correctly and I used the typelib browser that JosÃÆ'Ã,© posted as a foundation and then went from there. But if you define CRASH and call the TestParam method passing in a variant, it bombs. If anyone has any clues as to what I'm doing wrong, I'd appreciate some insight. I've also attached the code for the projects.

My browser currently declares BYVAL variants as a pointer because apparently Aurora doesn't support (yet?) passing structures by value and gives a syntax error if you declare it as BYVAL var AS VARIANT. It crashes because we are passing the address of a variant when we should be pushing to the stack the 16 bytes of the variant.

Variant arguments can be passed by value or reference. When a Visual Basic program calls a procedure declared to receive a Variant by reference, the calling program passes a pointer to the Variant variable. If the procedure is declared to receive a Variant argument by value, then the calling program passes the complete Variant structure (sixteen bytes) in the stack.

You know, I could have sworn that I had tried changing the method to use ByRef (in the VB object) and it had crashed. But when I made that change just now, it compiled and ran with no problem. You're absolutely right, for COM support Aurora needs to be able to pass structures by value and push the whole thing on the stack. I know that right now, you have no choice; it'll always pass a structure by reference.

Thanks for taking a look at that, I thought I was going blind or stupid there for a minute. ;)

Right now you might want to make a small change that just emits a comment that passing a VARIANT by value is not currently supported. By the way, I think that's a fantastic tool. Thanks very much for porting it to Aurora.

Here is a way to pass the 16 bytes of the variant by value without using assembler. Not nice, but...

Change the declaration of TestParam to:


declare virtual TestParam(int v1, int v2, int v3, int v4, VARIANT *pvarResult), HRESULT;


Declare a dummy structure with an array of four longs:


struct MyDummyVariant
{
    int v[4];
}


Change the code as follows:


// Call the Test method
VARIANT varResult;
VariantInit(&varResult);
hr = pTestClass->Test(&varResult);
writeln("The Test method returned 0x" + NumToHex(hr) + ", varResult=" + NumToStr(varResult.lVal) + "\n");
VariantClear(&varResult);

// Call the TestParam method
VARIANT varValue;
VariantInit(&varValue);
varValue.vt = VT_I4;
varValue.lVal = 9876;
    MyDummyVariant *pdv;
    pdv = &varValue;
hr = pTestClass->TestParam(pdv->v[0], pdv->v[1], pdv->v[2], pdv->v[3], &varResult);
writeln("The TestParam method returned 0x" + NumToHex(hr) + ", varResult=" + NumToStr(varResult.lVal) + "\n");
VariantClear(&varValue);


I think you could also do it as:


declare virtual TestParam(int64 v1, int64 v2, VARIANT *pvarResult), HRESULT;



hr = pTestClass->TestParam(*(int64)(&varValue), *(int64)(&varValue + 8), &varResult);


Eliminating the need the for the dummy structure. Either way, yeah, it's pretty funky. :)

Your method crashes.

We need support for BYVAL variants soon. Imagine that someone wants to use Excel, that has some methods with 30 byval variants... 30 x 4 = 120 parameters, more than the 100 currently allowed.

I agree, had same problems with webband example from Microsoft ftp (http://ftp://ftp.microsoft.com).
The item() method never returns, in addition plays a MB_ICONSTOP wav.
CWBExplorerBar::ManageAnchorsEventSink(AdviseType adviseType)
{
//ÂÃ,  _ASSERT(_pWebBrowserOC);

ÂÃ,  ÂÃ, if ((adviseType = Unadvise) and (_stackAnchorCookies.empty()))
ÂÃ,  ÂÃ,  ÂÃ,  return;

ÂÃ,  ÂÃ, if (_pWebBrowserOC)
ÂÃ,  ÂÃ, {
ÂÃ,  ÂÃ,  ÂÃ,  // Sink Anchor Events
ÂÃ,  ÂÃ,  ÂÃ,  IDispatch* pDisp;
ÂÃ,  ÂÃ,  ÂÃ,  if ((!_pWebBrowserOC->get_Document(&pDisp)) and (pDisp))
ÂÃ,  ÂÃ,  ÂÃ,  {
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, IHTMLDocument2* pDoc;
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, HRESULT hr = pDisp->QueryInterface(_IID_IHTMLDocument2, &pDoc);
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, pDisp->Release();

ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, if (hr)
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  return;

ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, //
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, // Advise all the anchors on the page so we can get the onclick events
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, // For the search pages, the anchors collection is empty.ÂÃ,  Therefore,
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, // we have to iterate through the entire all collection and advise
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, // each anchor tag.
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, //
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, IHTMLElementCollection* pElemColl;
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, hr = pDoc->get_all(&pElemColl);
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, pDoc->Release();

ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, if (hr)
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  return;

ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, long lNumElems = 0;
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, pElemColl->get_length(&lNumElems);

ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, for (int i = 0; i < lNumElems; i++)
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, {
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  VARIANT vtItem; vtItem.vt = VT_I4; vtItem.lVal = i;
ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  VARIANT vtEmpty; vtEmpty.vt = VT_EMPTY;

ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  hr = pElemColl->item(vtItem, vtEmpty, &pDisp);

The first two parameters of the IHTMLCollection Item's method are BYVAL VARIANTs, so it can't work because of the mentioned problem. Besides, to omit a value of an optional parameter you can't simply pass a VT_EMPTY variant (sometimes works, depending of how the programmer has coded it, but its not the standard way), but a VT_ERROR variant filled with the value DISP_E_PARAMNOTFOUND).

To detect if an HTML element has been clicked, instead of advising all the elements (with the problem that you have to store all the cookies to later unadvise), I have used with success the following code (its PowerBASIC code, but you will understand it):


' ****************************************************************************************
' Function name: onclick
' Fires when the user clicks the left mouse button on the object.
' Member identifier: &HFFFFFDA8 (-600)
' ****************************************************************************************
SUB HTMLDocumentEvents2_onclick (BYVAL pCookie AS HTMLDocumentEvents2_IDispatchVtbl PTR, BYREF pdispparams AS DISPPARAMS, BYREF pvarResult AS VARIANT)

'  Retrieve the IUnknown or IDispatch of the control that has fired the event.
   LOCAL pthis AS DWORD : pthis = @@pCookie.pthis
'  Pointer to access the parameter
   LOCAL pv AS VARIANT PTR : pv = pdispparams.VariantArgs
'  Pointer to an IHTMLEventObj interface for the current event.
   LOCAL pEvtObj AS DWORD : pEvtObj = VARIANT#(@pv[0])

'  ===========================================================================================
'  *** Put your code here ***
'  Note: The return type for pvarResult is %VT_BOOL <INTEGER>
'  Return Value: If the event bubbles and is cancellable, return 0 to prevent the
'  event from bubbling to other event handlers in the document tree. Return -1 to
'  allow bubbling. (The documentation wrongly says the opposite.)
'  ===========================================================================================

   LOCAL pvr AS VARIANTAPI PTR
   pvr = VARPTR(pvarResult)
   @pvr.vt = %VT_BOOL
   @pvr.vd.boolVal = -1

'  ===========================================================================================

   LOCAL ppElement AS DWORD             ' // Element that has fired the event
   LOCAL strId AS STRING                ' // Identifier of the element that has fired the event
   LOCAL strValue AS STRING             ' // Value of the property

   ' // Get a reference to the element that has fired the event
   IF pEvtObj THEN ppElement = IHTMLEventObj_GetSrcElement(pEvtObj)
   IF ppElement THEN
      ' // Get the identifier of the element that has fired the event
      strId = IHTMLElement_GetId(ppElement)
      SELECT CASE strId
         CASE "Button_1", "Button_2", "Button_3", "Button_4"
            HTMLDocument_SetElementInnerHtmlById pthis, "output", "You have clicked " & strId
         CASE "Button_GetText"
            strValue = HTMLDocument_GetElementValueById(pthis, "Input_Text")
            MSGBOX strValue
      END SELECT
      ' // Release the IHTMLElement interface
      HTMLDocumentEvents2_IUnknown_Release ppElement
   END IF

END SUB
' ****************************************************************************************


This is the wrapper function to retrieve a value by its identifier. Only problem (nothing is perfect) is that all the elements that you want to detect if have been clicked must have an identifier.


' ****************************************************************************************
' HTMLDocument_GetElementValueById
' Parameters:
' - pHTMLDocument = Reference to the IHTMLDocument interface
' - strId = The value of the ID attribute
' Return Value:
' An string containing the value as defined by the attribute.
' This method performs a case insensitive property search.
' If two or more attributes have the same name (differing only in uppercase and lowercase
' letters) this function retrieves values only for the last attribute created with this
' name, and ignores all other attributes with the same name.
' When retrieving the CLASS attribute using this method, set the strAttributeName to be
' "className", which is the corresponding Dynamic HTML (DHTML) property.
' This function is used only by events created from HTML Components.
' HtmlResult will return %S_OK if successful, or an error value otherwise.
' ****************************************************************************************
FUNCTION HTMLDocument_GetElementValueById ALIAS "HTMLDocument_GetElementValueById" (BYVAL pHTMLDocument AS DWORD, BYVAL strId AS STRING) EXPORT AS STRING

   LOCAL ppDoc3 AS DWORD                ' // Reference to the IHTMLDocument3 interface
   LOCAL ppElement AS DWORD             ' // Reference to the element
   LOCAL IID_IHTMLDocument3 AS GUID     ' // IHTMLDocument3 interface identifier
   LOCAL pvar AS VARIANT                ' // General purpose variant

   IF ISFALSE pHTMLDocument THEN HTML_HRESULT = %E_POINTER : EXIT FUNCTION
   IID_IHTMLDocument3 = GUID$("{3050F485-98B5-11CF-BB82-00AA00BDCE0B}")
   ' // Get a reference to the IHTMLDocument3 interface
   ppDoc3 = HtmlQueryInterface(pHTMLDocument, IID_IHTMLDocument3)
   IF ppDoc3 THEN
      ' // Get a reference to the input element
      ppElement = IHTMLDocument3_GetElementById(ppDoc3, strId)
      IF ppElement THEN
         ' // Get the value
         IHTMLElement_GetAttribute ppElement, "value", 0, pvar
         ' // Release the element interface
         HtmlRelease ppElement
      END IF
      ' // Release the IHTMLDocument3 interface
      HtmlRelease ppDoc3
   END IF

   IF VARIANTVT(pvar) = %VT_BOOL THEN
      FUNCTION = LTRIM$(STR$(CINT(VARIANT#(pvar))))
   ELSEIF VARIANTVT(pvar) = %VT_BSTR THEN
      FUNCTION = VARIANT$(pvar)
   ELSE
      FUNCTION = LTRIM$(STR$(VARIANT#(pvar)))
   END IF

END FUNCTION
' ****************************************************************************************


In PowerBASIC, variants are native, so initialization and memory management is performed by the compiler. The problem with this compiler, regarding COM support, is that it only supports natively Automation, and I have to waste countless hours writing wrappers if I want to use interfaces directly derived from IUnknown.

Actually what your running into is that C passes any structure 16 bytes or less on the stack, not specifically variant related but it is causing your problem.  Since most COM objects are written in C.

using this small helper in separate module, the method item is working now:#asm

global variant2stack

variant2stack:
pop edx            ;// return address
pop ecx            ;// pointer to variant
push dword[ecx+12] ;// last VARIANT dword
push dword[ecx+8]  ;// third VARIANT dword
push dword[ecx+4]  ;// push second VARIANT dword
push dword[ecx]    ;// push first VARIANT dword

jmpÂÃ,  edxÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ,  ÂÃ, ;// return
#endasm

usage:extern void variant2stack(VARIANT *v);

hr = pElemColl->item(variant2stack(vtItem), variant2stack(vtEmpty), &pDisp); ;D

A3 Rev 1 allows passing structures by value now.  Just got it working ;)

Very cool, and COM users around the world thank you. :)

Any sense of when A3R1 will be released?

Depends ;)

Sabres game is on tonight and I'll be glued to the set.  Tomorrow I am pouring a new foundation for the rear of the house.  Sunday I'll have more time to work on it.

Paul.

Quote from: Ionic Wizard on April 28, 2006, 04:07:27 PM
... Tomorrow I am pouring a new foundation for the rear of the house. Sunday I'll have more time to work on it.

more like Sunday you'll be icing your back ;)

One caveat about the way that it's been implemented, you can't have something like this:


declare virtual SomeFunction(varValue1 VARIANT, varValue2 VARIANT, VARIANT *pvarResult), HRESULT;


Even though a pointer isn't specified, it's still passing the VARIANT by reference. You have to declare it like this:


declare virtual SomeFunction(varValue1 VARIANT byval, varValue2 VARIANT byval, VARIANT *pvarResult), HRESULT;


The 'byval' keyword is required, it's not implied.

Yes the default is by reference as it always has been.  BYVAL forces passing by value.

Then, it doesn't make any difference to use VARIANT *pvarResult or VARIANT pvarResult?

Must be always use a syntax such varValue1 VARIANT byval or other forms like VARIANT varValue1 byval are alsio allowed?

The syntax is either:

VARIANT varValue1 BYVAL

or

varValue1 AS VARIANT BYVAL

Mike had it a little off in his post ;)

I did have it backwards, but funny enough, it compiles and works correctly that way. :)

The compiler is treating the "as" as an optional decoration?

Flexibility is my middle name ;)