ActiveX DLL на PB

[jangle]

Кто-нибудь уже делал в девятке?

[jangle]

Есть такая COM DLL, при подключении к VB, видна в проводнике объектов, но созадать экземпляр объекта из VB нельзя.
Не пойму в чем проблема

Код: Выделить всё

'------------------------------------------------------------------------------
'   CVACALC.BAS   2008
'   Created by R. Angell    - Public Domain, use at your own risk
'   Demo of a COM Class "published" in a DLL
'------------------------------------------------------------------------------
#Compiler PBWin 9
#Compile Dll "CVACalc.Dll"
#Dim All
'REGISTER NONE must be outside the class def
'to avoid erasing register values during
'other processing
#Register None
'
'Lets add some info for potential users to retrieve with COM browsers, etc.
#Com Doc "CVACalc encapsulates several methods for resolving vector values."
'#COM HELP "MyProg.chm", &H1E00   'no hlep file , but would be spec'd here
#Com Name "CVACalc", 0.0001
#Com Guid Guid$("{C6053157-DAD1-4FAF-B4D7-96C128E522CB}")
#Com TLib On    'set to ON to use PB COM Browser to produce include file
'---------------
' Note: the GUID$ entry above and the 2 following shortly are easily
'       generated using the right click menu in PB's IDE. Then choose
'       Insert GUID at the appropriate spots, shown here.  You can
'       also do this with the Ctrl+Alt+G hotkey.
'---------------
%USEMACROS = 1
#Include "Win32API.inc"

$CVACALCGUID = Guid$("{A6AE5018-2FBC-4952-B078-A94FC27FF351}")
$CVACALCIO   = Guid$("{CD68C662-926E-49F2-8B38-526A50469942}")

Global ghInstance As Dword
'-------------------------------------------------------------------------------
' Main DLL entry point called by Windows...
' Using standard PB WinMain template function, comments removed
Function LibMain (ByVal hInstance   As Long, _
                  ByVal fwdReason   As Long, _
                  ByVal lpvReserved As Long) As Long
    Select Case fwdReason
    Case %DLL_PROCESS_ATTACH
        ghInstance = hInstance
        Function = 1

    Case %DLL_PROCESS_DETACH
        Function = 1

    Case %DLL_THREAD_ATTACH
        Function = 1

    Case %DLL_THREAD_DETACH
        Function = 1
    End Select
End Function
'------------------------------------------------------------------------------
'   Here is where we are adding the Class(es).
'   Note:
'   For a compliant COM class (AS COM) we are can only use variable types
'   BYTE, WORD, DWORD, INTEGER, LONG, QUAD, SINGLE, DOUBLE, CURRENCY,
'   OBJECT, STRING, and VARIANT, when such are published variables.
'   See "What is a Base Class?" in the Programming Reference\Objects and
'   COM Programming section of the PBWin 9 help file
'------------------------------------------------------------------------------
Class CVACALC $CVACALCGUID As Com
    'INSTANCE variables
    'A unique set of instance variables
    'will be created for every new object,
    'created from this CLASS; and which
    'may only be referenced from within
    Instance ptX          As Double
    Instance ptY          As Double
    Instance radangle     As Double
    Instance vlength      As Double
    Instance dangleraw    As Double
    Instance dangleABS    As Double
    Instance HasValues    As Long

    'Class Methods are private within
    'the classes' objects, that is they can not be
    'accessed externally, only internally.  You
    'access them using the ME keyword, like this:
    'ME.CalcRadAngle
    Class Method CalcRadAngle()
        'requires ptX and ptY
        'You can declare local varibles
        'and arrays in a CLASS METHOD or
        'in INTERFACE METHODs
         Local ry,rx As Double
         ry = ptY
         rx = ptX
         ! emms
         ! fld ry
         ! fld rx
         ! fpatan
         ! fstp ry
         radangle = ry
    End Method


    Class Method CalcDegreeAngleRAW()
        'requires radangle
        dangleraw = radangle * 57.29577951308232##
    End Method


    Class Method CalcDegreeAngleABS()
        'requires dangleraw
        If dangleraw = 0 Then dangleraw = radangle * 57.29577951308232##
        If Sgn(dangleraw) = -1 Then
            dangleABS = 360 + dangleraw
        Else
            dangleABS = dangleraw
        End If
    End Method

    Class Method CalcVectorLengthXY()
        'requires ptX and ptY
        vlength = Sqr((ptX)^2+(ptY)^2)
    End Method

    Class Method  CalcPolar2Rect()
        'requires radangle and  vlength
        'ptX and ptY  are the return values
        'vlength is the distance from origin to point ptX,ptY
        ptX = vlength * Cos(radangle)
        ptY = vlength * Sin(radangle)
    End Method

    Class Method CalcDegreesToRadians()
         radangle = dangleABS * 0.0174532925199433##
    End Method


    Class Method Update(ByVal updcase As Long)
        Select Case As Long updcase
            Case 1        'coordinates input updates
                ME.CalcRadAngle()
                ME.CalcDegreeAngleRAW()
                ME.CalcDegreeAngleABS()
                ME.CalcVectorLengthXY()

            Case 2        'polar input updates
                ME.CalcPolar2Rect()
                ME.CalcDegreeAngleRAW()
                ME.CalcDegreeAngleABS()

            Case 3        'degree angle vector inputs update
                ME.CalcDegreeAngleABS()
                ME.CalcDegreesToRadians
                ME.CalcPolar2Rect()
        End Select
        HasValues = 1
    End Method

    '--------------------------------------------------------------------------
    ' INTERFACES are where we define the externally accessible Methods and
    ' properties for an object created as an INTERFACE type.  While accessible
    ' externally if so specified, an INTERFACE can be marked AS HIDDEN  to
    ' prevent its being documented in the Type Library (.tlb)
    '--------------------------------------------------------------------------

    Interface CALCIO $CVACALCIO
        Inherit IUnknown                 'INHERIT CUSTOM for those who like

        'The INTERFACE's methods are equivalent to SUBs and FUNCTIONs
        'these here are like SUBs, but when a METHOD has the
        'FUNCTION style, with the AS vartype return type
        'then the methods value is assigned METHOD = retvalue
        'There are other source and help examples showing this.
        Method CalcReset Alias "CalcReset" ()
            ptX = 0
            ptY = 0
            dangleraw = 0
            dangleABS = 0
            radangle  = 0
            vlength   = 0
            HasValues = 0
        End Method

        Method XYIn  Alias "XYIn" (ByVal X As Double,ByVal y As Double)
            ptX = X
            ptY = Y
            ME.Update(1)
        End Method

        Method PolarIn  Alias "PolarIn"(ByVal radianangle As Double,ByVal vectorlength As Double)
            radangle = radianangle
            vlength  = vectorlength
            ME.Update(2)
        End Method

        Method DegreeAngleVector  Alias "DegreeAngleVector"(ByVal angleraw As Double,ByVal vectorlength As Double)
            If Sgn(angleraw) = -1 Then
                dangleraw = angleraw
                dangleABS = 180 + angleraw
            Else
                dangleraw = angleraw
                dangleABS = angleraw
            End If
            vlength  = vectorlength
            ME.Update(3)
        End Method

        'Properties are a special kind of method for setting or
        'returning a value. In this demo, we are only returning
        'resulting variable values after one of the primary
        'methods has been called.

        Property Get X Alias "x"() As Double
            Property = ptX
        End Property

        Property Get Y Alias "y" () As Double
            Property = ptY
        End Property

        Property Get radians Alias "radians"() As Double
            Property = radangle
        End Property

        Property Get degrees Alias "degrees"() As Double
            Property = dangleABS
        End Property

        Property Get degreesPM Alias "degreesPM"() As Double
            Property = dangleraw
        End Property

        Property Get vectorlength Alias "vectorlength"() As Double
            Property = vlength
        End Property

        Property Get TTT Alias "TEST"() As String
            Property = "HELLO WORD!"
        End Property


    End Interface
