Visual Basic 4 Unleashed/Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso/source/chap28/frm128.frm

Visual Basic Form | 1995-10-11 | 15.4 KB | 439 lines

VERSION 4.00
Begin VB.Form form128
   BackColor       =   &H00C0C0C0&
   Caption         =   "Form1"
   ClientHeight    =   5940
   ClientLeft      =   1140
   ClientTop       =   1515
   ClientWidth     =   6690
   Height          =   6375
   Left            =   1080
   LinkTopic       =   "Form1"
   ScaleHeight     =   5940
   ScaleWidth      =   6690
   Top             =   1140
   Width           =   6810
   Begin VB.CommandButton cmdcreatetable
      Caption         =   "Create Table"
      Height          =   390
      Left            =   1920
      TabIndex        =   16
      Top             =   2400
      Width           =   1635
   End
   Begin VB.CommandButton cmdrecordsets
      Caption         =   "RecordSet Examples"
      Height          =   390
      Left            =   180
      TabIndex        =   15
      Top             =   2400
      Width           =   1635
   End
   Begin VB.CommandButton cmdqryopenrecordset
      Caption         =   "Open Recordset Qry"
      Height          =   390
      Left            =   3660
      TabIndex        =   14
      Top             =   2880
      Width           =   1635
   End
   Begin VB.CommandButton cmdqueryexecute
      Caption         =   "Query execute"
      Height          =   390
      Left            =   1920
      TabIndex        =   13
      Top             =   2880
      Width           =   1635
   End
   Begin VB.CommandButton cmdtdopenrecordset
      Caption         =   "Open Recordsets TD"
      Height          =   390
      Left            =   180
      TabIndex        =   12
      Top             =   2880
      Width           =   1635
   End
   Begin VB.CommandButton cmdcreatetdproperty
      Caption         =   "Create Property TD"
      Height          =   390
      Left            =   3660
      TabIndex        =   11
      Top             =   3360
      Width           =   1635
   End
   Begin VB.CommandButton cmcreateindex
      Caption         =   "Create Index"
      Height          =   390
      Left            =   1920
      TabIndex        =   10
      Top             =   3360
      Width           =   1635
   End
   Begin VB.CommandButton cmdaddfield
      Caption         =   "Add field"
      Height          =   390
      Left            =   180
      TabIndex        =   9
      Top             =   3360
      Width           =   1635
   End
   Begin VB.CommandButton cmdrelation
      Caption         =   "Create Relation"
      Height          =   390
      Left            =   3660
      TabIndex        =   8
      Top             =   3840
      Width           =   1635
   End
   Begin VB.CommandButton cmdquery
      Caption         =   "Create Query"
      Height          =   390
      Left            =   1920
      TabIndex        =   7
      Top             =   3840
      Width           =   1635
   End
   Begin VB.CommandButton cmdcreateproperty
      Caption         =   "Create Property DB"
      Height          =   390
      Left            =   180
      TabIndex        =   6
      Top             =   3840
      Width           =   1635
   End
   Begin VB.CommandButton cmdrecordset
      Caption         =   "Open Recordsets"
      Height          =   390
      Left            =   3660
      TabIndex        =   5
      Top             =   4320
      Width           =   1635
   End
   Begin VB.CommandButton cmdversion
      Caption         =   "Version "
      Height          =   390
      Left            =   1920
      TabIndex        =   4
      Top             =   4320
      Width           =   1635
   End
   Begin VB.CommandButton cmdeditable
      Caption         =   "Editable Record"
      Height          =   390
      Left            =   180
      TabIndex        =   3
      Top             =   4320
      Width           =   1635
   End
   Begin VB.CommandButton cmdrecordeffected
      Caption         =   "Records Effected"
      Height          =   390
      Left            =   3660
      TabIndex        =   2
      Top             =   4800
      Width           =   1635
   End
   Begin VB.CommandButton cmdcreate
      Caption         =   "Create DataBase"
      Height          =   390
      Left            =   1920
      TabIndex        =   1
      Top             =   4800
      Width           =   1635
   End
   Begin VB.CommandButton cmdtransactions
      Caption         =   "Transaction Example"
      Height          =   390
      Left            =   180
      TabIndex        =   0
      Top             =   4800
      Width           =   1635
   End
