Public Class frmXML_Multiuser
 
    Dim xmldaten As String = "C:\daten\demo_multi.xml"
 
    Dim WithEvents btnload As New Button With _
        {.Parent = Me, .Text = "Laden"}
    Dim WithEvents btnSave As New Button With _
        {.Parent = Me, .Text = "Speichern", .Left = 100}
 
    Dim dgv As New DataGridView With _
                      {.Parent = Me, .Top = 50, .Width = 600, _
                       .AllowUserToDeleteRows = False}
 
    Dim dt As New DataTable
 
 
    Private Sub CreateData()
        With dt
            .TableName = "testdaten"
            .Columns.Add("Firma")
            .Columns.Add("Kundennummer")
            .Columns.Add("Optionen")
 
            .Rows.Add("MotorenMaxe", "123-4567", "Express")
            .Rows.Add("GetriebeGünther", "123-5678", "Normal")
            .Rows.Add("SchmierölEddi", "456-789", "Reduziert")
 
            .PrimaryKey = {.Columns("Kundennummer")}
        End With
 
        dt.WriteXml(xmldaten, XmlWriteMode.WriteSchema)
    End Sub
 
 
    Private Sub btnload_Click(sender As Object, _
            e As System.EventArgs) Handles btnload.Click
 
        Try
            dt.Clear()
            dt.ReadXml(xmldaten)
            dt.AcceptChanges()
            dgv.DataSource = dt
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
 
 
    Private Sub btnSave_Click(sender As Object, _
                e As System.EventArgs) Handles btnSave.Click
 
        Try
            If Not writexmltofile() Then
                If MsgBox("Änderungen konnten nicht gespeichert werden." & _
                  vbCrLf & _
                       "Trotzdem speichern?", _
                   MsgBoxStyle.Exclamation Or MsgBoxStyle.OkCancel) = _
                   MsgBoxResult.Cancel Then Exit Sub
 
                dt.WriteXml(xmldaten, 0) 'Kollegen-Änderungen überschreiben
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
 
    End Sub
 
 
    Public Function writexmltofile() As Boolean
 
        'aktuelle Daten neu lesen und sperren
        Dim fs As IO.FileStream = IO.File.Open(xmldaten, _
            IO.FileMode.Open, IO.FileAccess.ReadWrite, IO.FileShare.Read)
 
        Dim dt_current As New DataTable
        dt_current.ReadXml(fs)
 
        'aktuelle Daten abgleichen
        With dt_current
            If .Columns.Count <> dt.Columns.Count Then Return False
            For c As Integer = 0 To .Columns.Count - 1
                If Not dt.Columns.IndexOf(.Columns(c).ColumnName) = c Then
                    fs.Close() 'Spaltenschema inzwischen geändert
                    Return False
                End If
            Next c
 
            Dim pcn As String = dt.PrimaryKey(0).ColumnName
 
            For r As Integer = 0 To .Rows.Count - 1
                Dim row_user As DataRow = _
                    dt.Rows.Find(.Rows(r)(pcn))
 
                If row_user IsNot Nothing Then
                    For c As Integer = 0 To .Columns.Count - 1
                        Dim cc As Integer = _
                           dt.Columns.IndexOf(.Columns(c).ColumnName)
                        If Not .Rows(r)(c).Equals _
                            (row_user(cc, DataRowVersion.Original)) Then
                            fs.Close() 'Zeileninhalt inzwischen extern geändert
                            Return False
                        End If
 
                        If Not row_user.RowState = DataRowState.Unchanged Then
                            'geänderten Wert in frisch geladene Table übertragen
                            .Rows(r)(c) = row_user(cc, DataRowVersion.Current)
                        End If
                    Next c
                Else
                    fs.Close() : Return False 'Schlüssel geändert oder 
                    'inzwischen neue Zeile erstellt
                End If
            Next r
 
            For r As Integer = 0 To dt.Rows.Count - 1
                If dt.Rows(r).RowState = DataRowState.Added Then
                    .Rows.Add(dt.Rows(r).ItemArray) 'neu erstellte Zeile anfügen
                End If
            Next r
 
            fs.Close()
            .WriteXml(xmldaten, XmlWriteMode.WriteSchema)
            dt.AcceptChanges()
        End With
 
        Return True
 
    End Function
 
    Private Sub frmXML_Multiuser_Load(sender As Object, _
                        e As System.EventArgs) Handles Me.Load
        If Not IO.File.Exists(xmldaten) Then CreateData()
    End Sub
End Class