Tipp-Upload: VB.NET 0199: DatasetAdapter

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Datenbanken und XML
• Fenster

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Datenbank, DataRow, Dataset, typisiertes Dataset, Connection, Update, Databinding, Binding, Datagridview, DatagridviewComboBoxColumn, Tableadapter, DataRowView, BindingSource

Der Vorschlag wurde erstellt am: 17.02.2008 11:29.
Die letzte Aktualisierung erfolgte am 04.02.2009 19:30.

Zurück zur Übersicht

Beschreibung  

Eine kleine Klasse kann die Lade- und Speicher-Funktionalität übernehmen, wenn Datenbank und Zugriffs-Strategie darauf abgestimmt sind.

Weiters enthält der Download ein sehr komfortables GUI zur Bearbeitung von Bestellungen, mit Datagridviews, BindingSources, und unter Verwendung typisierter Dataset-Eigenschaften. Nicht hier im User-Code erkennbar die in Designern vorgenommenen Konfigurationen: berechnete DataColumns im Dataset, DatagridviewComboColumns / colorierte Columns in den Grids, DataBindings an Labels und sogar an eine Tabpage.

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [225,19 KB]

' Dieser Source 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!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ----------- Anfang Projektgruppe DBLoadSave.sln  -----------
' ---------- Anfang Projektdatei DBLoadSave.vbproj  ----------
' -------------- Anfang Datei DatasetAdapter.vb --------------
' Projekt-Einstellungen:
' Option Strict On
' Option Explicit On
' Imports System.Windows.Forms
' Imports System.Drawing
' Imports Microsoft.VisualBasic.ControlChars

Imports AdapterInfo = System.Collections.Generic.KeyValuePair(Of Object, System.Data.DataTable)

