Meo's Web site
     

http://www.meo-x.net

     Home | Information | Know-how | Sections | Documents | Services | Plus |

 

 

 

E-MAIL:
mail to meo-x.net  Send a mail           

 

Ein einfaches Demo-Programm in VB 6 SP6 mit SQL Server 2005 Express SP4 und ADO Data Control unter Windows 7

Ein einfaches Demo-Programm in VB 6 SP6 mit SQL Server 2005 Express SP4 und ADO Data Control, in der Datei MEOWebArticle.zip

 

Dieses Modul wurde von Didier Meo programmiert.

 

Hier wird die Entwicklungsumgebung Visual Studio 6 SP 6 eingesetzt.

Un programme de démonstration facile développé en VB 6 SP6 avec SQL Server 2005 Express SP4 en utilisant le contrôle de données ADO sous Windows 7

Un programme de démonstration facile développé en VB 6 SP6 avec SQL Server 2005 Express SP4 en utilisant le contrôle de données ADO, dans le fichier MEOWebArticle.zip

 

Ce module a été programmé par Didier Meo.

 

L'outil Visual Studio 6 SP 6 a été utilisé ici pour programmer ce module

An easy demo programm developped with VB 6 SP6 and SQL Server 2005 Express SP4 using ADO data control under Windows 7

An easy demo programm developped with VB 6 SP6 and SQL Server 2005 Express SP4 using ADO data control, in the file MEOWebArticle.zip

 

This module was programming by Didier Meo.

 

For programming the IDE Visual Studio 6 SP 6 was used here.
..............................................                


'
Rem **********************************************************************
Rem MEOWebArticle.vbp
Rem developped by Didier MEO
Rem didiermeo@gmail.com
Rem http://www.meo-x.net
Rem A demo programm developped with VB 6 SP6 and SQL Server 2005 Express SP4
Rem using ADO data control under Windows 7
Rem
Rem Connection String
' Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=MEOWebArticle;Data Source=PC7-PC\SQLEXPRESS05
'

Dim Refreshed As Boolean

Private Sub Form_Load()
    disableTxt
End Sub

Private Sub ADODCRefreshing()
    If Refreshed Then
        Refreshed = False
        AuthorADO.CommandType = adCmdTable
        AuthorADO.RecordSource = "Authors"
        AuthorADO.Enabled = True
        AuthorADO.Refresh
        lbCommand.Caption = ""
    End If
End Sub

Private Sub cdAdd_Click()
    lbCommand.Caption = "Add"
    enableTxt
    txAuthorId.SetFocus
    On Error GoTo ErrorMsg:
    AuthorADO.Recordset.AddNew
    '
    
ErrorMsg:
            If Err.Number <> 0 Then
                MsgBox "Error = " & Err.Number & vbCrLf & Err.Description
                AuthorADO.Recordset.CancelUpdate
                lbCommand.Caption = ""
                AuthorADO.Recordset.MovePrevious
                If AuthorADO.Recordset.BOF Then
                    AuthorADO.Recordset.MoveFirst
                End If
            End If
End Sub

Private Sub cdArticle_Click()
    MsgBox "Article: NOT IMPLEMENTED !", vbOKOnly, "MEOWebArticle"
End Sub

Private Sub cdCancel_Click()
    disableTxt
    If lbCommand.Caption = "Refresh ADODC" Then Exit Sub
    If lbCommand.Caption = "Find" Then
        FindRecord
        lbCommand.Caption = "Refresh ADODC"
        Exit Sub
    End If
    On Error GoTo ErrorMsg:
    lbCommand.Caption = ""
    AuthorADO.Recordset.CancelUpdate
    
ErrorMsg:
            If Err.Number <> 0 Then
                MsgBox "Error = " & Err.Number & vbCrLf & Err.Description
                AuthorADO.Recordset.MovePrevious
                If AuthorADO.Recordset.BOF Then
                    AuthorADO.Recordset.MoveFirst
                End If
            End If
            lbCommand.Caption = ""
