Programming Tool Box/SIMS_2.iso/vb_code2/v_bench/vbench.frm

Text File | 1994-07-13 | 14KB | 472 lines

VERSION 2.00
Begin Form Vbench
   BackColor       =   &H00C0C0C0&
   Caption         =   "VBench"
   ClientHeight    =   3228
   ClientLeft      =   1584
   ClientTop       =   660
   ClientWidth     =   5172
   Height          =   3648
   Left            =   1536
   LinkTopic       =   "Form1"
   ScaleHeight     =   3228
   ScaleWidth      =   5172
   Top             =   288
   Width           =   5268
   Begin TextBox Text1
      Height          =   372
      Index           =   4
      Left            =   2520
      TabIndex        =   8
      Text            =   "Text1"
      Top             =   2160
      Width           =   2412
   End
   Begin TextBox Text1
      Height          =   372
      Index           =   3
      Left            =   2520
      TabIndex        =   7
      Text            =   "Text1"
      Top             =   1680
      Width           =   2412
   End
   Begin TextBox Text1
      Height          =   372
      Index           =   2
      Left            =   2520
      TabIndex        =   6
      Text            =   "Text1"
      Top             =   1200
      Width           =   2412
   End
   Begin TextBox Text1
      Height          =   372
      Index           =   1
      Left            =   2520
      TabIndex        =   5
      Text            =   "Text1"
      Top             =   720
      Width           =   2412
   End
   Begin TextBox Text1
      Height          =   372
      Index           =   0
      Left            =   2520
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   240
      Width           =   2412
   End
   Begin CommandButton Command1
      Caption         =   "E&xit"
      Height          =   372
      Index           =   3
      Left            =   3840
      TabIndex        =   3
      Top             =   2760
      Width           =   1092
   End
   Begin CommandButton Command1
      Caption         =   "&Populate"
      Height          =   372
      Index           =   2
      Left            =   2640
      TabIndex        =   2
      Top             =   2760
      Width           =   1092
   End
   Begin CommandButton Command1
      Caption         =   "&Select"
      Height          =   372
      Index           =   1
      Left            =   1440
      TabIndex        =   1
      Top             =   2760
      Width           =   1092
   End
   Begin CommandButton Command1
      Caption         =   "&Update"
      Height          =   372
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   2760
      Width           =   1092
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Parameter QueryDef"
      ForeColor       =   &H00FF0000&
      Height          =   252
      Index           =   4
      Left            =   240
      TabIndex        =   13
      Top             =   2160
      Width           =   2412
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Static QueryDef"
      ForeColor       =   &H00FF0000&
      Height          =   252
      Index           =   3
      Left            =   240
      TabIndex        =   12
      Top             =   1680
      Width           =   2412
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Inline VB SQL"
      ForeColor       =   &H00FF0000&
      Height          =   252
      Index           =   2
      Left            =   240
      TabIndex        =   11
      Top             =   1200
      Width           =   2412
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Dynaset FindFirst"
      ForeColor       =   &H00FF0000&
      Height          =   252
      Index           =   1
      Left            =   240
      TabIndex        =   10
      Top             =   720
      Width           =   2412
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "ISAM Table Seek"
      ForeColor       =   &H00FF0000&
      Height          =   252
      Index           =   0
      Left            =   240
      TabIndex        =   9
      Top             =   240
      Width           =   2412
   End
End
'Declarations

Option Explicit
Dim db As database
Dim tbl As Table
Dim dyna As dynaset
Dim qd As querydef
Dim foo As Integer
Declare Function GetTickCount Lib "User" () As Long


Sub CloseDb ()
On Error Resume Next
    dyna.Close
    tbl.Close
    qd.Close
    db.Close
    DoEvents
End Sub

Sub Command1_Click (Index As Integer)
Dim TimeCount As Long, TimeStart As Long
Dim foobar As Integer, foo As Integer
ReDim cost(5) As Double

TimeCount = 0
'Set the hourglass
Screen.MousePointer = 11

Select Case Index

