Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0438: ADO StoredProcedures eines SQL-Servers nutzen

VB 5/6-Tipp 0438: ADO StoredProcedures eines SQL-Servers nutzen

 von Florian Reischl

Schwierigkeitsgrad:

Verwendete API-Aufrufe: keine

Download: Download des Beispielprojektes [4,21 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
' Es muss ein Verweis auf 'Microsoft ActiveX Data Objects 2.5 Library' gesetzt werden.
' Die Komponente 'Microsoft DataGrid Control 6.0 (OLEDB) (MSDATGRD.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "cmdEdit"
' Steuerelement: Schaltfläche "cmdUndo"
' Steuerelement: Schaltfläche "cmdSave"
' Steuerelement: Schaltfläche "cmdNew"
' Steuerelement: Textfeld "txtOrt"
' Steuerelement: Textfeld "txtStrasse"
' Steuerelement: Textfeld "txtHausnummer"
' Steuerelement: Textfeld "txtTelefon"
' Steuerelement: Textfeld "txtNName"
' Steuerelement: Textfeld "txtVName"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: DataGrid "DataGrid1"
' Steuerelement: Beschriftungsfeld "Label5"
' Steuerelement: Beschriftungsfeld "Label8"
' Steuerelement: Beschriftungsfeld "Label7"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Beschriftungsfeld "Label4"
Option Explicit

Dim Cn As ADODB.Connection  ' ADO-Connectionobjekt für Verbindung
Dim WithEvents Rs As ADODB.Recordset   ' ADO-Recordset für Datenhandling
Dim bAdd As Boolean

Private Sub cmdEdit_Click()
    Call CntLock(False)
End Sub

Private Sub cmdNew_Click()
Dim oCont As Control

For Each oCont In Me.Controls
    If TypeOf oCont Is TextBox Then
        oCont.Text = vbNullString
    End If
Next oCont

    Call CntLock(False)
    bAdd = True
End Sub

Private Sub cmdSave_Click()
Dim Cmd As ADODB.Command

Set Cmd = New ADODB.Command
    With Cmd
        .ActiveConnection = Cn
        .CommandType = adCmdStoredProc
        
        If bAdd Then    ' Name der StoredProcedure
            .CommandText = "sp_Add_Person"
        Else
            .CommandText = "sp_Edit_Person" ' Beim Ändern muß die ID übergeben werden
            .Parameters.Append cParam("@iPerson", adInteger, Rs.Fields("Personen_ID"))
        End If
        ' Parameter für die StoredProcedure werden übergeben.
        .Parameters.Append cParam("@sVName", adVarChar, SetText(Me.txtVName.Text), 50)
        .Parameters.Append cParam("@sNName", adVarChar, SetText(Me.txtNName.Text), 50)
        .Parameters.Append cParam("@sStrasse", adVarChar, SetText(Me.txtStrasse.Text), 50)
        .Parameters.Append cParam("@iHausNr", adInteger, SetText(Me.txtHausnummer.Text))
        .Parameters.Append cParam("@sOrt", adVarChar, SetText(Me.txtOrt.Text), 50)
        .Parameters.Append cParam("@sTelefon", adVarChar, SetText(Me.txtTelefon.Text), 50)
        .Execute    ' StoredProcedure wird ausgeführt
    End With
    
    Rs.Requery
    bAdd = False
    Call CntLock(True)
    
End Sub

Private Sub cmdUndo_Click()
    Call CntLock(True)
    Call GetValues
    bAdd = False
End Sub

Private Sub Command1_Click()
    Call Unload(Me)
End Sub

Private Sub Form_Load()

Set Cn = New ADODB.Connection
    With Cn
        .CursorLocation = adUseClient
        .Mode = adModeShareDenyNone
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Properties("Data Source") = App.Path & "\db1.mdb"
        .Open
    End With

Set Rs = New ADODB.Recordset
    With Rs
        .ActiveConnection = Cn
        .CursorLocation = adUseClient
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Source = "SELECT * FROM tbl_Personen"
        .Open
    End With

Set Me.DataGrid1.DataSource = Rs    ' Daten in Grid
Call CntLock(True)                  ' Controls sperren
bAdd = False

End Sub

Private Sub Rs_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, _
    ByVal pError As ADODB.Error, _
    adStatus As ADODB.EventStatusEnum, _
    ByVal pRecordset As ADODB.Recordset)
    
    GetValues
End Sub

'********************************************************************************
' Beschreibung:    Um mehrfach gleichen Code zu vermeiden wird zentral über diese
'                  Funktion das Formular mit Daten aus der DB gefüllt.
'********************************************************************************
Private Sub GetValues()

    With Me
        .txtVName.Text = GetText(Rs.Fields("VName"))
        .txtNName.Text = GetText(Rs.Fields("NName"))
        .txtStrasse.Text = GetText(Rs.Fields("Strasse"))
        .txtHausnummer.Text = GetText(Rs.Fields("HausNr"))
        .txtOrt.Text = GetText(Rs.Fields("Ort"))
        .txtTelefon.Text = GetText(Rs.Fields("Telefon"))
    End With

End Sub

Private Sub CntLock(Optional bLock As Boolean = False)
Dim oCont As Control

    For Each oCont In Me.Controls
        If TypeOf oCont Is TextBox Then
            oCont.Enabled = Not bLock
        End If
    Next oCont
    
    With Me
        .cmdEdit.Enabled = bLock
        .cmdNew.Enabled = bLock
        .cmdSave.Enabled = Not bLock
        .cmdUndo.Enabled = Not bLock
    End With

End Sub

'********************************************************************************
' Parameter :
'      IN       #pName#             Name des Parameters der übergeben werden soll
'      IN       #pType#             ADO-Type des Parameters
'      IN       #pVal#              Parameterwert
'      IN       #pSize#             Größe bei String-(/Character-)parametern.
'      OUT      #cParam#            ADO-Parameter für StoredProcedure
'********************************************************************************
' Beschreibung:    Funktion erstellt einen Parameter für eine StoredProcedure
'                  einer Access-Datenbank
'********************************************************************************
' Möglicher Aufruf:
' Cmd.Parameters.Append cParam("@sParam", adVarChar, "Hallo", 50)
'********************************************************************************
Private Function cParam(pName As String, pType As ADODB.DataTypeEnum, _
            pVal As Variant, Optional pSize As Integer = 0) As ADODB.Parameter
Dim pTemp As New ADODB.Parameter

With pTemp
    .Type = pType
    .Name = pName
    If pSize > 0 Then
        .Size = pSize
    End If
    .Value = pVal
End With

Set cParam = pTemp

End Function

'********************************************************************************
' Parameter :
'      IN       #DBText#            Wert aus Datenbank der in einen
'                                   String umgewandelt werden soll
'      OUT      #setText#           Stringwert für GUI
'********************************************************************************
' Beschreibung:    Übergabe von DB-Werten an Textfelder ect.
'                  Sonst Fehler bei DB-Feldern die NULL übergeben
'********************************************************************************
' Aenderungen:
'********************************************************************************
' Möglicher Aufruf:
' Me.Text1.Text = GetText(Rs.Fields("FeldName")
'********************************************************************************
Public Function GetText(DBText As Variant) As String
    ' Wenn DB-Wert ist NULL, dann setText = ""
    If IsNull(DBText) = True Then
        GetText = vbNullString
    Else
        ' sonst setText = DB-Wert
        GetText = DBText
    End If

End Function

'********************************************************************************
' Name      :  SetText
' Parameter :
'      IN       #txtFRM#            String aus Form/Variabler der in DB eingesetzt
'                                   werden soll
'      OUT      #setText#           Variant der in DB übergeben wird
'********************************************************************************
' Beschreibung:    Übergabe von Strings in DB-Felder
'                  Sonst Fehler bei DB-Feldern die NULL verlangen
'********************************************************************************
' Aenderungen:
'********************************************************************************
' Möglicher Aufruf:
' Rs.Fields("FeldName") = SetText(Me.Text1.Text)
'********************************************************************************
Public Function SetText(txtFRM As Variant) As Variant
    ' Wenn Text = "" dann DB-Wert ist NULL
    If txtFRM = vbNullString Then
        SetText = Null
    Else
        ' sonst DB-Wert = TextBox
        SetText = txtFRM
    End If

End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.