End Sub

Private Sub cdDelete_Click()
    lbCommand.Caption = "Delete"
End Sub

Private Sub cdFind_Click()
    lbCommand.Caption = "Find"
    clearTxt
    txAuthorId.SetFocus
End Sub

Private Sub cdOk_Click()
    Select Case lbCommand.Caption
        Case "Update", "Add"
            On Error GoTo ErrorMsg:
            AuthorADO.Recordset.Update
ErrorMsg:
            If Err.Number <> 0 Then
                MsgBox "Error = " & Err.Number & vbCrLf & Err.Description
                '
                ' AuthorADO.Recordset.MovePrevious
                On Error GoTo TheEnd
                If AuthorADO.Recordset.BOF Then
                    AuthorADO.Recordset.MoveFirst
                End If
                Exit Sub
            End If
            lbCommand.Caption = " "
        Case "Find"
            FindRecord
        Case "Delete"
            Dim Message As Integer
            Message = MsgBox("Delete ", vbYesNo + vbQuestion, "MEOWebArticle", "", 0)
            If Message = vbYes Then
                On Error GoTo ErrMsg:
                AuthorADO.Recordset.Delete
                AuthorADO.Recordset.MovePrevious
                If AuthorADO.Recordset.BOF Then
                    AuthorADO.Recordset.MoveFirst
                End If
            End If
ErrMsg:
            If Err.Number <> 0 Then
                MsgBox "Error = " & Err.Number & vbCrLf & Err.Description
                '
                AuthorADO.Recordset.MovePrevious
                On Error Resume Next
                If AuthorADO.Recordset.BOF Then
                    AuthorADO.Recordset.MoveFirst
                End If
            End If
            lbCommand.Caption = ""
        Case "Refresh ADODC"
            ADODCRefreshing
        Case Else
            cdCancel_Click
            lbCommand.Caption = " "
    End Select
TheEnd:
disableTxt
End Sub

Private Sub cdUpdate_Click()
    lbCommand.Caption = "Update"
    enableTxt
End Sub
Private Sub FindRecord()
    On Error GoTo ErrorMsg:
            Dim strsql As String
            strsql = "SELECT * FROM Authors WHERE AuthorId = " & txAuthorId.Text
            AuthorADO.CommandType = adCmdText
            AuthorADO.RecordSource = strsql
            AuthorADO.Refresh
            Refreshed = True
            lbCommand.Caption = "Refresh ADODC"
ErrorMsg:
            If Err.Number <> 0 Then
                MsgBox "Error = " & Err.Number & vbCrLf & Err.Description
                '
                ' AuthorADO.Recordset.MovePrevious
                On Error GoTo TheEnd
                If AuthorADO.Recordset.BOF Then
                    AuthorADO.Recordset.MoveFirst
                End If
                lbCommand.Caption = " "
            End If
            
TheEnd:
End Sub
Private Sub clearTxt()
    txArticleId.Text = ""
    txName.Text = ""
    txTel.Text = ""
    txFax.Text = ""
    txeMail.Text = ""
    txWebsite.Text = ""
    txSocialweb.Text = ""
    disableTxt
    txAuthorId.Enabled = True
End Sub

Private Sub enableTxt()
    txAuthorId.Enabled = True
    txArticleId.Enabled = True
    txName.Enabled = True
    txTel.Enabled = True
    txFax.Enabled = True
    txeMail.Enabled = True
    txWebsite.Enabled = True
    txSocialweb.Enabled = True
End Sub
Private Sub disableTxt()
    txAuthorId.Enabled = False
    txArticleId.Enabled = False
    txName.Enabled = False
    txTel.Enabled = False
    txFax.Enabled = False
    txeMail.Enabled = False
    txWebsite.Enabled = False
    txSocialweb.Enabled = False
End Sub


	  

Tweet