-- text figures

Figure 7 CDeviceProxy

Option Explicit

'local variable(s) to hold property value(s)
Private mvarDeviceId As String 'local copy
Private mvarDeviceType As String 'local copy
Private mvarDeviceServer As String 'local copy
Private mvarDeviceSize As Integer 'local copy
Private mvarDeviceUnitsFree As Integer 'local copy

Public Property Let DeviceId(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.DeviceName = 5
    mvarDeviceId = vData
End Property


Public Property Get DeviceId() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.DeviceName
    DeviceId = mvarDeviceId
End Property
Public Property Let DeviceType(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.DeviceName = 5
    mvarDeviceType = vData
End Property


Public Property Get DeviceType() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.DeviceName
    DeviceType = mvarDeviceType
End Property
Public Property Let DeviceServer(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.DeviceName = 5
    mvarDeviceServer = vData
End Property


Public Property Get DeviceServer() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.DeviceName
    DeviceServer = mvarDeviceServer
End Property
Public Property Let DeviceSize(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.DeviceName = 5
    mvarDeviceSize = vData
End Property


Public Property Get DeviceSize() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.DeviceName
    DeviceSize = mvarDeviceSize
End Property
Public Property Let DeviceUnitsFree(ByVal vData As Integer)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.DeviceName = 5
    mvarDeviceUnitsFree = vData
End Property


Public Property Get DeviceUnitsFree() As Integer
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.DeviceName
    DeviceUnitsFree = mvarDeviceUnitsFree
End Property

Public Function getDevices() As CDevices
    Dim gbo As New CObjectLocator
    Dim bTemp
    Dim rs As ADOR.Recordset
    Dim rsinfo
    Dim ses As New CDevices
    Dim util As New CUtility
On Error GoTo errHandler

    Set bTemp = gbo.GetBusinessObject("polAdminSVC.CDevice")
    Set rs = bTemp.getDevices()
    
    While Not rs.EOF
        Call util.StripNulls(rs, rsinfo)
        ses.Add CStr(rsinfo(0)), CStr(rsinfo(1)), CStr(rsinfo(2)), CInt(rsinfo(3)), 
            CInt(rsinfo(4)), CStr(rsinfo(0))
        rs.MoveNext
    Wend
    Set getDevices = ses
    GoTo endFunction
    
errHandler:
    Dim errMsg As New CBizErrorHandler
    errMsg.showErr Err.Number, Err.Description, Err.Source
    Err.Clear
    
endFunction:
    Set bTemp = Nothing
    Set gbo = Nothing
    Set rs = Nothing
    Set util = Nothing
End Function
Public Function addDevice(ByVal srvName As String, ByVal size As Integer,
                          ByVal perId As String)
    Dim gbo As New CObjectLocator
    Dim bTemp
    Dim rs As ADOR.Recordset
    Dim rsinfo
    Dim ses As New CSessionInfos
    Dim util As New CUtility
On Error GoTo errHandler

    Set bTemp = gbo.GetBusinessObject("polAdminSVC.CDevice")
    bTemp.addDevice srvName, size, perId
    
    GoTo endFunction
    
errHandler:
    Dim errMsg As New CBizErrorHandler
    errMsg.showErr Err.Number, Err.Description, Err.Source
    Err.Clear
    
endFunction:
    Set bTemp = Nothing
    Set gbo = Nothing
    Set rs = Nothing
    Set util = Nothing
End Function


CBizErrorhandler.cls

Option Explicit

Dim msg As String

Public Function showErr(ByVal errNum As Long, ByVal errDesc As String,
                        ByVal errSource As String)
    Select Case errNum
        Case -2147467259
            errDesc = "The requested project no longer exists in the PDS system."
            errSource = "PDS System"
        Case 8447
            errDesc = "Unable to establish communication with the internet server.  Please retry your request.  If this problem persists, please contact your internet service provider for assistance."
    End Select
    msg = "An error has occurred in your application" & vbLf & vbLf & _
            "Error Number: " & errNum & vbLf & _
            "Error Description: " & errDesc & vbLf & _
            "Error Source: " & errSource & vbLf & _
            "Error Time: " & Time
    MsgBox msg, POLFERRICON, POLFERRACTIVEXCAPTION
    Err.Clear
End Function

Figure 8 CObjectLocator

Option Explicit

Public Function GetBusinessObject(ByVal objectName As String)
On Error GoTo errHandle

    'Comment next line during debugging
    Dim oADS As New RDS.DataSpace
    Dim pTemp

    If Len(Trim(HTTPAddress)) = 0 Then HTTPAddress = GetSetting(POLREGROOT,
        "Web Addresses", "DEFAULT")
    
    'Comment next line during debugging and uncomment the following line
    Set pTemp = oADS.CreateObject(objectName, HTTPAddress)
    'Set pTemp = CreateObject(objectName)


    Set GetBusinessObject = pTemp
    
    GoTo endFunction
    
errHandle:
    Dim errMsg As New CBizErrorHandler
    errMsg.showErr Err.Number, Err.Description, Err.Source
    Err.Clear
    
endFunction:

    'Comment next line during debugging
    Set oADS = Nothing
    Set pTemp = Nothing

End Function

Figure 10 polAdminSvc.CDevice

Option Explicit
Public Function GetDevices() As Recordset
    
    Dim masterX
    Dim db
    Dim paramsX
    Dim rs As ADOR.Recordset

    Set masterX = CreateObject("polDBSVC.CSPMaster")
    Set db = CreateObject("polDBSVC.CSPExec")
    Set paramsX = CreateObject("polDBSVC.CSPParams")

    masterX.spName = "psp_get_polDevices"
    masterX.prjId = "polmaster"
    Set masterX.Params = paramsX
    Set rs = db.spExec(masterX)
    Set GetDevices = rs

    Set masterX = Nothing
    Set spExec = Nothing
    Set rs = Nothing
End Function

   
Public Function AddDevice(ByVal devServer As String, ByVal devSize As Integer, 
                          ByVal perId As String)
    Dim masterX
    Dim db
    Dim paramsX
    Dim rs As ADOR.Recordset

    Set masterX = CreateObject("polDBSVC.CSPMaster")
    Set db = CreateObject("polDBSVC.CSPExec")
    Set paramsX = CreateObject("polDBSVC.CSPParams")

    masterX.spName = "psp_add_polDevice"
    masterX.prjId = "polmaster"
    paramsX.Add "@dev_server", devServer, adParamInput, Len(devServer), adChar
    paramsX.Add "@dev_size", devSize, adParamInput, Len(devSize), adInteger
    paramsX.Add "@per_id", perId, adParamInput, Len(perId), adChar
    
    Set masterX.Params = paramsX
    
    Set rs = db.spExec(masterX)
    If Not Err.Number = 0 Then
        Err.Clear
    End If
    
    Set masterX = Nothing
    Set spExec = Nothing
    Set paramsX = Nothing
    Set rs = Nothing
End Function