Here is the source code for CHelloWorld.cls:
'=== PUBLIC PROPERTIES
' These properties can be modified directly by the caller
Public ConnectionString As String
'=== PRIVATE DATA MEMBERS
Private objHelloData As CHelloData
Private Sub Class_Initialize()
' Set the class defaults here
ConnectionString = "DSN=HelloWorld"
Set objHelloData = New CHelloData
End Sub
Private Sub Class_Terminate()
Set objHelloData = Nothing
End Sub
Public Sub SayHello(Optional ByVal LanguageCode As String)
Dim objResponse As ASPTypeLibrary.Response
Dim strLang As String, strPhrase As String
On Error GoTo ErrHandler
' Business Logic:
' We're only interested in the major language (ISO 639-1),
' so we discard the locality. Also, if no language is
' specified, or if the phrase is not found, we resort to
' English (en).
If LanguageCode <> "" Then
strLang = Left(LanguageCode, 2)
Else
strLang = "en"
End If
objHelloData.ConnectionString = ConnectionString
strPhrase = objHelloData.GetPhrase(strLang)
If strPhrase = "" Then
' We can assume there will always be a phrase for English.
strPhrase = objHelloData.GetPhrase("en")
End If
' Finally, report the results to the user
Set objResponse = GetObjectContext.Item("Response")
objResponse.Write "<b>VISUAL BASIC COMPONENT SAYS:</b> """ & strPhrase & """<br>" & vbCrLf
Set objResponse = Nothing
Exit Sub
ErrHandler:
' NOTE: This call will cause the component to halt execution
' and return an error to the caller.
Err.Raise Err.Number, Err.Source, Err.Description
End Sub
Here is the source code for CHelloData.cls:
'=== PUBLIC PROPERTIES
' These properties can be modified directly by the caller
Public ConnectionString As String
Private Sub Class_Initialize()
ConnectionString = "DSN=HelloWorld"
End Sub
Public Function GetPhrase(ByVal LanguageCode As String) As String
Dim oc As MTxAS.ObjectContext
Dim cmd As ADODB.Command
Dim params As ADODB.Parameters
On Error GoTo ErrHandler
Set oc = GetObjectContext
Set cmd = oc.CreateInstance("ADODB.Command")
With cmd
.ActiveConnection = ConnectionString
.CommandTimeout = 90
.CommandText = "sp_helloworld"
.CommandType = adCmdStoredProc
'Pass Arguments to stored procedure
Set params = .Parameters
params.Append .CreateParameter("@iso3691", adChar, adParamInput, 8, LanguageCode)
params.Append .CreateParameter("@phrase", adVarChar, adParamOutput, 255)
'Execute the command
.Execute
End With
'Return value (add empty string in case of NULL)
GetPhrase = params("@phrase") & ""
'Release the memory
Set cmd = Nothing
Set oc = Nothing
Exit Function
ErrHandler:
' NOTE: This call will cause the component to halt execution
' and return an error to the caller.
Err.Raise Err.Number, Err.Source, Err.Description
End Function