Public Class DatasetAdapter

    ' Der DatasetAdapter setzt Beziehungen mit Löschweitergabe vorraus, sowohl in Datenbank als
    ' auch im Dataset.
    ' Primärschlüsselwerte werden clientseitig generiert, **nicht in der Datenbank**.
    ' Autowerte dürfen auch nicht im Dataset-Designer konfiguriert werden; auch das übernimmt der
    ' DatasetAdapter (late Initializing)
    ' Andernfalls müsste der Client für jeden neuen Datensatz denselben zunächst in die Datenbank
    ' speichern, und sich dann den dort generierten Schlüssel zurückgeben lassen, und im Datensatz
    ' eintragen, denn ohne Primärschlüssel ist das Dataset nicht arbeitsfähig.
    ' Für Multi-Client-Datenbanken ergibt sich daraus, daß als Primärschlüssel-Typ nur GUID in
    ' Frage kommt, ansonsten mehrere Clients evtl. denselben Primärschlüssel-Wert generieren
    ' könnten (Aber Multi-Client-Datenbanken haben noch viel mehr Probleme zu lösen).

    ' Die Verwendung von CallByName bei Load() und Save() ist natürlich recht unsauber. Trotzdem
    ' ist es sicherer, diese Datenzugriffs-Logik immer wieder zu verwenden, statt für jedes
    ' Dataset eine neue zu Datenzugriffs-Logik implementieren.
    Private _AdapterInfos As New List(Of AdapterInfo)
    Private _Dataset As DataSet

    Public Sub Add(ByVal Adapter As Object, ByVal Table As DataTable)

        If _AdapterInfos.Count = 0 Then
            If _Dataset Is Nothing Then
                _Dataset = Table.DataSet
                InitAutoValues(_Dataset)
            End If

        ElseIf _Dataset IsNot Table.DataSet Then

            Throw New ArgumentException(String.Concat("Die DataTable ", Table.TableName, _
                " entstammt einem anderen Dataset"))

        End If

        ' übergeordnete Tabellen vorne einordnen
        Dim I As Integer

        For I = 0 To _AdapterInfos.Count - 1

            If IsParentOf(Table, _AdapterInfos(I).Value) Then Exit For
        Next

        _AdapterInfos.Insert(I, New AdapterInfo(Adapter, Table))

    End Sub

    Private Shared Function IsParentOf(ByVal tbParent As DataTable, ByVal tbChild As _
        DataTable) As Boolean

        For Each Rl As DataRelation In tbParent.ChildRelations

            If Rl.ChildTable Is tbChild Then Return True
        Next

        For Each Rl As DataRelation In tbParent.ChildRelations

            If Rl.ChildTable Is Rl.ParentTable Then ' Endlos-Rekursion vermeiden

            ElseIf IsParentOf(Rl.ChildTable, tbChild) Then

                Return True
            End If

        Next

        Return False

    End Function

    ''' <summary>richtet Generierung von Primärschlüsselwerten beim Client ein</summary>
    ''' <remarks>
    ''' unterstützt Datentypen, die auf AutoIncrement gesetzt werden können, sowie System.Guid
    ''' </remarks>
    Private Sub InitAutoValues(ByVal DataSet As DataSet)

        For Each Tb As DataTable In DataSet.Tables

            Dim PrimKey As DataColumn() = Tb.PrimaryKey

            If PrimKey.Length <> 1 Then Continue For

            Dim Clmn As DataColumn = PrimKey(0)
            Dim Tp As Type = Clmn.DataType

            If Tp.Equals(GetType(Int16)) OrElse Tp.Equals(GetType(Int32)) OrElse Tp.Equals( _
                GetType(Int64)) Then

                Clmn.AutoIncrement = True

            ElseIf Tp.Equals(GetType(Guid)) Then

                AddHandler Clmn.Table.TableNewRow, AddressOf Table_NewRow
            End If

        Next

    End Sub

    Private Sub Table_NewRow(ByVal sender As Object, ByVal e As DataTableNewRowEventArgs)

        e.Row(e.Row.Table.PrimaryKey(0)) = Guid.NewGuid

    End Sub

    Public Sub Load()

        ' Dim SW As Stopwatch = Stopwatch.StartNew
        For I As Integer = _AdapterInfos.Count - 1 To 0 Step -1

            With _AdapterInfos(I).Value
                .BeginLoadData()
                .Clear()
            End With

        Next

        For Each Inf As AdapterInfo In _AdapterInfos
            CallByName(Inf.Key, "Fill", CallType.Method, Inf.Value)
            Inf.Value.EndLoadData()
        Next

        ' Dbg(SW.ElapsedMilliseconds)
    End Sub

    Public Sub Save()

        ' Löschweitergabe zur Erhaltung der Datenkonsistenz: Löschen einer übergeordneten
        ' Datarow löscht alle ChildRows mit
        ' Problem beim Update: Update ich den DELETE einer übergeordneten Datarow, so wendet
        ' auch die Datenbank Löschweitergabe auf ihre Daten an. Update ich danach die DELETEs
        ' der ChildRows, so wirft die DB eine Exception, denn bei ihr sind diese Daten schon weg.
        ' (Hier vorgetragene) Lösung: Zunächst nur die DELETEs aller übergeordneter Rows des
        ' ganzen Datasets updaten (Top -> Down). Dabei temporär für alle Datarelations des
        ' Datasets AcceptRejectRule.Cascade einstellen. Wenn nun die übergeordneten geupdatet
        ' sind, und (intern) ihr AcceptChanges() aufrufen, akzeptieren die ChildRows auch.
        ' Eine akzeptierte (Child-)Datarow gibt mit DataRowState.Unchanged an, daß sie in
        ' Übereinstimmung mit der Datenbank ist, und vom Update auszunehmen.
        SetAcceptReject(AcceptRejectRule.Cascade)

        For Each Inf As AdapterInfo In _AdapterInfos

            If Inf.Value.ChildRelations.Count > 0 Then

                Dim rwDeletes As Object = Inf.Value.Select("", "", DataViewRowState.Deleted)

                CallByName(Inf.Key, "Update", CallType.Method, rwDeletes)
            End If

        Next

        SetAcceptReject(AcceptRejectRule.None)

        ' INSERTs, und UPDATEs normal updaten
        For Each Inf As AdapterInfo In _AdapterInfos
            CallByName(Inf.Key, "Update", CallType.Method, Inf.Value)
        Next

    End Sub

    Private Sub SetAcceptReject(ByVal Rule As AcceptRejectRule)

        For Each Inf As AdapterInfo In _AdapterInfos
            For Each Rel As DataRelation In Inf.Value.ChildRelations
                Rel.ChildKeyConstraint.AcceptRejectRule = Rule
            Next
        Next

    End Sub

End Class

' --------------- Ende Datei DatasetAdapter.vb ---------------
' -------------- Anfang Datei frmDBLoadSave.vb  --------------
Imports System.ComponentModel
Imports DBLoadSave.BestellungDataSet

Public Class frmDBLoadSave

    Private _Observating As Boolean

