Private Sub HandleDBx(ByVal
dbx As Data.DBConcurrencyException, ByVal csODBC As String)
'HandleDBx
Subroutine
' Written by Matthew R. King
(mking56@comcast.net).
' Handles a DBConcurrencyException thrown by
any TableAdapter.Update method.
'This
subroutine handles concurrency errors of 3 types:
' User B changes a record before User A saves.
' User B deletes a record before user A saves.
' The DataSet looses sync with the database.
'Inputs to
this subroutine:
' The DBConcurrencyException called when a
TableAdapter fails an UPDATE.
' The ODBC Connection String.
'ODBC
CONNECTOR
' While this subroutine was written for the
ODBC Connector in VB.NET, it can easily
' be modified to handle any VB.NET Connector.
'MySQL
' The SQL statements formed in this subroutine
are formatted for MySQL. They can be
' revised for other databases.
'CONDITIONS
' A Column for Concurrency Checks
' The tables in the underlying database
need a column for checking when the table
' was last updated. A TIMESTAMP column is
ideal for this. Make sure the TableAdapter's
' UPDATE command includes this column in
the WHERE clause. When a TableAdapter.Update
' command cannot find the original value
in the TIMESTAMP column (because the row has
' been changed by User B) the
DBConcurrencyException is thrown.
' Read-Only columns in the DataSet
' Table columns that are automatically
updated by the database server (such as
' the PRIMARYKEY and TIMESTAMP columns)
need to be set as Read-Only in the DataSet.
' AllowDBNull
' The Read-Only columns also need
AllowDBNull set to True
' FillTableAdapters subroutine
' A subroutine called FillTableAdapters()
is required in the main program code to re-sync
' the database. This subroutine will
contain the TableAdapter.Fill methods.
' Do While DataSet.HasChanges Loop
' If the TableAdapter.Update methods are
placed in a Do...While Loop that checks
' the DataSet.HasChanges = True condition,
this subroutine will process all changes
' and Concurrency Errors in the DataSet
with one Update call.
' PSUEDO CODE:
' Do While DataSet.HasChanges
' Try
' TableAdapterA.Update
' TableAdapterB.Update
' ...
' Catch ex as
Data.DBConcurrencyException
' Call HandleDBx(ex,
My.Settings.ConnectionString)
' End Try
'
'CONCURRENCY
ERRORS:
' User B changes a record before User A saves
' The subroutine automatically merges the
two records. In the event of a conflict,
' User A's changes overwrite user B's
changes.
' User B deletes a record before User A saves
' The subroutine notifies User A and asks
if User A wants to delete the record,
' or re-add the row as a new record.
' The DataSet looses sync with the database
' The subroutine notifies User A and calls
the FillTableAdapters subroutine
' to re-fill the TableAdapters.
'DEFINITION
OF RECORDS
' original record
' The record User A originally loaded from
the database (before being changed
' by someone else).
' current record
' The record as it is in the database
right now (changed by User B).
' updated record
' The changes User A is trying to save.
' merged record
' A merge between the two - the current +
update.
'holds the
error message for the user and the change indicator
Dim
info As String
= ""
Dim
indicator As String
= ""
'data rows
for the current record, updated record, and merged record
Dim
drCurrent As DataRow
Dim
drUpdate As DataRow
'data tables
for the current record and updated record
Dim
dtCurrent As New
DataTable
Dim
dtUpdate As New
DataTable
'data adapter
- used for fetching and updating record
Dim da As New
Odbc.OdbcDataAdapter
'holds the
Primary Key of the damaged row
Dim
rowPK As Integer
'used to
determine if the row was deleted by someone else
Dim
checkDelete As Integer
'connection
information for the ODBC Connector
'revise the
connection information if using a different Connector
Dim
myCommand As New
Odbc.OdbcCommand
Dim
conn As New
Odbc.OdbcConnection
conn.ConnectionString = csODBC
'MySQL
commands for the data adapters
Dim
countRowSQL As String
Dim
selectRowSQL As String
Try 'if the dataset is out of sync, it will be caught when
accessing the dbx.row
'the row
and table that caused the error
drUpdate = dbx.Row
dtUpdate = drUpdate.Table
'find the
PK of the row with the error
rowPK = dbx.Row.Item(0)
'MySQL
strings
countRowSQL = "SELECT COUNT(*) FROM " & _
dtUpdate.TableName & _
" WHERE " & _
dtUpdate.Columns(0).ColumnName & " =
" & rowPK
selectRowSQL = "SELECT * FROM " & _
dtUpdate.TableName & _
" WHERE " & _
dtUpdate.Columns(0).ColumnName & " =
" & rowPK
'was the
row deleted by someone else?
'check
for the current record in the database
'checkDelete:
0=Yes; 1=No
myCommand.Connection = conn
Try
conn.Open()
myCommand.CommandText =
countRowSQL
checkDelete =
myCommand.ExecuteScalar
conn.Close()
Catch
ex As Exception
conn.Close()
conn.Dispose()
MessageBox.Show _
("Error:
" & ex.Message, "Connection
Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End
Try
If
checkDelete <> 0 Then 'the row was changed, not deleted
'holds
the number of columns in the data table
Dim
col As Integer
col = dtUpdate.Columns.Count
'start
the info message
info = "This
message appears when another user updates a record while you had it open."
& _
vbCrLf & vbCrLf
& _
"The changes you made to this record have been merged with the
other user's changes." & _
vbCrLf & _
"The merged record is shown below:" & _
vbCrLf & vbCrLf
& _
"COLUMN" & ControlChars.Tab & ControlChars.Tab
& ControlChars.Tab & "RECORD"
& vbCrLf
'fetch
the current row from the database and fill dtCurrent and drCurrent
'modify
the SelectCommand if using a different Connector
Try
da.SelectCommand = New Odbc.OdbcCommand(selectRowSQL, conn)
Catch
ex As Exception
MessageBox.Show _
("Error: " & ex.Message, "Connection Error", MessageBoxButtons.OK,
MessageBoxIcon.Error)
End
Try
da.Fill(dtCurrent)
drCurrent = dtCurrent.Rows(0) 'only one row is returned
'for
each column, find the original, current, and updated rows
'the
original column is needed to determine whcih fields were changed by the
previous user
For
i As Integer =
0 To col - 1
Dim
colName As String
= ""
Dim
colCurrent As String
= ""
Dim
colUpdate As String
= ""
Dim
colMerge As String
= ""
Dim
colOriginal As String
= ""
'fill
the columns with data from the comparison rows
colName =
dtUpdate.Columns(i).ColumnName
colCurrent =
drCurrent.Item(i).ToString
colUpdate =
drUpdate.Item(i).ToString
colOriginal = drUpdate(i,
DataRowVersion.Original).ToString
'prepare
the merged columns
If
colCurrent = colOriginal Then
If colUpdate = colCurrent Then
colMerge =
colOriginal 'no
change
indicator = ""
Else
colMerge =
colUpdate 'User
A update
indicator = ""
End If
Else
If colUpdate = colOriginal Then
colMerge =
colCurrent 'User
B update
indicator = "*"
Else
colMerge =
colUpdate 'both
changed -- User A wins
indicator = ""
End If
End
If
'rebuild
the drUpdate data row with merged data
If
dtUpdate.Columns(i).ReadOnly = False Then 'ignore read-only columns
Try
drUpdate.Item(i) =
colMerge 'this command also updates the DatGrid
Catch ex As Exception
Dim exmessage As String
exmessage = vbCrLf
& vbCrLf & "The " &
dtUpdate.TableName & "." &
colName & _
" column could not be written to." &
vbCrLf & _
"Within the DataSet, make sure this column's "
& _
"ReadOnly and AllowDBNull properties are set to
TRUE." & vbCrLf
MessageBox.Show _
("Error: " & ex.Message &
exmessage, "Column Error",
MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End
If
'limit
the size of the strings for the displayed message
If
colName.Length > 15 Then
colName =
colName.Substring(0, 15)
End
If
If
colMerge.Length > 15 Then
colMerge =
colMerge.Substring(0, 15)
End
If
'build
the info message columns
info = info &
colName.PadRight(35) & ControlChars.Tab & colMerge & indicator
& vbCrLf
Next
i
'build
the UPDATE sql command (between SET and WHERE keywords) using column names
' UPDATE table SET column1 = 'value', column2
= 'value', ... WHERE pkid = rowPK
Dim
updateSQL As String
= ""
For
c As Integer =
1 To col - 1
If
dtUpdate.Columns(c).ReadOnly = False Then 'ignore read-only columns
updateSQL = updateSQL
& dtUpdate.Columns(c).ColumnName & " =
'" & _
drUpdate.Item(c) & "', "
End
If
Next
c
'updateSQL
at this point: column1 = 'value',
column2 = 'value,...columnx = value,
'get
rid of the last comma and space
updateSQL =
updateSQL.Substring(0, updateSQL.Length - 2)
'the
completed update command
updateSQL = "UPDATE " & dtUpdate.TableName & " SET " & updateSQL & _
" WHERE " &
dtUpdate.Columns(0).ColumnName & " = "
& drCurrent.Item(0)
'update
the database with the drUpdate data row
Try
conn.Open()
myCommand.CommandText =
updateSQL
myCommand.ExecuteNonQuery()
conn.Close()
Catch
ex As Exception
conn.Close()
conn.Dispose()
MessageBox.Show _
("Error: " & ex.Message, "Connection Error", MessageBoxButtons.OK,
MessageBoxIcon.Error)
End
Try
'Accept
the changes and clear the error
dbx.Row.AcceptChanges()
dbx.Row.ClearErrors()
'finish
the info message
info = info & vbCrLf &
_
"The
other user's changes are marked with an asterisk." & vbCrLf
& _
"All
of your current changes remain intact." & vbCrLf
MessageBox.Show(info, "Concurrency Violation",
MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
'the row was deleted
'holds the number
of columns in the data table
Dim
col As Integer
col = dtUpdate.Columns.Count
'build
the INSERT sql command using column names
' INSERT INTO table (column1, column 2,...)
VALUES ('value', 'value',...)
Dim
insertSQL As String
= "INSERT INTO " &
dtUpdate.TableName & " ("
For
c As Integer =
1 To col - 1
If
dtUpdate.Columns(c).ReadOnly = False Then 'ignore read-only columns
insertSQL = insertSQL
& dtUpdate.Columns(c).ColumnName & ",
"
End
If
Next
c
insertSQL =
insertSQL.Substring(0, insertSQL.Length - 2) 'get rid
of the last comma and space
insertSQL = insertSQL & ") VALUES ("
For
d As Integer =
1 To col - 1
If
dtUpdate.Columns(d).ReadOnly = False Then 'ignore read-only columns
insertSQL = insertSQL
& "'" & drUpdate.Item(d)
& "', "
End
If
Next
d
insertSQL =
insertSQL.Substring(0, insertSQL.Length - 2) 'get rid
of the last comma and space
insertSQL = insertSQL & ")"
'INSERT
command complete
'start
the info message
info = "This
error occurs when another user deletes a record while you had it open."
& _
vbCrLf & vbCrLf
& _
"COLUMN" & ControlChars.Tab &
ControlChars.Tab & ControlChars.Tab & "RECORD"
& vbCrLf
'for
each column, find the name and value
For
i As Integer = 0
To col - 1
Dim
colName As String
= ""
Dim
colUpdate As String
= ""
If
dtUpdate.Columns(i).ReadOnly = False Then 'ignore read-only columns
'fill the columns with data from the row
colName =
dtUpdate.Columns(i).ColumnName
colUpdate =
drUpdate.Item(i).ToString
'limit the size of the strings for the displayed message
If colName.Length > 15 Then
colName =
colName.Substring(0, 15)
End If
If colUpdate.Length > 15 Then
colUpdate =
colUpdate.Substring(0, 15)
End If
'build the info message columns
info = info &
colName.PadRight(35) & ControlChars.Tab & colUpdate & vbCrLf
End
If
Next
i
'finish
the info message
info = info & vbCrLf &
_
"Do you want to save your changes as a new record in the
database?" & _
vbCrLf & vbCrLf
& _
"CAUTION: Any child records of this record are now orphaned."
& _
vbCrLf & vbCrLf
& _
"Select YES to save as a new record." & _
vbCrLf & _
"Select NO to delete this record." & _
vbCrLf
'ask
if the user wants to delete the row or add it new
If
MessageBox.Show(info, "Concurrency Error",
MessageBoxButtons.YesNo, MessageBoxIcon.Error) _
=
Windows.Forms.DialogResult.Yes Then 'save as a new
row
Try
conn.Open()
myCommand.CommandText =
insertSQL
myCommand.ExecuteNonQuery()
conn.Close()
Catch
ex As Exception
conn.Close()
conn.Dispose()
MessageBox.Show _
("Error: " & ex.Message, "Connection Error", MessageBoxButtons.OK,
MessageBoxIcon.Error)
End
Try
'Accept
the changes and clear the error
dbx.Row.AcceptChanges()
dbx.Row.ClearErrors()
Else 'delete the
row
'mark each
string column with #Deleted#
For
r As Integer =
1 To col - 1
If dtUpdate.Columns(r).ReadOnly = False
Then
If dtUpdate.Columns(r).DataType Is GetType(System.String)
Then
drUpdate.Item(r) = "#Deleted#"
End If
End If
Next
'Accept
changes and clear errors
drUpdate.AcceptChanges()
dbx.Row.ClearErrors()
End
If
End
If
Catch
dri As DeletedRowInaccessibleException 'the dataset is out of sync
info = "The
application has lost sync with the database." & vbCrLf & _
"This
usually occurs after multiple SAVE and DELETE operations within the same
DataGrid." & _
vbCrLf & vbCrLf & _
"Some
of your changes since the last SAVE may be lost." & vbCrLf
& vbCrLf & _
"Select
OK to re-synchronize the application and database." & vbCrLf
MessageBox.Show _
(info, "Concurrency
Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Call
FillTableAdapters() 'subroutine with TablAdapter.Fill methods
End Try
End Sub