Visual Basic 4 Unleashed/Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso/source/chap14/vbu1402.frm

Visual Basic Form | 1995-10-07 | 6.8 KB | 242 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   4140
   ClientLeft      =   1140
   ClientTop       =   1512
   ClientWidth     =   6696
   Height          =   4524
   Left            =   1092
   LinkTopic       =   "Form1"
   ScaleHeight     =   4140
   ScaleWidth      =   6696
   Top             =   1176
   Width           =   6792
   Begin VB.CommandButton Command1
      Caption         =   "&Update Prices"
      Height          =   495
      Left            =   360
      TabIndex        =   0
      Top             =   840
      Width           =   1215
   End
   Begin VB.Data Data1
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   "Ch1402.mdb"
      Exclusive       =   0   'False
      Height          =   300
      Left            =   720
      Options         =   2
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "InvPrice"
      Top             =   3000
      Width           =   3375
   End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
    UpdatePrices ' run price update
End Sub
Private Sub Data1_Error(DataErr As Integer, Response As Integer)
    If DataErr = 3196 Or DataErr = 3045 Then
        MsgBox "Database Locked for Maintenance - Try again later", vbCritical, "Open DB"
    Else
        MsgBox Error$, vbCritical, "Error " + Str(Err)
        Unload Me
        End
    End If
End Sub
Private Sub Form_Load()
    Dim db As Database
    '
    ' open db exclusively
    On Error GoTo FormLoadErr
    '
    'Set db = OpenDatabase("ch1402.mdb", True)
    'MsgBox "Database Opened Successfully", vbInformation, "Open DB"
    '
    GoTo FormLoadExit
    '
FormLoadErr:
    If Err = 3196 Or Err = 3045 Then
        MsgBox "Database Locked for Maintenance - Try again later", vbCritical, "Open DB"
    Else
        MsgBox Error$, vbCritical, "Error " + Str(Err)
    End If
    Unload Me
    End
    '
FormLoadExit:
    '
End Sub
Public Sub UpdatePrices()
    '
    ' update all inventory wholesale prices
    '
    On Error GoTo UpdatePricesErr
    '
    Dim dbFile As Database
    Dim rsTable As Recordset
    '
    ' open db
    Set dbFile = DBEngine.OpenDatabase("ch1402.mdb")
    '
    ' open table exclusively
    Set rsTable = dbFile.OpenRecordset("InvPrice", dbOpenTable, dbDenyRead)
    '
    ' attempt mass update
    'dbFile.Execute "UPDATE InvPrice SET WholesalePrice = WholesalePrice * 1.05;"
    '
    ' perform mass update
    '
    On Error Resume Next    ' ignore errors
    Workspaces(0).BeginTrans ' start trans tracking
    While Not rsTable.EOF   ' for every row
        rsTable.Edit        ' start edit
        rsTable.Fields("WholesalePrice") = rsTable.Fields("WholesalePrice") * 1.05
        rsTable.Update      ' end edit
    Wend                    ' get another
    If Err = 0 Then         ' no errors
        Workspaces(0).CommitTrans    ' final update
        MsgBox "Wholesale Prices Updated", vbInformation, "Inventory"
    Else                    ' trouble
        Workspaces(0).Rollback   ' undo all edits
        MsgBox "Wholesale Price Update Failed", vbCritical, "Error " + Str(Err)
    End If
    On Error GoTo 0         ' tell me about errors!
    '
    '
    GoTo UpdatePricesExit
    '
UpdatePricesErr:
    MsgBox Error$, vbCritical, "UpdatePrices Error " + Str(Err)
    '
UpdatePricesExit:
    On Error Resume Next
    dbFile.Close
    On Error GoTo 0
End Sub
Public Sub PageLockErrors(LockErr As Integer)
    '
    ' handle errors due to page locks
    '
    Static nTries As Integer
    Dim nMaxTries As Integer
    Dim nLoop As Integer
    Dim nTemp As Integer
    '
    nMaxTries = 3
    '
    Select Case LockErr
        Case 3197
            ' data changed
            'Edit    ' re-read changed record
        Case 3260, 3816
            ' currently locked
            nTries = nTries + 1 ' try again
            If nTries > nMaxTries Then  ' too manytimes?
                nTemp = MsgBox(Error, vbRetryCancel, "Error " + Str(Err))
                If nTemp = vbRetry Then ' user said try again
                    nTries = 1  ' start all over
                End If
            End If
    End Select
    '
    DBEngine.Idle  ' free up old locks
    DoEvents            ' let messages catch up
    '
    For nLoop = 1 To 2000 ' 2000 millisecond pause
        ' empty loop
    Next nLoop
    Resume
    '
End Sub
Public Function CheckLockTable(cTable$, cRecId$) As Boolean
    '
    ' check lock table to see if
    ' we can edit this rec
    '
    rsLockTable.FindFirst "TableName=" + cTable$ + " and RecordID=" + cRecId$
    If rsLockTable.NoMatch = False Then
        MsgBox cTable$ + "." + cRecId$ + " is Locked - Try again later.", vbCritical, "CheckLockTable"
        CheckLockTable = False
    Else
        CheckLockTable = True
    End If
    '
End Function
Public Sub EditRec()
    '
    ' check locks, then edit
    '
    Dim cTable As String
    Dim cRecId As String
    '
    cTable = rsEditTable.Name ' get table to lock
    cRecId = rsEditTable.Field(0) ' first field is primary key
    '
    If CheckLockTable(cTable, cRecId) = True Then
        rsEditTable.Edit
        '
        ' perform edits
        '
        rsEditTable.udpate
        ClearLock cTable, cRecId
    End If
End Sub
Public Sub ClearLock(cTable, cRecId)
    '
    ' remove rec form lock table
    '
    rsLockTable.FindFirst "TableName=" + cTable + " and REcordID=" + cRecId
    If rsLockTable.nomath = False Then
        rsLockTable.Delete
    End If
    '
End Sub
Public Sub SQLProcess()
    '
    ' peform updates via SQL statements
    '
    Dim db As Database
    Dim rs As Recordset
    Dim cSQL As String
    '
    Set db = DBEngine.OpenDatabase("ch1402.mdb")
    Set rs = db.OpenRecordset("Table1", dbOpenSnapshot)
    '
    ' add new record
    cSQL = "INSERT INTO Table1 VALUES('MCA','Weather Ballon','FirstClass','RoundTrip');"
    db.Execute cSQL
    '
    db.Close
    '
 End Sub
Public Sub BatchUpdate()
    '
    ' provide temporary table
    ' for batch loading of
    ' master table
    '
    Dim dbFile As Database
    Dim rsTable As Recordset
    Dim cSQL As String
    '
    Set dbFile = DBEngine.OpenDatabase("ch1402.mdb")
    '
    cSQL = "SELECT InvTrans.* INTO MyTrans SELECT * FROM InvTrans WHERE InvID='JUNK';"
    dbFile.Execute cSQL
    '
    Set rsTable = dbFile.OpenRecordset("MyTrans", dbOpenTable)
    '
    ' allow user to peform batch processing on local table
    '
    cSQL = "INSERT * INTO InvTrans FROM MyTrans;"
    dbFile.Execute cSQL
    '
End Sub