#Region "DatasetAdapter"

    ' Diese Region enthält alles, was man für den Datenzugriff auch komplizierterer Datasets
    ' braucht. Sogar mehr: Alles, was mit _Observating zu tun hat gehört eigentlich schon in die
    ' Region "Bestell-Funktionalität"

    Private _DatasetAdapter As New DatasetAdapter

    Private Sub frmDBLoadSave_Load(ByVal sender As Object, ByVal e As EventArgs) _
                Handles MyBase.Load

        With Me.BestellungDataSet
            _DatasetAdapter.Add(KundeTableAdapter, .Kunde)
            _DatasetAdapter.Add(BestellpostenTableAdapter, .Bestellposten)
            _DatasetAdapter.Add(BestellungTableAdapter, .Bestellung)

            ' unveränderliche Tabellen kann ich auch vom DatasetAdapter ausnehmen, und
            ' einmalig herkömmlich befüllen. Hierbei gilt: Parent-Tables first!!
            KategorieTableAdapter.Fill(.Kategorie)
            ArtikelTableAdapter.Fill(.Artikel)
        End With

        _DatasetAdapter.Load()

        ' Bug-Workaround mittm Databinding der TabPage "tpSelectArtikel"
        Me.TabControl1.SelectedIndex = 2
        Me.TabControl1.SelectedIndex = 0

    End Sub

    Private Sub Button_Click(ByVal sender As Object, ByVal e As EventArgs) _
                Handles btReLoad.Click, btSave.Click, btManual.Click

        Dim Observating As Boolean = _Observating

        EnableArticleObserver(False)

        Select Case True

            Case sender Is btReLoad
                _DatasetAdapter.Load()

            Case sender Is btSave
                _DatasetAdapter.Save()

            Case sender Is btManual
                MsgBox(My.Settings.Manual)

        End Select

        EnableArticleObserver(Observating)

    End Sub

#End Region ' DatasetAdapter

#Region "Verschiedenes"

    Private Sub BestellpostenSource_ListChanged( _
                ByVal sender As Object, ByVal e As ListChangedEventArgs) _
                Handles BestellpostenSource.ListChanged

        ' Bei Änderung eines Bestellpostens BestellSumme neu rechnen und anzeigen
        Static ValidChangeTypes As IList(Of ListChangedType) = New ListChangedType() { _
            ListChangedType.Reset, ListChangedType.ItemChanged, ListChangedType.ItemDeleted}

        If ValidChangeTypes.Contains(e.ListChangedType) Then

            Dim BestellSum As Decimal = 0D

            For Each DRV As DataRowView In BestellpostenSource

                Dim Posten As BestellpostenRow = DirectCast(DRV.Row, BestellpostenRow)

                BestellSum += Posten.Preis
            Next

            AssignSave(lbBestellSum.Text, BestellSum.ToString("c"))
        End If

    End Sub

    Private Sub BestellungGrid_CellEnter( _
                ByVal sender As Object, ByVal e As DataGridViewCellEventArgs) _
                Handles BestellungGrid.CellEnter

        If e.RowIndex = BestellungGrid.NewRowIndex Then

            ' Betreten der Hinzufüge-Zeile übernimmt sofort den neuen Datensatz mit aktuellem
            ' Datum, ohne auf eine User-Eingabe zu warten
            Dim Rw As BestellungRow = GetRow(Of BestellungRow)(BestellungSource.Current)

            Rw.Bestelldatum = Date.Today
            Rw.Table.Rows.Add(Rw)
        End If

    End Sub

#End Region ' Verschiedenes