Attribute VB_Name = "form128"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub cmcreateindex_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim indx1 As index
Dim fld1 As Field
Dim tbltitles As TableDef
' Create the WorkSpace
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
' Open the DataBase
Set dbbiblio = wstitle.OpenDatabase("\source\chap28\biblio.mdb", False, False)
' Open the Table Definition
Set tbltitles = dbbiblio!titles
' Create the new Index object.
Set indx1 = tbltitles.CreateIndex("nonthindx")
' define the index field
Set fld1 = indx1.CreateField("month")
' Define the index as non primary, non unique, and non required
indx1.Unique = False
indx1.Primary = False
indx1.Required = False
indx1.Fields.Append fld1 ' Save Index definition by appending it to Indexes collection.
tbltitles.Indexes.Append indx1
End Sub
Private Sub cmdaddfield_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim tbltitles As TableDef
Dim fld1 As Field
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, False)
' Get the Existing Table Definition
Set tbltitles = dbbiblio!titles
' Create Field object.
Set fld1 = tbltitles.CreateField("month", dbText, 12)
    ' Append MyField to Fields collection.
tbltitles.Fields.Append fld1
End Sub
Private Sub cmdcreate_Click()
Dim wstitle As Workspace
Dim dbnew As Database
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbnew = wstitle.CreateDatabase("\source\chap28\new.mdb", dbLangGeneral)
End Sub
Private Sub cmdcreateproperty_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim propdirty As Property
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, False)
' Create the New Property
Set propdirty = dbbiblio.CreateProperty("dirty", dbBoolean, True, False)
' Save the Property definition
dbbiblio.Properties.Append propdirty
Debug.Print propdirty.Value
propdirty.Value = True
Debug.Print propdirty.Value
End Sub
Private Sub cmdcreatetable_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim newtable As TableDef
Dim fld1 As Field
Dim fld2 As Field
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, False)
' creates a table if Data Base specified in Parameter 1
Set newtable = dbbiblio.CreateTableDef("books")
' add the fields to the tabledef Object
Set fld1 = newtable.CreateField("")
fld1.Name = "Title"
fld1.Type = dbText
fld1.Size = 30
newtable.Fields.Append fld1
Set fld2 = newtable.CreateField("")
fld2.Name = "Author"
fld2.Type = dbText
fld2.Size = 30
newtable.Fields.Append fld2
' Now add the table definition to the database object
' ---------------------------------------------
dbbiblio.TableDefs.Append newtable
End Sub
Private Sub cmdcreatetdproperty_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim proptext As Property
Dim tbltitle As TableDef
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, False)
Set tbltitle = dbbiblio!titles
' Create the New Property
Set proptext = tbltitle.CreateProperty("contents", dbText, "Test", False)
' Save the Property definition
tbltitle.Properties.Append proptext
Debug.Print proptext.Value
proptext.Value = " testing property"
Debug.Print proptext.Value
End Sub
Private Sub cmdeditable_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim rstitles As Recordset
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, True)
Set rstitles = dbbiblio.OpenRecordset(" select * from titles", dbOpenDynaset)
If dbbiblio.Updatable = True Then
    rstitles.Edit
    MsgBox ("This Recordset Is Read Only ")
End If
End Sub
Private Sub cmdqryopenrecordset_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim proptext As Property
Dim tbltitle As TableDef
Dim qrynew As QueryDef
Dim rstitle As Recordset
' open the Workspace
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
' open the DataBase
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, False)
' Set the QueryDef  Definition
Set qrynew = dbbiblio.OpenQueryDef("new")
qrynew.SQL = " Select * from titles "
' Open the RecordSet
Set rstitle = qrynew.OpenRecordset(dbOpenDynaset)
End Sub
Private Sub cmdquery_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim qrynew As QueryDef
Dim rstitles As Recordset
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("\source\chap28\biblio.mdb", False, False)
' Create a New QueryDef
Set qrynew = dbbiblio.CreateQueryDef("new", "Select * from titles where pubid = 13")
' Load The Recordset based on the New Query
Set rstitles = dbbiblio.OpenRecordset("new", dbOpenDynaset)
End Sub
Private Sub cmdqueryexecute_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim qrynew As QueryDef
Dim rstitles As Recordset
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, False)
Set rstitles = dbbiblio.OpenRecordset(" select * from titles", dbOpenDynaset)
Set qrynew = dbbiblio.OpenQueryDef("new")
qrynew.SQL = "update titles set notes = 'Test Notes'"
wstitle.BeginTrans
qrynew.Execute
If MsgBox("There have been " & qrynew.RecordsAffected & " Records changed Do you wish to Save the Changes you have Made ", vbYesNo, "", "", 0) = vbYes Then
    wstitle.CommitTrans
    wstitle.Rollback