End Class

[Kumpel]

Возможно, за два месяца Вы и сами разобрались, но, на всякий случай:
1) В интерфейсе CALCIO необходимо "INHERIT IDispatch" вместо "IUnknown", иначе VB не простит;
2) PB9 загоняет в TLB описание кокласса с параметром "noncreatable" ...
Нужно декомпильнуть CVACalc.tlb (я использовал OLEVIEW.EXE), закомментировать "noncreatable" и компильнуть заново. У меня все работает. Ниже правка под ODL - синтаксис:

Код: Выделить всё

// Generated .IDL file (by the OLE/COM Object Viewer)
//
// typelib filename: CVACalc.Dll

[
  uuid(C6053157-DAD1-4FAF-B4D7-96C128E522CB),
  version(0.1),
  helpstring("CVACalc encapsulates several methods for resolving vector values.")
]
library CVACalc
{
    // TLib :     // TLib : OLE Automation : {00020430-0000-0000-C000-000000000046}
    importlib("stdole32.tlb");

    // Forward declare all types defined in this typelib
    interface CALCIO;
   
typedef double          DOUBLE;

    [
      odl,
      uuid(CD68C662-926E-49F2-8B38-526A50469942),
      helpstring("CALCIO is a dual interface with IDispatch."),
      dual,
      nonextensible,
      oleautomation
    ]
    interface CALCIO : IDispatch {
        [id(0x00000101)]
        HRESULT CalcReset();
        [id(0x00000102)]
        HRESULT XYIn(
                        [in] double X,
                        [in] double Y);
        [id(0x00000103)]
        HRESULT PolarIn(
                        [in] double RADIANANGLE,
                        [in] double VECTORLENGTH);
        [id(0x00000104)]
        HRESULT DegreeAngleVector(
                        [in] double ANGLERAW,
                        [in] double VECTORLENGTH);
        [id(0x00000105), propget]
           HRESULT X([out, retval] double*  pData);
        [id(0x00000106), propget]
        HRESULT Y([out, retval] double*  pData);
        [id(0x00000107), propget]
        HRESULT radians([out, retval] double*  pData);
        [id(0x00000108), propget]
        HRESULT degrees([out, retval] double*  pData);
        [id(0x00000109), propget]
        HRESULT degreesPM([out, retval] double*  pData);
        [id(0x0000010a), propget]
        HRESULT VECTORLENGTH([out, retval] double*  pData);
        [id(0x0000010b), propget]
        HRESULT TEST([out, retval] BSTR*  pData);
    };

    [
      uuid(A6AE5018-2FBC-4952-B078-A94FC27FF351),
      //noncreatable
    ]
    coclass CVACalc {
        [default] interface CALCIO;
    };
};

Но, в VB все равно пришлось использовать

Код: Выделить всё

MsgBox StrConv(CVACalc.TEST, vbUnicode)

Наверное это немножко не то OOP в PB9, особенно, если Вы захотите получить поддержку доп. стандартных интерфейсов.
Два года назад я слепил Edm32 в виде ActiveX Dll используя низкий COM на PB8 без особых проблем и боюсь, что это более приемлемый путь использования PB-COM в VB и на сегодня.

[jangle]

Kumpel - кстати спасибо за полезную инфу!