#Region "Bestell-Funktionalität"

    ' Ab hier gehts um das recht trickreiche GUI: Gibt man im Artikel-Katalog bei "AnzahlInput"
    ' eine Zahl ein, so wird automatisch der aktuellen Bestellung ein Bestellposten hinzufügt.
    ' Das funktioniert so: "Artikel" ist eine "Bestellposten" übergeordnete DataTable
    ' Die enthaltene Datenspalte "Artikel.AnzahlInput" ist im Dataset-Designer hinzugefügt,
    ' und wird nicht mit abgespeichert.
    ' Die dortigen Werte werden laufend synchronisiert mit den Werten der "ordentlichen"
    ' Datenspalte "Bestellposten.Anzahl" (die abgespeichert wird).
    ' So erhalte ich o.g. Verhalten: User kann in allen Artikeln blättern, und dabei seine
    ' aktuelle Bestellung editieren, indem er nur die gewünschte Anzahl dazu-schreibt,
    ' und ohne den View verlassen zu müssen

    Private Sub TabControl1_Selected(ByVal sender As Object, ByVal e As TabControlEventArgs) _
                Handles TabControl1.Selected

        ' grundlegende Synchronisation beim Wechsel der TabPages
        EnableArticleObserver(False)

        Dim Posten As BestellpostenRow

        Select Case True

            Case e.TabPage Is tpKunde
                Return

            Case e.TabPage Is tpSelectArtikel

                ' schreibe die aktuellen "Bestellposten.Anzahl" nach "Artikel.AnzahlInput"
                For Each DRV As DataRowView In BestellpostenSource
                    Posten = DirectCast(DRV.Row, BestellpostenRow)
                    Posten.ArtikelRow.AnzahlInput = Posten.Anzahl
                Next

            Case e.TabPage Is tpBestellung

                ' lösche die temporären Einträge der übergeordneten "Artikel.AnzahlInput"
                For Each DRV As DataRowView In BestellpostenSource
                    Posten = DirectCast(DRV.Row, BestellpostenRow)
                    Posten.ArtikelRow.SetAnzahlInputNull()
                Next

        End Select

        EnableArticleObserver(True)

    End Sub

    Private Sub ArticleObserver_RowChanged( _
                ByVal sender As Object, ByVal e As BestellungDataSet.ArtikelRowChangeEvent)

        If e.Action = DataRowAction.Commit Then Return

        ' User hat einen Eintrag in "Artikel.AnzahlInput" gemacht
        EnableArticleObserver(False)

        Dim Artikel As ArtikelRow = e.Row
        Dim Posten As BestellpostenRow
        Dim HasAnzahl As Boolean = Not Artikel.IsAnzahlInputNull AndAlso Artikel.AnzahlInput > 0
        Dim I As Integer = BindingSourceFind(BestellpostenSource, "ArtikelID", Artikel.ArtikelID)

        If I < 0 Then
            If HasAnzahl Then
                Posten = GetRow(Of BestellpostenRow)(BestellpostenSource.AddNew())
                Posten.ArtikelRow = Artikel
                Posten.Anzahl = Artikel.AnzahlInput
                BestellpostenSource.EndEdit()
            End If

        Else

            Posten = GetRow(Of BestellpostenRow)(BestellpostenSource(I))

            If HasAnzahl Then
                AssignSave(Posten.Anzahl, Artikel.AnzahlInput)

            Else

                Posten.Delete()
                BestellpostenSource.EndEdit()
            End If
        End If

        EnableArticleObserver(True)

    End Sub

    Private Sub EnableArticleObserver(ByVal Enable As Boolean)

        If _Observating = Enable Then Return
        _Observating = Enable

        If Enable Then

            AddHandler Me.BestellungDataSet.Artikel.ArtikelRowChanged, AddressOf _
                ArticleObserver_RowChanged

        Else

            RemoveHandler Me.BestellungDataSet.Artikel.ArtikelRowChanged, AddressOf _
                ArticleObserver_RowChanged

        End If

    End Sub

#End Region ' Bestell-Funktionalität

End Class

' --------------- Ende Datei frmDBLoadSave.vb  ---------------
' ----------------- Anfang Datei Helpers.vb  -----------------
Public Module Helpers

    Public Function GetRow(Of T As DataRow)(ByVal Current As Object) As T

        If Current Is Nothing Then Return Nothing
        Return DirectCast(DirectCast(Current, DataRowView).Row, T)

    End Function

    Public Function BindingSourceFind( _
                ByVal BindingSource As BindingSource, _
                ByVal PropertyName As String, _
                ByVal Key As Object) As Integer

        For BindingSourceFind = BindingSource.Count - 1 To 0 Step -1

            If DirectCast(BindingSource(BindingSourceFind), DataRowView)(PropertyName) _
                .Equals(Key) Then Exit Function

        Next

    End Function

    ''' <summary> vor Zuweisung testen, ob neuer Wert Änderung darstellt </summary>
    ''' <remarks>
    ''' nützlich bei Zuweisungen an performance-intensive Properties (z.B. Control.Text), 
    ''' oder wenn auf Änderungen reagiert werden muß.
    ''' Bei DataRows können Update-Probleme auftreten, wenn ein Feld mit seinem eigenen Wert 
    ''' überschrieben wird: Die Connection will eine Änderung speichern, aber es ist nix geändert.
    ''' </remarks>
    Public Function AssignSave(Of T)(ByRef Dest As T, ByVal Src As T) As Boolean

        If Object.Equals(Dest, Src) Then Return False
        Dest = Src
        Return True

    End Function

    ''' <summary>einfache Debug-Ausgabe, nimmt alles, unkaputtbar</summary>
    Public Sub Dbg(ByVal ParamArray Args As Object())

        Dim Args2(Args.Length * 2 - 1) As Object

        For i As Integer = 0 To Args.Length - 1
            Args2(i * 2) = Args(i)
            Args2(i * 2 + 1) = " "
        Next

        Debug.WriteLine(String.Concat(Args2))

    End Sub

End Module

' ------------------ Ende Datei Helpers.vb  ------------------
' ----------- Ende Projektdatei DBLoadSave.vbproj  -----------
' ------------ Ende Projektgruppe DBLoadSave.sln  ------------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.