'Update Operations ======================================
'The objective here is to examine 1000 out of 10,000 records,
'and modify those that match a given criteria - about 200 writes
Case 0
    Me.Caption = "VBench: Update Operation Benchmarks"
    FileCopy "C:\vb\IoTest.Mdb", "C:\vb\IoTest.Bak"
    'Seeks and indexed sequential updates ---------------
    'Open the database logicals
    OpenDb
    'Start the clock
    TimeStart = GetTickCount()
    'Use transactions for speed
    BeginTrans
    'Jump to first ID using a fast seek
    tbl.Seek ">=", 5000
    'Continue searching till eof or break
    Do Until tbl.EOF
    'Test if reached top of range
    If tbl!id < 6000 Then
        'Test if record meets change criteria
        If tbl!cost > 30 And tbl!cost < 40 Then
        tbl.Edit
        tbl!cost = tbl!cost * .9
        tbl.Update
        End If
    Else
        'Exit if past top of range
        Exit Do
    End If
    'Get the next record
    tbl.MoveNext
    Loop
    CommitTrans
    'Stop the clock and report
    TimeCount = GetTickCount() - TimeStart
    Text1(0) = Format$(TimeCount / 1000, "##0.00")
    CloseDb
    'Dynaset FindFirst ---------------------------------------
    'Start each iteration with same file
    FileCopy "C:\vb\IoTest.bak", "C:\vb\IoTest.mdb"
    'Open the data logicals
    OpenDb
    'Start The Clock
    TimeStart = GetTickCount()
    'Use transactions for speed
    BeginTrans
    'Jump to first record
    dyna.FindFirst "Id >= 5000"
    'Continue searching till eof or break
    Do Until dyna.EOF
    'Test if reached top of range
    If dyna!id < 6000 Then
        'Test if record meets change criteria
        If dyna!cost > 30 And dyna!cost < 40 Then
        dyna.Edit
        dyna!cost = dyna!cost * .9
        dyna.Update
        End If
    Else
        'Exit loop if past top of range
        Exit Do
    End If
    'Get the next record
    dyna.MoveNext
    Loop
    CommitTrans
    'Stop the clock and report
    TimeCount = GetTickCount() - TimeStart
    Text1(1) = Format$(TimeCount / 1000, "##0.00")
    CloseDb
    'Test SQL processing with inline VB code ----------
    'Start each iteration with same file
    FileCopy "C:\vb\IoTest.bak", "C:\vb\IoTest.mdb"
    'Open the database logicals
    OpenDb
    'Start The Clock
    TimeStart = GetTickCount()
    'Execute the statement on databse DB
    db.Execute "Update testtable Set Cost = Cost *.9 where cost > 30 and cost < 40 and id >= 5000 and id < 6000 and id/2 = id\2"
    'Stop the clock and report
    TimeCount = GetTickCount() - TimeStart
    Text1(2) = Format$(TimeCount / 1000, "##0.00")
    CloseDb
    'Test SQL processing with Stored QueryDef -------
    'Start each iteration with same file
    FileCopy "C:\vb\IoTest.bak", "C:\vb\IoTest.mdb"
    'Open the database logicals
    OpenDb
    'Store the procedure before starting the clock
    Set qd = db.CreateQueryDef("TestQd", "Update testtable Set Cost = Cost *.9 where cost > 30 and Cost < 40 and id >= 5000 and id < 6000")
    qd.Close
    'Start The Clock
    TimeStart = GetTickCount()
    'Use Transactions for speed
    BeginTrans
    'Execute the querydef on database DB
    db.Execute "TestQd"
    CommitTrans
    'Stop the clock and report
    TimeCount = GetTickCount() - TimeStart
    Text1(3) = Format$(TimeCount / 1000, "##0.00")
    'Remove the querydef - normally we wouldn't do this
    db.DeleteQueryDef "TestQd"
    CloseDb
    'ParameterQueryDef ------------------------------------
    'Start each iteration with same file
    FileCopy "C:\vb\IoTest.bak", "C:\vb\IoTest.mdb"
    'Open the database logicals
    OpenDb
    'Store the procedure before starting the clock
    Set qd = db.CreateQueryDef("TestQd", "Parameters IdSearch1 Long, IdSearch2 Long, CostSearch1 IEEEDouble, CostSearch2 IEEEDouble; Update testtable Set Cost = Cost *.9 where cost > CostSearch1 and cost < CostSearch2 and id >= IdSearch1 and id < IdSearch2")
    qd.Close
    'Start the clock
    TimeStart = GetTickCount()
    BeginTrans
    'Open the querydef
    Set qd = db.OpenQueryDef("TestQd")
    'Set the paramter values
    qd!IdSearch1 = 5000
    qd!IdSearch2 = 6000
    qd!CostSearch1 = 30
    qd!CostSearch2 = 40
    'Execute the querydef
    qd.Execute
    CommitTrans
    'Stop the clock and report
    TimeCount = GetTickCount() - TimeStart
    Text1(4) = Format$(TimeCount / 1000, "##0.00")
    'Remove the querydef - normally we wouldn't do this
    qd.Close
    db.DeleteQueryDef "TestQd"
    CloseDb

