Visual Basic 4 Power Pack/Visual_Basic4_Power_Pack.bin/vb4files/dbawarco/vb4oo.bas

BASIC Source File | 1996-11-20 | 6.7 KB | 251 lines

Attribute VB_Name = "TestDBAwareCollection"
Option Explicit

Public publicCompany As New Company

Public CompanyDatabase As Database
Private pvtPerson As Person
Private pvtPersons As New DBAwareCollection
Private pvtAddress As Address
Private pvtPhone As Phone

Public George As Person
Public Abe As Person
Public BillClinton As Person
Public HillaryClinton As Person
Public ChelseaClinton As Person

Sub CreateTestData()

'    Set pvtPersons = Company.Persons.pvtDBSelect()
    Dim tempNewPerson As New Person

    On Local Error Resume Next

    CompanyDatabase.Execute "DELETE FROM Persons "
    CompanyDatabase.Execute "DELETE FROM Addresses "
    CompanyDatabase.Execute "DELETE FROM Phones "
    CompanyDatabase.Execute "DELETE FROM DBAwareObjectLinks "

' an example if instantiating and populating
'   a Person object.
' Note: DBAwareCollection automatically creates
'   persistent objects by synchronizing object
'   creations, updates and deletions with
'   corresponding SQL directed at the appropriate
'   table
    Set George = New Person
    With George
        .CustomerNumber = "1363267"
        .FirstName = "George"
        .LastName = "Washington"
        .SSN = 123456789
        .DateOfBirth = #8/29/53#
    End With

 ' example of adding the Person to the
 '  Company.Persons DBAwareCollection object
    publicCompany.AddPerson _
        Item:=George
 '  (the Company.AddPerson is a wrapper for the
 '  DBAwareCollection.Add method, which
 '  automatically takes care of the Parent:=
 '  named parameter)

    Set Abe = New Person
    With Abe
        .CustomerNumber = "205289"
        .FirstName = "Abe"
        .LastName = "Lincoln"
        .SSN = 234567890
        .DateOfBirth = #11/3/58#
    End With
    publicCompany.AddPerson _
        Item:=Abe

    Set pvtAddress = New Address
    With pvtAddress
        .Line1 = "123 Elm"
        .City = "Phoenix"
        .StateCode = "AZ"
        .ZipCode = 80808
        .ZipSupplement = 5591
        .ZipExtension = 22
        .Status = "Current"
        .Usage = "Residence"
    End With

    George.AddAddress _
        Item:=pvtAddress

    Set pvtAddress = New Address
    With pvtAddress
        .Line1 = "122 Pine"
        .City = "Springfield"
        .StateCode = "IL"
        .ZipCode = 60609
        .Status = "Former"
        .Usage = "Residence"
    End With
    George.AddAddress _
        Item:=pvtAddress

    Set pvtPhone = New Phone
    With pvtPhone
        .PhoneNumber = "3035551400"
        .Usage = "Residence"
    End With
    George.AddPhone _
        Item:=pvtPhone

    Set pvtPhone = New Phone
    With pvtPhone
        .PhoneNumber = "8185551212"
        .Usage = "Business"
    End With
    George.AddPhone _
        Item:=pvtPhone

' example of containing one of George's
'   instantiated Address objects within the
'   Abe.Addresses DBAwareCollection object.
' Note: there is no new object instantiated due
'   to this operation -- both DBAwareCollections
'   contain references to the same object
    Abe.AddAddress _
        Item:=George.Addresses(1)

' example of containing one of George's
'   instantiated Phone objects within the
'   Abe.Phones DBAwareCollection object.
' Note: there is no new object instantiated due
'   to this operation -- both DBAwareCollections
'   contain references to the same object
    Abe.AddPhone _
        Item:=George.Phones(1)

    Set pvtAddress = New Address
    With pvtAddress
        .Line1 = "401 Maple"
        .City = "Boston"
        .StateCode = "MA"
        .ZipCode = 6709
        .Status = "Former"
        .Usage = "Residence"
    End With
    Abe.AddAddress _
        Item:=pvtAddress

    Set pvtPhone = New Phone
    With pvtPhone
        .PhoneNumber = "2024441578"
        .Usage = "Business"
    End With
    Abe.AddPhone _
        Item:=pvtPhone

    Set pvtPhone = New Phone
    With pvtPhone
        .PhoneNumber = "9132242668"
        .Usage = "Fax"
    End With
    Abe.AddPhone _
        Item:=pvtPhone

' add filler data
    Set BillClinton = New Person
    With BillClinton
        .CustomerNumber = "1"
        .FirstName = "Bill"
        .LastName = "Clinton"
        .SSN = 123456789
        .DateOfBirth = #1/3/48#
    End With
    publicCompany.AddPerson _
        Item:=BillClinton

    Set HillaryClinton = New Person
    With HillaryClinton
        .CustomerNumber = "2"
        .FirstName = "Hillary"
        .LastName = "Clinton"
        .SSN = 234567890
        .DateOfBirth = #6/22/49#
    End With
    publicCompany.AddPerson _
        Item:=HillaryClinton

    Set ChelseaClinton = New Person
    With ChelseaClinton
        .CustomerNumber = "3"
        .FirstName = "Chelsea"
        .LastName = "Clinton"
        .SSN = 345678901
        .DateOfBirth = #8/29/80#
    End With
    publicCompany.AddPerson _
        Item:=ChelseaClinton

    Set pvtAddress = New Address
    With pvtAddress
        .Line1 = "123 Pennsylvannia Ave."
        .City = "Washington"
        .StateCode = "DC"
        .ZipCode = 12345
        .ZipSupplement = 1001
        .Status = "Current"
        .Usage = "Primary"
    End With
    BillClinton.AddAddress _
        Item:=pvtAddress

    HillaryClinton.AddAddress _
        Item:=BillClinton.Addresses(1)

    ChelseaClinton.AddAddress _
        Item:=BillClinton.Addresses(1)

' example of an on-demand creation of a
'   DBAwareCollection of instantiated objects,
'   based on the contents of the database.
' this is an example of how DBAwareCollection
'   provides object persistence by re-instantiating
'   objects from the database at some time after
'   their initial instantiation.
' Note: this uses the
'   DBAwareCollection.InstantiateFromDatabase
'   method
' gather all of the above individuals and
'   place them in pvtPersons
'    publicCompany.EmptyPersons
    Set pvtPersons = _
        pvtPersons.InstantiateFromDatabase( _
            Database:=CompanyDatabase, _
            Parent:=publicCompany, _
            SampleObject:=tempNewPerson)

    Abe.AddAddress _
        Item:=BillClinton.Addresses(1)

' example of DBAwareCollection.Replace to
'   replace an object in a DBAwareCollection
    Abe.Addresses.Replace _
        Item:=Abe.Addresses(3), _
        ReplaceWith:=George.Addresses(2)
End Sub

Sub Main()

    Set CompanyDatabase = DBEngine.Workspaces(0). _
        OpenDatabase(App.Path & "\VB4OO.MDB")

    Set publicCompany = New Company

    pvtPersons.SetDatabaseParameters _
        Database:=CompanyDatabase, _
        OrderByClause:="LastName ASC, FirstName ASC"

    Intro.Show

End Sub