Currently the component is called from
vb script,dot net and will be also in access
Im more interested in wether it should work
my assembly uses strong names like the following and ive
included some code from the main program. Hopefully you
may spot something
Regards
Stu
Option Explicit On
Option Strict On
Imports System.Runtime. InteropServices
Imports System.Enterpri seServices
Imports System.Data
Imports System.Data.Sql Client
Imports CGCalc.Common
Imports CGCalc.CalcData Access
Namespace cgCalc
<Transaction(Tr ansactionOption .Required)> _
Public Class CalcEngine
Inherits ServicedCompone nt
Private Shared s_count As Integer = 0
Private m_count As Integer
Private m_canBePooled As Boolean = True
Public Sub New()
MyBase.New()
m_count =
System.Threadin g.Interlocked.I ncrement(s_coun t)
End Sub
Protected Overrides Function canBePooled() As
Boolean
Return m_canBePooled
End Function
Protected Overrides Sub activate()
m_canBePooled = False
End Sub
Protected Overrides Sub deactivate()
m_canBePooled = True
End Sub
Public Sub reset()
End Sub
Public ReadOnly Property version() As String
Get
version = CgCalcConfigura tion.CGTVersion
End Get
End Property
Public Property Calcmode() As Integer
Get
Calcmode = m_CalcMode
End Get
Set(ByVal Value As Integer)
If Value < 0 Or Value > 3 Then
Throw New Exception("Inva lid Calc
mode: " & CStr(Value))
End If
m_CalcMode = Value
CgCalcConfigura tion.glo.gCalcM ode = Value
End Set
End Property
Public Property Client() As Integer
Get
Client = CInt(m_Client)
End Get
Set(ByVal Value As Integer)
If Not
CgCalcConfigura tion.glo.gGloba lsLoaded Then
Throw New Exception("CGca lc has not
been initialised")
End If
objCalcDB.getCl ientType(m_Calc Mode, _
Value)
m_Client = Value
End Set
End Property
Public Property asset(ByVal passet As Integer) As
Integer
Get
passet = CInt(m_Asset)
End Get
Set(ByVal Value As Integer)
Dim reccount As Long
If Not
CgCalcConfigura tion.glo.gGloba lsLoaded Then
Throw New Exception("CGca lc has not
been initialised")
End If
'check asset exists
reccount = objCalcDB.Asset ExistsCheck
(Value)
If reccount = 0 Then
Throw New Exception("Inva lid Asset
Code: " & passet)
End If
m_Asset = Value
End Set
End Property
Public ReadOnly Property ErrorText() As String
Get
ErrorText = m_Error
End Get
End Property
Public ReadOnly Property MultPoss() As Boolean
Get
MultPoss = m_Multpos
End Get
End Property
Public Property MQuantity(ByVal Qty As Double) As
Double
Get
Dim TaxYear As Integer, LoadTable As
Boolean
Dim tcg() As CalcInfo
If Not
CgCalcConfigura tion.glo.gGloba lsLoaded Then
Throw New Exception("CGca lc has not
been initialised")
End If
Call Check_Parms()
LoadTable = True
Call objModel.Acheiv eRequiredTGainL oss
(m_Client, tcg, m_Asset, MDate, Price, _
m_Gain, m_ReturnGainLos s, GraphReqd, _
m_Qty, m_Multpos, m_ReturnCode,
AuditReqd, m_Error, LoadTable, TaxYear, m_CalcMode, 0)
MQuantity = m_Qty
If InStr(CgCalcCon figuration.glo. gErrText,
CgCalcConfigura tion.gFAILEDUPD ATETEXT) <> 0 Then
Throw New Exception
(CgCalcConfigur ation.gFAILEDUP DATETEXT)
End If
End Get
Set(ByVal Value As Double)
m_Qty = CDec(Value)
End Set
End Property
Public Property MGain() As Decimal
Get
Dim TaxYear As Integer
Dim tcg() As CalcInfo
Dim LoadTable As Boolean, UpdateData As
Boolean, IncludeUnconfir med As Boolean
If Not
CgCalcConfigura tion.glo.gGloba lsLoaded Then
Throw New Exception("CGca lc has not
been initialised")
End If
Call Check_Parms()
LoadTable = True
UpdateData = True
IncludeUnconfir med = False
Call objModel.Comput eGainLoss(m_Cli ent,
tcg, m_Asset, Price, MDate, _
TaxYear, m_Qty, m_NetGL, m_LossApplied,
m_Taper, m_Gain, _
m_LossCF, m_Error, UpdateData,
LoadTable, IncludeUnconfir med, _
AuditReqd, m_ReturnCode, m_CalcMode)
MGain = m_Gain
If InStr(CgCalcCon figuration.glo. gErrText,
CgCalcConfigura tion.gFAILEDUPD ATETEXT) <> 0 Then
Throw New Exception
(CgCalcConfigur ation.gFAILEDUP DATETEXT)
End If
End Get
Set(ByVal Value As Decimal)
m_Gain = Value
End Set
End Property
Public ReadOnly Property ReturnGain() As Decimal
Get
ReturnGain = m_ReturnGainLos s
End Get
End Property
Private Sub Check_Parms()
Dim holdingsDR As SqlDataReader
Dim reccount As Long
Dim validated_asset () As Boolean
Dim MaxHldgs As Integer, AssetX As Integer,
maxtxns As Integer, X As Integer
Dim NullTxn As CGcalcTxnStruct ure
If m_Client = 0 Then
m_ReturnCode = 9
Throw New Exception("Clie nt not
specified.")
End If
If m_CalcMode < 0 Or m_CalcMode > 3 Then
m_ReturnCode = 9
Throw New Exception("Calc mode incorrectly
specified: " & m_CalcMode)
End If
If m_CalcMode =
CgCalcConfigura tion.WHAT_IF_CA LC_MODE Then
If m_Asset = 0 Then
m_ReturnCode = 9
Throw New Exception("Asse t not
specified.")
End If
'check client has a holding in the asset
to model
reccount = objCalcDB.clien tAssetHldgExist s
(m_Client, m_Asset)
If reccount = 0 Then
m_ReturnCode = 9
Throw New Exception("Clie nt does not
have a holding in the asset.")
End If
End If
If m_CalcMode =
CgCalcConfigura tion.WHAT_IF_CA LC_MODE Then
'check date is >= current
If MDate < System.DateTime .Now Then
m_ReturnCode = 9
Throw New Exception("Mode lling date
cannot be in the past.")
End If
End If
If m_CalcMode =
CgCalcConfigura tion.MODEL_SLE_ TXNS_MODE Or m_CalcMode =
CgCalcConfigura tion.MODEL_PUR_ TXNS_MODE Then
maxtxns = UBound(m_ModelT xns)
For X = 1 To maxtxns
If CInt(m_ModelTxn s(X).InQty) = 0 Then
Exit For
End If
MaxHldgs = X
Next X
If MaxHldgs > 0 Then
ReDim validated_asset (MaxHldgs)
'validate all the holdings exist
holdingsDR =
objCalcDB.Clien tHoldingList(m_ Client)
Do While holdingsDR.Read
For AssetX = 1 To MaxHldgs
If CLng(holdingsDR .Item
("AssetID")) = m_ModelTxns(Ass etX).AssetID Then
validated_asset (AssetX) =
True
End If
Next AssetX
Loop
End If
For AssetX = 1 To MaxHldgs
If Not validated_asset (AssetX) Then
m_ReturnCode = 9
Throw New Exception("Clie nt does
not have a holding in the asset." & m_ModelTxns
(AssetX).AssetI D)
End If
Next AssetX
End If
End Sub
<AutoComplete() > _
Public Function CalcCGT() As Integer
Dim reccount As Long
Dim tcg() As CalcInfo
m_ReturnCode = 0
If Not CgCalcConfigura tion.glo.gGloba lsLoaded
Then
Throw New Exception("CGca lc has not been
initialised")
End If
Call Check_Parms()
objEvent.EventP rocessor(m_Clie nt, tcg,
m_CalcMode, m_Asset, 0, Price, _
True, True, False,
AuditReqd, m_ReturnCode)
CalcCGT = m_ReturnCode
If InStr(CgCalcCon figuration.glo. gErrText,
CgCalcConfigura tion.gFAILEDUPD ATETEXT) <> 0 Then
m_ReturnCode = 8
CalcCGT = 8
'Err.Raise 111 + gObjectError, ,
gFailedUpdateTe xt
End If
Return CalcCGT
End Function
Public ReadOnly Property ReturnCode() As String
Get
ReturnCode = CStr(m_ReturnCo de)
End Get
End Property
Public Sub InitialiseClass (ByVal PServer As
String, _
ByVal PDatabase As String, _
Optional ByVal PUser As String = "", _
Optional ByVal PPassword As String = "")
If Not CgCalcConfigura tion.glo.gGloba lsLoaded
Then
ReDim CgCalcConfigura tion.glo.gEELtx t(9)
Call load_globals(PS erver, _
PDatabase, _
PUser, _
PPassword, _
m_Error)
End If
If m_Error <> "" Then
Throw New Exception(m_Err or)
End If
End Sub
Public Function Execute(ByVal Action As String) As
String
'A generic function for future
methods/properties without
'inflicting painful version incompatability
issues.
'For use refer francesco balena's book
prog'ing vb6 pg850
Select Case Action
Case "CGCALC"
Execute = "test generic function"
Case "AutoGenerateAl lDisposals"
'this function just sets the boolean
value to state that all
'modelled txns will be generated
automatically from the notionals.
'Ordinarily this would be a class
variable, but rolling out a new class is
'too painful...!
m_AutoGenerateA llDisposals = True
Execute = "Set
AutoGenerateAll Disposals to true."
End Select
Return Execute
End Function
Public Property ModelTxns() As CGcalcTxnType()
Get
ModelTxns = m_ModelTxns
End Get
Set(ByVal Value As CGcalcTxnType() )
m_ModelTxns = Value
End Set
End Property
<AutoComplete() > _
Function ModelTxnSet() As Integer
Dim TaxYear As Integer
Dim tcg() As CalcInfo
If Not CgCalcConfigura tion.glo.gGloba lsLoaded
Then
Throw New Exception("CGca lc has not been
initialised")
End If
Call Check_Parms()
Select Case m_CalcMode
Case
CgCalcConfigura tion.MODEL_SLE_ TXNS_MODE
Call objModel.ModelM ultipleDisposal s
(m_Client, tcg, m_ModelTxns, ModelTxnSortID, m_NetGL, _
m_LossApplied, m_Taper,
m_ReturnGainLos s, m_LossCF, m_Error, m_ReturnCode,
m_CalcMode, _
m_AutoGenerateA llDisposals)
Case
CgCalcConfigura tion.MODEL_PUR_ TXNS_MODE
Call objModel.ModelM ultipleAcquisit ions
(m_Client, tcg, m_ModelTxns, m_NetGL, _
m_LossApplied, m_Taper,
m_ReturnGainLos s, m_LossCF, m_Error, m_ReturnCode,
m_CalcMode)
End Select
ModelTxnSet = m_ReturnCode
MGain = m_Gain
If InStr(CgCalcCon figuration.glo. gErrText,
CgCalcConfigura tion.gFAILEDUPD ATETEXT) <> 0 Then
Throw New Exception
(CgCalcConfigur ation.gFAILEDUP DATETEXT)
End If
Return ModelTxnSet
End Function
End Class
End Namespace
<Assembly: ApplicationActi vation(Activati onOption.Server )>
<Assembly: AssemblyTitle(" Calcxxxxx")>
<Assembly: ApplicationName ("xxxxxx(Dot Net)")>
<Assembly: AssemblyDescrip tion("Calculato r Engine")>
<Assembly: AssemblyCompany ("xxxxxx Financial Systems")>
<Assembly: AssemblyProduct ("xxxx")>
<Assembly: AssemblyCopyrig ht("2003")>
<Assembly: AssemblyTradema rk("")>
<Assembly: CLSCompliant(Tr ue)>
<Assembly: AssemblyKeyFile ("DotNetCalc.sn k")>
'The following GUID is for the ID of the typelib if this
project is exposed to COM
<Assembly: Guid("84838924-1931-4C0A-BB23-D4E4BFABAD96")>
' Version information for an assembly consists of the
following four values:
'
' Major Version
' Minor Version
' Build Number
' Revision
'
' You can specify all the values or you can default the
Build and Revision Numbers
' by using the '*' as shown below:
<Assembly: AssemblyVersion ("1.0.*")>
-----Original Message-----
Hi Stuart,
Can you modify your code as simple as possible and post
in the newsgroup for me to reproduce the problem?
do while not eof
x=createobject( "mycomp")
x.execute
set x=null
LOOP
Do you call the component in the Vb6 or VB.NET?
Regards,
Peter Huang
Microsoft Online Partner Support
Get Secure! www.microsoft.com/security
This posting is provided "as is" with no warranties and
confers no rights. --------------------Content-Class: urn:content-classes:message
From: <an*******@disc ussions.microso ft.com>
Sender: <an*******@disc ussions.microso ft.com>
References: <0e************ *************** *@phx.gbl>
<bp*********** **@ID-208219.news.uni-berlin.de>Subject: Re: vb dot net com+ Component rerun
Date: Thu, 13 Nov 2003 09:21:09 -0800
Lines: 46
Message-ID: <34************ *************** *@phx.gbl>
MIME-Version: 1.0
Content-Type: text/plain;
charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable
X-Newsreader: Microsoft CDO for Windows 2000
X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4910.0300
Thread-Index: AcOqCodX9pTNbyY iQlixxvvU5oROBg ==
Newsgroups: microsoft.publi c.dotnet.langua ges.vb
Path: cpmsftngxa06.ph x.gbl
Xref: cpmsftngxa06.ph x.gbl
microsoft.publi c.dotnet.langua ges.vb:156554NNTP-Posting-Host: TK2MSFTNGXA14 10.40.1.166
X-Tomcat-NG: microsoft.publi c.dotnet.langua ges.vb
Hi,
I dont thinkso as it works fine if i call it like this
do while not eof
x=createobject( "mycomp")
x.execute
set x=null
LOOP
-----Original Message-----
* "Stuart Dee" <s.***@cognatus .com> scripsit:
I have created a com+ component with vb dot net
using jit activation and transactions
If i call it like this
x=createobject( "mycomp")
x.dispose
it works fine
if i try it in a loop it then locks up.
i would like to run it this way. What do i need to do
x=createobject( "mycomp")
do while not eof
x.execute
LOOP
That should work. Maybe there is a bug in the
implementatio n of 'Execute'?
--
Herfried K. Wagner
MVP · VB Classic, VB.NET
<http://www.mvps.org/dotnet>
<http://www.plig.net/nnq/nquote.html>
.
.
