Article ID: 170380
Article Last Modified on 7/1/2004
CREATE TABLE BankTbl
(Account int identity, Balance money, Stamp TimeStamp)
INSERT INTO BankTbl (Balance) Values(1000)
INSERT INTO BankTbl (Balance) Values(400)
INSERT INTO BankTbl (Balance) Values(250)
CREATE UNIQUE INDEX AcctIndex ON BankTbl(Account)
CREATE PROCEDURE UpdateBalance
@Sys_Ts TimeStamp, @newBalance Money AS
UPDATE Pubs..BankTbl
SET BankTbl.Balance = @newBalance
WHERE BankTbl.Stamp=@Sys_Ts
IF @@ROWCOUNT=0
RAISERROR ("Optimistic concurrency check failed!", 11, -1)
Option Explicit
Dim cn As New rdoConnection
Dim rsList As rdoResultset
Function TSToHex(sBinRep As rdoColumn) As String
Dim sBuffer As String
Dim b As Integer
sBuffer = "0x"
For b = 1 To 8 'Break up the binary
sBuffer = sBuffer + Right$("00" & _
Hex(AscB(MidB(sBinRep, b, 1))), 2)
Next b
TSToHex = sBuffer 'Return the string
End Function
Private Sub Command1_Click()
Dim strTS As String
Dim theBalance As Single
Dim strTemp As String
Dim oldPos As Integer
On Error GoTo Err_Update
If List1.ListIndex = -1 Then
MsgBox "No item is selected"
Exit Sub
End If
strTemp = Mid(List1.Text, InStr(List1.Text, Chr(9)) + 1)
theBalance = Val(Mid(strTemp, 1, InStr(strTemp, Chr(9)) - 1)) _
- Val(Text1.Text)
strTS = Mid(strTemp, InStr(1, strTemp, Chr(9)) + 1)
'if the concurrency check fails, a runtime error will occur
cn.Execute "{CALL UpdateBalance(" _
& strTS & ", " & theBalance & ")}"
rsList.Requery
oldPos = List1.ListIndex
List1.Clear
Do While Not rsList.EOF
List1.AddItem rsList(0) & Chr(9) & rsList(1) & Chr(9) _
& TSToHex(rsList(2))
rsList.MoveNext
Loop
List1.ListIndex = oldPos
MsgBox "Update Succeeded", vbOKOnly
Exit Sub
Err_Update:
MsgBox Err.Description, vbCritical
End Sub
Private Sub Form_Load()
Dim strSQL As String
Dim strConnect As String
strConnect = "Driver={SQL Server};Server=MyServer; _
Database=pubs;Uid=sa;Pwd="
With cn
.Connect = strConnect
.EstablishConnection
End With
strSQL = "Select Account, Balance, Stamp from BankTbl _
Order by Account"
Set rsList = cn.OpenResultset(strSQL)
Do While Not rsList.EOF
List1.AddItem rsList(0) & Chr(9) & rsList(1) & Chr(9) _
& TSToHex(rsList(2))
rsList.MoveNext
Loop
List1.ListIndex = 0
Text1.Text = "0"
Text1.TabIndex = 0
Command1.Default = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
cn.Close
End Sub
Additional query words: kbVBp500 kbVBp600 kbdse kbDSupport kbVBp kbRDO
Keywords: kbhowto KB170380