Visual Basic 4 Power Pack/Visual_Basic4_Power_Pack.bin/vb4files/dbawarco/dbawarlk.cls

Text File | 1996-11-20 | 5.4 KB | 193 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "DBAwareObjectLink"
Attribute VB_Creatable = True
Attribute VB_Exposed = False
Option Explicit
' DBAwareObjectLink is a component of the
'   DBAwareCollection database-aware Collection
'   class for Microsoft Visual Basic 4.0

Private pvtDatabase As Database
Private pvtRecordSet As RecordSet
Private pvtSQLStatement As String
Private pvtDBAwareCollection As DBAwareCollection
Private pvtCollectionEmulationMode As Boolean



Public Function CountOfParentObjectLinksToItem(Optional ByVal Parent As Variant, Optional ByVal Child As Variant) As Long
' Return the number of Parent links exist for
'   the specified Child object

    Dim SQLStatement As String

    On Local Error Resume Next

' bullet-proofing
    If IsMissing(Parent) _
    Or IsMissing(Child) _
    Or pvtCollectionEmulationMode Then
        CountOfParentObjectLinksToItem = -1
        Exit Function
    End If

    Err = 0

' build the SQL statement to perform the Count
    SQLStatement = _
        "SELECT COUNT(*) FROM " & TableName() & " " & _
        "WHERE ToObjectType = '" & _
        Child.ObjectType & "' AND ToObjectID = " & _
        Child.ObjectID

' check for non-existent Object
    If Err = 91 Then
        CountOfParentObjectLinksToItem = 0
        Exit Function
    End If

    Set pvtRecordSet = pvtDatabase. _
                        OpenRecordset( _
                            SQLStatement, _
                            dbOpenDynaset)

    If Err <> 0 Then
        pvtErrorMessage pvtDBAwareCollection.Name & " received a database error while attempting to count the object containment links (Select Count(*))."
        CountOfParentObjectLinksToItem = 0
    Else
        CountOfParentObjectLinksToItem = pvtRecordSet(0)
    End If

    Set pvtRecordSet = Nothing
End Function
Private Function pvtErrorMessage(Optional ByVal ErrorMessage As Variant) As Long

    Dim RC As Long

    RC = MsgBox( _
        ErrorMessage & vbCrLf & "Err=" & Err & ", Msg=" & Error(Err), _
        vbOK + vbExclamation, _
        pvtDBAwareCollection.Name & " Run-Time Error")
    Err = 0
    pvtErrorMessage = RC
End Function

Public Function DeleteParentObjectLinksToItem(Optional ByVal Parent As Variant, Optional ByVal Child As Variant) As Long
' Remove the link between the Parent and Child

    Dim SQLStatement As String

    On Local Error Resume Next

    If pvtCollectionEmulationMode Then
        DeleteParentObjectLinksToItem = True
        Exit Function
    End If

    Err = 0

' delete the row from the DBAwareObjectLinks table
    SQLStatement = _
        "DELETE FROM " & TableName() & " WHERE FromObjectType = '" & _
        Parent.ObjectType & "' AND FromObjectID = " & _
        Parent.ObjectID & " AND ToObjectType = '" & _
        Child.ObjectType & "' AND ToObjectID = " & _
        Child.ObjectID

' check for illegal Object
    If Err = 91 Then
        DeleteParentObjectLinksToItem = False
        Exit Function
    End If

    pvtDatabase.Execute SQLStatement
    If Err <> 0 And Err <> 3078 Then '
        pvtErrorMessage pvtDBAwareCollection.Name & " received a database error while attempting to remove an object containment link (Delete)."
        DeleteParentObjectLinksToItem = False
        Exit Function
    End If

    DeleteParentObjectLinksToItem = True
End Function


Public Sub SetDatabaseParameters(Optional ByVal Database As Variant, Optional ByVal DBAwareCollection As Variant, Optional ByVal CollectionEmulationMode As Variant)
' Receive user-defined parameters

    If Not IsMissing(Database) Then
        Set pvtDatabase = Database
    End If

    If Not IsMissing(DBAwareCollection) Then
        Set pvtDBAwareCollection = DBAwareCollection
    End If

    If Not IsMissing(CollectionEmulationMode) Then
        pvtCollectionEmulationMode = CollectionEmulationMode
    End If

End Sub


Public Function LinkParentObjectToChildObject(Optional ByVal Parent As Variant, Optional ByVal Child As Variant) As Long

    Dim SQLStatement As String

    On Local Error Resume Next

    If pvtCollectionEmulationMode Then
        LinkParentObjectToChildObject = True
    End If

' insert a row into the DBAwareObjectLinks table
    SQLStatement = _
        "INSERT INTO " & TableName() & " " & _
        "(FromObjectType" & _
        ",FromObjectID" & _
        ",ToObjectType" & _
        ",ToObjectID"
    SQLStatement = SQLStatement & _
        ") VALUES " & _
        "('" & Parent.ObjectType & "'" & _
        ", " & Parent.ObjectID & "" & _
        ",'" & Child.ObjectType & "'" & _
        ", " & Child.ObjectID & ""
    SQLStatement = SQLStatement & _
        ")"

    pvtDatabase.Execute SQLStatement
    If Err <> 0 Then '
        pvtErrorMessage pvtDBAwareCollection.Name & " received a database error while attempting to establish an object containment link (Insert)."
        LinkParentObjectToChildObject = False
        Exit Function
    End If

    LinkParentObjectToChildObject = True
End Function
Public Function ObjectType() As String
    ObjectType = "DBAwareObjectLink"
End Function



Public Property Get ObjectID()
    ObjectID = -1
End Property


Public Function TableName() As String
    TableName = "DBAwareObjectLinks"
End Function


Private Sub Class_Initialize()

    pvtCollectionEmulationMode = False

End Sub