End If
End Sub
Private Sub cmdrecordeffected_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim rstitles As Recordset
Dim csql As String
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, False)
Set rstitles = dbbiblio.OpenRecordset(" select * from titles", dbOpenDynaset)
wstitle.BeginTrans
csql = " update titles set notes = 'Test Notes' "
dbbiblio.Execute csql, dbFailOnError
If MsgBox("There have been " & dbbiblio.RecordsAffected & " Records changed Do you wish to Save the Changes you have Made ", vbYesNo, "", "", 0) = vbYes Then
    wstitle.CommitTrans
    wstitle.Rollback
End If
End Sub
Private Sub cmdrecordset_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim rstitles As Recordset
Dim dstitles As Dynaset
Dim sntitles As Snapshot
Dim tbltitles As Table
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, True)
' old method to create a Dynaset Object
Set dstitles = dbbiblio.CreateDynaset("Select * from titles")
'New Method to Open a Dynaset Type Recordset
Set rstitles = dbbiblio.OpenRecordset(" select * from titles", dbOpenDynaset)
' old method to create a Table Object
Set tbltitles = dbbiblio.OpenTable("titles")
'New Method to Open a Dynaset Type Recordset
Set rstitles = dbbiblio.OpenRecordset("titles", dbOpenTable)
' Old method to create a SnapShot Object
Set sntitles = dbbiblio.CreateSnapshot("Select * from titles")
'New Method to Open a Dynaset Type Recordset
Set rstitles = dbbiblio.OpenRecordset(" select * from titles", dbOpenSnapshot)
End Sub
Private Sub cmdrecordsets_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim rstitles As Recordset
Dim dstitles As Dynaset
Dim sntitles As Snapshot
Dim tbltitles As Table
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, True)
' old method to create a Dynaset Object
'Set dstitles = dbbiblio.CreateDynaset("Select * from titles")
'New Method to Open a Dynaset Type Recordset
Set rstitles = dbbiblio.OpenRecordset(" select * from titles", dbOpenDynaset)
' old method to create a Table Object
'Set tbltitles = dbbiblio.OpenTable("titles")
'New Method to Open a Dynaset Type Recordset
'Set rstitles = dbbiblio.OpenRecordset("titles", dbOpenTable)
' Old method to create a SnapShot Object
'Set sntitles = dbbiblio.CreateSnapshot("Select * from titles")
'New Method to Open a Dynaset Type Recordset
'Set rstitles = dbbiblio.OpenRecordset(" select * from titles", dbOpenSnapshot)
rstitles.AbsolutePosition = 1
End Sub
Private Sub cmdrelation_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim relnew As Relation
Dim fld1 As Field
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, False)
' Create a New Relation
Set relnew = dbbiblio.CreateRelation("new", "publishers", "titles", _
dbRelationLeft + dbRelationUpdateCascade + dbRelationDeleteCascade)
' Set the parant table field for the Relation
Set fld1 = relnew.CreateField("pubid")
' Set the Child Table field for the Relation
fld1.ForeignName = "pubid"
' Update the Fields portion of the Relations Collection
relnew.Fields.Append fld1
' Update the New Relation to the  Relations Collection
dbbiblio.Relations.Append relnew
End Sub
Private Sub cmdtdopenrecordset_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim proptext As Property
Dim tbltitle As TableDef
Dim rstitle As Recordset
' open the Workspace
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
' open the DataBase
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, False)
' Set the Table Definition
Set tbltitle = dbbiblio!titles
' Open the RecordSet
Set rstitle = tbltitle.OpenRecordset(dbOpenDynaset)
End Sub
Private Sub cmdtransactions_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim rstitles As Recordset
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("biblio.mdb", False, False)
Set rstitles = dbbiblio.OpenRecordset(" select * from titles", dbOpenDynaset)
If rstitles.RecordCount = 0 Then
    Exit Sub
End If
wstitle.BeginTrans
Do While rstitles.EOF = False
    rstitles.Edit
    rstitles("notes") = " Test Notes "
    rstitles.Update
    rstitles.MoveNext
If MsgBox("Do you wish to Save the Changes you have Made ", vbYesNo, "", "", 0) = vbYes Then
    wstitle.CommitTrans
    wstitle.Rollback
End If
End Sub
Private Sub cmdversion_Click()
Dim wstitle As Workspace
Dim dbbiblio As Database
Dim rstitles As Recordset
Set wstitle = DBEngine.CreateWorkspace("title", "Admin", "")
Set dbbiblio = wstitle.OpenDatabase("\source\chap28\biblio.mdb", False, True)
MsgBox " The Version of the DBENGINE is " _
& DBEngine.Version & ". The version of the " _
& dbbiblio.Name & " Database is " _
& dbbiblio.Version & "."
End Sub