Printable View
I have created the dataCtl form Wrox "Beginning databses with VB6" however when it runs it look ok as if database was updated when you quit the application and start agaiin the modifications are gone.
I run VS6 SP4 on NT4 with SP6a. Have tried commit routines. SQL svr and mdb's databases. Same problem.
Can anyone shed some light on this please.
Regards,
Post your code so that some of these ADO gurus on this board can have a look at it. Maybe the problem is in the code, and if you post it then someone can probably find it.
Tis is the code for the user control is someone needs the compltete project I can mail it to you. Any assistance would be highly appreciated.
---------------->>>>>>>>>>>>>>>>>>>>>>>
Option Explicit
'-- Default Property Values
Const m_def_connectionString = ""
Const m_def_recordSource = ""
'-- Property Variables. These will be read from the property bag
Dim m_connectionString As String
Dim m_recordSource As String
Dim m_form As Object '-the form that hosts our control
Dim lTotalRecords As Long '-holds the current number of records
'-- Keep our control a constant size --
Private Const m_def_Height = 77
Private Const m_def_Width = 402
'-Values for our navigation and editing buttons
Public Enum cmdButtons
cmdMoveFirst = 0
cmdMovePrevious = 1
cmdMoveNext = 2
cmdMoveLast = 3
cmdAddNew = 4
cmdEdit = 5
cmdSave = 6
cmdDelete = 7
cmdUndo = 8
End Enum
'-Values for our current edit status
Private Enum editMode
nowStatic = 0
nowEditing = 1
nowadding = 2
End Enum
Dim editStatus As editMode
'Declare our object variables for the ADO connection
'and the recordset used in the control
Private adoConnection As ADODB.Connection
Private adoRecordset As ADODB.Recordset
Public Event validateRecord(ByVal operation As String, ByRef cancel As Boolean)
Const m_def_Tag = "no tag"
Private m_Tag As String
Private Sub cmdButton_Click(Index As Integer)
Static vMyBookmark As Variant
Dim bCancel As Boolean
'-- sanity check here --
If adoRecordset Is Nothing Then Exit Sub
Select Case Index
Case cmdMoveFirst '--- move first ---
adoRecordset.MoveFirst
editStatus = nowStatic
Call updateButtons
lblControl = "Record " & adoRecordset.AbsolutePosition & _
" of " & lTotalRecords
Case cmdMovePrevious '--- move previous ---
adoRecordset.MovePrevious
editStatus = nowStatic
Call updateButtons
lblControl = "Record " & adoRecordset.AbsolutePosition & _
" of " & lTotalRecords
Case cmdMoveNext '--- move next ---
adoRecordset.MoveNext
editStatus = nowStatic
Call updateButtons
lblControl = "Record " & adoRecordset.AbsolutePosition & _
" of " & lTotalRecords
Case cmdMoveLast '-- move last ---
adoRecordset.MoveLast
editStatus = nowStatic
Call updateButtons
lblControl = "Record " & adoRecordset.AbsolutePosition & _
" of " & lTotalRecords
'-- Now we are modifying the database --
Case cmdAddNew '-- add a new record
RaiseEvent validateRecord("Add", bCancel)
If (bCancel = True) Then Exit Sub
editStatus = nowadding
With adoRecordset
If (.RecordCount > 0) Then
If (.BOF = False) And (.EOF = False) Then
vMyBookmark = .Bookmark
Else
vMyBookmark = ""
End If
Else
vMyBookmark = ""
End If
.AddNew
lblControl = "Adding New Record"
Call updateButtons
End With
Case cmdEdit '-- edit the current record
RaiseEvent validateRecord("Edit", bCancel)
If (bCancel = True) Then Exit Sub
editStatus = nowEditing
With adoRecordset
vMyBookmark = adoRecordset.Bookmark
'We just change the value with ado
lblControl = "Editing Record"
Call updateButtons
End With
Case cmdSave '-- save the current record
Dim bMoveLast As Boolean
RaiseEvent validateRecord("Save", bCancel)
If (bCancel = True) Then Exit Sub
With adoRecordset
If .editMode = adEditAdd Then
bMoveLast = True
Else
bMoveLast = False
End If
.Update
.Move 0
.Update
editStatus = nowStatic
If (bMoveLast = True) Then
.MoveLast
Else
.Move 0
End If
editStatus = nowStatic
lTotalRecords = adoRecordset.RecordCount
updateButtons True
lblControl = "New Record Saved"
End With '
Case cmdDelete '-- delete the current record
Dim iResponse As Integer
Dim sAskUser As String
RaiseEvent validateRecord("Delete", bCancel)
If (bCancel = True) Then Exit Sub
sAskUser = "Are you sure you want to delete this record?"
iResponse = MsgBox(sAskUser, vbQuestion + vbYesNo _
+ vbDefaultButton2, Ambient.DisplayName)
If (iResponse = vbYes) Then
With adoRecordset
.Delete
If (adoRecordset.RecordCount > 0) Then
If .BOF Then
.MoveFirst
Else
.MovePrevious
End If
lTotalRecords = adoRecordset.RecordCount
lblControl = "Record Deleted"
End If
End With
End If
editStatus = nowStatic
Call updateButtons '
Case cmdUndo '-- undo changes to the current record
RaiseEvent validateRecord("Undo", bCancel)
If (bCancel = True) Then Exit Sub
With adoRecordset
If editStatus = nowEditing Then
.Move 0
.Bookmark = vMyBookmark
End If
.CancelUpdate
If editStatus = nowEditing Then
.Move 0
Else
If Len(vMyBookmark) Then
.Bookmark = vMyBookmark
Else
If .RecordCount > 0 Then
.MoveFirst
End If
End If
End If
lblControl = "Cancelled"
End With
editStatus = nowStatic
updateButtons True
End Select
End Sub
Private Sub UserControl_GetDataMember(DataMember As String, Data As Object)
Dim iReturn As Integer
On Error GoTo ohno
'-Reasonability test --
If (adoRecordset Is Nothing) Or (adoConnection Is Nothing) Then
If Trim$(m_connectionString) = "" Then
iReturn = MsgBox("There is no connection string!", _
vbCritical, Ambient.DisplayName)
Exit Sub
End If
If Trim$(m_recordSource) = "" Then
iReturn = MsgBox("There is no recordsource!", vbCritical, _
Ambient.DisplayName)
Exit Sub
End If
Set adoConnection = New ADODB.Connection
adoConnection.Open m_connectionString
Set adoRecordset = New ADODB.Recordset
adoRecordset.CursorLocation = adUseClient
adoRecordset.CursorType = adOpenDynamic
adoRecordset.LockType = adLockBatchOptimistic
If Left$(m_recordSource, 3) = "TB_" Then
adoRecordset.Open m_recordSource, adoConnection, , , adCmdTable
Else
adoRecordset.Open m_recordSource, adoConnection, , , adCmdText
End If
lTotalRecords = adoRecordset.RecordCount
adoRecordset.MoveFirst
Call cmdButton_Click(cmdMoveFirst)
End If
Set Data = adoRecordset
Exit Sub
ohno:
MsgBox Err.Description
Exit Sub
End Sub
Private Sub updateButtons(Optional bLockem As Variant)
'-------------------------------------
'Position Button
' 0 move first
' 1 move previous
' 2 move next
' 3 move last
' 4 add a new record
' 5 edit the current record
' 6 save the current record
' 7 delete the current record
' 8 undo any current changes
'--------------------------------------
'
'Either we are Editing / Adding or we are not
If (editStatus = nowEditing) Or (editStatus = nowadding) Then
Call lockTheControls(False)
navigateButtons ("000000101")
Else
If (adoRecordset.RecordCount > 1) Then
If (adoRecordset.BOF) Or _
(adoRecordset.AbsolutePosition = 1) Then
navigateButtons ("001111010")
ElseIf (adoRecordset.EOF) Or _
(adoRecordset.AbsolutePosition = lTotalRecords) Then
navigateButtons ("110011010")
Else
navigateButtons ("111111010")
End If
ElseIf (adoRecordset.RecordCount > 0) Then
navigateButtons ("000011010")
Else
navigateButtons ("000010000")
End If
If (Not IsMissing(bLockem)) Then
lockTheControls (bLockem)
End If
End If
End Sub
Private Sub navigateButtons(buttonString As String)
''--------------------------------------------------
''-- This routine handles setting the enabled --
''-- to true / false on the buttons. --
''-------------------------------------------------
''-- A string of 0101 passed. If 0, disabled --
''-------------------------------------------------
Dim indx As Integer
buttonString = Trim$(buttonString)
For indx = 1 To Len(buttonString)
If (Mid$(buttonString, indx, 1) = "1") Then
cmdButton(indx - 1).Enabled = True
Else
cmdButton(indx - 1).Enabled = False
End If
Next
DoEvents
End Sub
Private Sub lockTheControls(bLocked As Boolean)
On Error Resume Next
Dim iindx As Integer
With m_form
For iindx = 0 To .Controls.Count - 1
If (.Controls(iindx).Tag = Me.Tag) Then
If (TypeOf .Controls(iindx) Is TextBox) Then
If (bLocked) Then
.Controls(iindx).Locked = True
.Controls(iindx).BackColor = vbWhite
Else
.Controls(iindx).Locked = False
.Controls(iindx).BackColor = vbYellow
End If
End If
End If
Next
End With
End Sub
Private Sub UserControl_Initialize()
editStatus = nowStatic
End Sub
Private Sub UserControl_InitProperties()
m_recordSource = m_def_recordSource
m_connectionString = m_def_connectionString
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_recordSource = PropBag.ReadProperty("RecordSource", _
m_def_recordSource)
m_connectionString = PropBag.ReadProperty _
("ConnectionString", m_def_connectionString)
m_Tag = PropBag.ReadProperty("Tag", m_def_Tag)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("RecordSource", _
m_recordSource, m_def_recordSource)
Call PropBag.WriteProperty("ConnectionString", _
m_connectionString, m_def_connectionString)
Call PropBag.WriteProperty("Tag", m_Tag, m_def_Tag)
End Sub
Private Sub UserControl_Resize()
Width = UserControl.ScaleX(m_def_Width, vbPixels, vbTwips)
Height = UserControl.ScaleX(m_def_Height, vbPixels, vbTwips)
Set m_form = UserControl.Parent
End Sub
Private Sub UserControl_Terminate()
On Error Resume Next
If Not adoRecordset Is Nothing Then
Set adoRecordset = Nothing
End If
If Not adoConnection Is Nothing Then
Set adoConnection = Nothing
End If
Err.Clear
End Sub
Public Property Get RecordSource() As String
RecordSource = m_recordSource
End Property
Public Property Let RecordSource(ByVal New_RecordSource As String)
m_recordSource = New_RecordSource
PropertyChanged "RecordSource"
End Property
Public Property Get ConnectionString() As String
ConnectionString = m_connectionString
End Property
Public Property Let ConnectionString(ByVal New_ConnectionString As String)
m_connectionString = New_ConnectionString
PropertyChanged "ConnectionString"
End Property
Public Sub showAbout()
frmAbout.Show vbModal
End Sub
Public Property Get Tag() As String
Tag = m_Tag
End Property
Public Property Let Tag(ByVal vNewValue As String)
m_Tag = vNewValue
PropertyChanged "Tag"
End Property