frmmain.frm

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#2.0#0"; "MSCOMCTL.OCX"
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Begin VB.Form frmMain 
   Caption         =   "Transfer Funds"
   ClientHeight    =   5850
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8385
   LinkTopic       =   "Form1"
   ScaleHeight     =   5850
   ScaleWidth      =   8385
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdTransfer 
      Caption         =   "Transfer"
      Height          =   375
      Left            =   3360
      TabIndex        =   3
      Top             =   1320
      Width           =   1695
   End
   Begin MSMask.MaskEdBox maskedAmount 
      Height          =   375
      Left            =   3360
      TabIndex        =   2
      Top             =   720
      Width           =   1695
      _ExtentX        =   2990
      _ExtentY        =   661
      _Version        =   393216
      MaxLength       =   7
      Mask            =   "####.##"
      PromptChar      =   " "
   End
   Begin ComctlLib.ListView listTo 
      Height          =   5295
      Left            =   5160
      TabIndex        =   1
      Top             =   360
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   9340
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   2
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "Customer"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "Balance"
         Object.Width           =   2540
      EndProperty
      _Items          =   "frmMain.frx":0000
   End
   Begin ComctlLib.ListView listFrom 
      Height          =   5295
      Left            =   120
      TabIndex        =   0
      Top             =   360
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   9340
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   2
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "Customer"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "Balance"
         Object.Width           =   2540
      EndProperty
      _Items          =   "frmMain.frx":0028
   End
   Begin VB.Label lblAmount 
      Caption         =   "Amount"
      Height          =   375
      Left            =   3360
      TabIndex        =   6
      Top             =   480
      Width           =   975
   End
   Begin VB.Label lblTo 
      Caption         =   "To"
      Height          =   375
      Left            =   5160
      TabIndex        =   5
      Top             =   120
      Width           =   1335
   End
   Begin VB.Label lblFrom 
      Caption         =   "From"
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   1095
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mConn As Connection

Private Sub cmdTransfer_Click()
    Dim lRowsAffected As Long
    Dim sError As String
    Dim sCmd As String
    Dim rs As Recordset
    
    If vbYes = MsgBox("Transfer " _
        & Format(Val(maskedAmount.Text), "$0.00") _
        & " from " & listFrom.SelectedItem.Text _
        & " to " & listTo.SelectedItem.Text & ".", vbYesNo) Then
        
        mConn.BeginTrans
        On Error GoTo TransferFailure
        'use the Connection's execute method
        sCmd = "update Accounts"
        sCmd = sCmd + " set Balance = Balance - " & maskedAmount.Text
        'only do the update if the from account has enough money
        sCmd = sCmd + " where balance >= " & maskedAmount.Text
        sCmd = sCmd + " and AccountId = " _
            & Right(listFrom.SelectedItem.Key _
            , Len(listFrom.SelectedItem.Key) - 1)
            
        mConn.Execute sCmd, lRowsAffected
        If lRowsAffected = 0 Then
            sError = "Insufficient funds."
            GoTo TransferFailure
        End If
        
        'or use the Recordset's methods
        Set rs = New Recordset
        rs.Open "select * from Accounts where AccountId = " _
            & Right(listTo.SelectedItem.Key _
            , Len(listTo.SelectedItem.Key) - 1), mConn, adOpenDynamic _
                , adLockPessimistic
            
        rs!Balance = rs("Balance") + Val(maskedAmount.Text)
        rs.Update
        
        'ok so far, commit it
        mConn.CommitTrans
        rs.Close
    End If
    
TransferDone:
    On Error GoTo 0
    Set rs = Nothing
    RefreshLists
    Exit Sub
TransferFailure:
    'something bad happened so rollback the transaction
    mConn.RollbackTrans
    Dim ADOError As Error
    
    For Each ADOError In mConn.Errors
        sError = sError & ADOError.Number & " - " & ADOError.Description _
            + vbCrLf
    Next ADOError
    MsgBox sError
End Sub

Private Sub Form_Load()
    'open the connection
    Set mConn = New Connection
    mConn.Open "Provider=SQLOLEDB.1;User ID=sa;Password=password;" _
        + "Location=WINEMILLER;Database=pubs"
    
    RefreshLists
End Sub

Private Sub Form_Unload(Cancel As Integer)
    mConn.Close
    Set mConn = Nothing
End Sub

Private Sub RefreshLists()
    'refresh the lists with acount holders and balances
    Dim NewItem As ListItem
    Dim rs As Recordset

    Set rs = New Recordset
    listFrom.ListItems.Clear
    listTo.ListItems.Clear
    
    rs.Open "Accounts", mConn, adOpenForwardOnly, adLockReadOnly
    Do Until rs.EOF
        Set NewItem = listFrom.ListItems.Add(, "k" & rs("AccountId") _
            , rs("Name"))
        NewItem.SubItems(1) = Format(rs("Balance"), "$0.00")
        Set NewItem = listTo.ListItems.Add(, "k" & rs("AccountId") _
            , rs("Name"))
        NewItem.SubItems(1) = Format(rs("Balance"), "$0.00")
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
End Sub