'Select Operations ======================================
'The objective of this benchmark is to read selected records From
'X to Y. For seeks and findfirst we need to get to X,then move
'through the records testing the criteria. For QueryDefs we need
'to select the desired records and then scan them all to achieve
'a similar result. Our criteria is all records with an even numbered
'ID between 5000 and 5100, for example 5000, 5002, 5004, etc.
Case 1
    Me.Caption = "VBench: Select Operation Benchmarks"
    'Initialize and open the database logicals
    OpenDb
    'Table Seek -------------------------------------------------
    'Start the clock
    TimeStart = GetTickCount()
    'Repeat the operation to get a meaningful time
    For foo = 1 To 10
    'Position to the first record with a seek
    tbl.Seek "=", 5001
    'Look at each record
    For foobar = 1 To 98
        If tbl!id / 2 = tbl!id \ 2 Then
        'do something if it is even
        End If
        tbl.MoveNext
    Next foobar
    'Reset for next seek
    tbl.Seek "=", 1
    Next foo
    'Stop the clock and report
    TimeCount = GetTickCount() - TimeStart
    Text1(0) = Format$(TimeCount / 1000, "##0.00")
    'Dynaset FindFirst ---------------------------------------
    dyna.MoveFirst
    'Start The Clock
    TimeStart = GetTickCount()
    'This operation is slow enough we don't have to repeat it
    'Jump to first record
    dyna.FindFirst "Id = 5000"
    For foo = 1 To 99
    If dyna!id / 2 = dyna!id \ 2 Then
        'do something if it is even
    End If
    dyna.MoveNext
    Next foo
    'We're positioned and ready to process, so stop benchmark
    'Stop the clock and report
    TimeCount = GetTickCount() - TimeStart
    Text1(1) = Format$(TimeCount / 100, "##0.00")
    'Inline VB SQL Code ------------------------------------
    'Start The Clock
    TimeStart = GetTickCount()
    For foo = 1 To 10
    'Execute the statement on databse DB
    dyna.Close
    Set dyna = db.CreateDynaset("Select * From Testtable where Id >= 5000 and Id < 5100 and Id \ 2 = Id / 2")
    Do Until dyna.EOF
        dyna.MoveNext
    Loop
    Next foo
    'Stop the clock and report
    TimeCount = GetTickCount() - TimeStart
    Text1(2) = Format$(TimeCount / 1000, "##0.00")
    'Static QueryDef ------------------------------------------
    'Store the procedure before starting the clock
    Set qd = db.CreateQueryDef("TestQd", "Select * From TestTable where Id >= 5000 and Id < 5100 and Id \ 2 = Id / 2")
    qd.Close
    'Start The Clock
    TimeStart = GetTickCount()
    For foo = 1 To 10
    'Execute the querydef on database DB
    dyna.Close
    Set dyna = db.CreateDynaset("TestQd")
    Do Until dyna.EOF
        dyna.MoveNext
    Loop
    Next foo
    'Stop the clock and report
    TimeCount = GetTickCount() - TimeStart
    Text1(3) = Format$(TimeCount / 1000, "##0.00")
    'Remove the QueryDef
    db.DeleteQueryDef ("TestQd")
    'Parameter QueryDef ------------------------------------
    'Init the db
    CloseDb
    OpenDb
    'Store the procedure before starting the clock
    Set qd = db.CreateQueryDef("TestQd", "Parameters IDSearch1 Long, IDSearch2 Long; Select * From Testtable where id >= IDSearch1 and Id < IdSearch2 and Id \ 2 = Id / 2")
    qd.Close
    'Start the clock
    TimeStart = GetTickCount()
    For foo = 1 To 10
    'Open the querydef
    Set qd = db.OpenQueryDef("TestQd")
    'Set the paramter values
    qd!IdSearch1 = 5000
    qd!IdSearch2 = 5100
    'Build the dynaset from the querydef
    dyna.Close
    'Note the required alternate syntax!
    Set dyna = qd.CreateDynaset()
    Do Until dyna.EOF
        dyna.MoveNext
    Loop
    'Close the querydef
    qd.Close
    Next foo
    'Stop the clock and report
    TimeCount = GetTickCount() - TimeStart
    Text1(4) = Format$(TimeCount / 1000, "##0.00")
    'Remove the QueryDef
    db.DeleteQueryDef ("TestQd")
    CloseDb

'Populate the DB Test Set ============================================
Case 2
    Me.Caption = "VBench: Populate Database"
    'Initialize costs so we'll have a nice variety
    cost(1) = 19.95
    cost(2) = 29.95
    cost(3) = 39.95
    cost(4) = 49.95
    cost(5) = 9.95
    'Use transactions for speed
    BeginTrans
    OpenDb
    db.Execute "Delete * from TestTable"
    For foo = 1 To 10000
    foobar = foobar + 1
    If foobar > 5 Then foobar = 1
    tbl.AddNew
    tbl!cost = cost(foobar)
    tbl!id = foo
    tbl.Update
    Next foo
    CommitTrans
    CloseDb
'Exit the program ====================================================
Case 3
    Screen.MousePointer = 0
    End
End Select

Screen.MousePointer = 0

End Sub

Sub OpenDb ()
On Error GoTo 0
    'Open the logicals
    Set db = OpenDatabase("C:\vb\IoTest.mdb")
    Set tbl = db.OpenTable("TestTable")
    tbl.Index = "IdKey"
    Set dyna = db.CreateDynaset("TestTable")
End Sub