sharexmlserver.vb

来自「是可以运行的电子光盘 有程序与PPT介绍 对于学习VB。NET的有参考意义」· VB 代码 · 共 301 行

Imports Microsoft.VisualBasic
Imports System.Data
Imports System.io
Public Class ShareXmlServer
    Public Shared Function GetXmlFullPath(ByVal strPath As String) As String
        ' 如果路径中含有:符号，则认定为传入的是完整路径  
        If strPath.IndexOf(":") > 0 Then
            Return strPath
        Else
            '返回完整路径()
            Return System.Web.HttpContext.Current.Server.MapPath(strPath)
        End If
    End Function

    Public Shared Function GetDataSetByXml(ByVal strXmlPath As String) As DataSet
        Try
            Dim ds As DataSet = New DataSet()
            '读取XML到DataSet
            ds.ReadXml(GetXmlFullPath(strXmlPath))
            If (ds.Tables.Count > 0) Then
                Return ds
            End If
            Return Nothing
        Catch ex As Exception

        End Try
        Return Nothing
    End Function
    '删除所有行
    Public Shared Function DeleteXmlAllRows(ByVal strXmlPath As String) As Boolean

        Try
            Dim ds As DataSet = New DataSet()
            ds.ReadXml(GetXmlFullPath(strXmlPath))
            '如果记录条数大于0
            If (ds.Tables(0).Rows.Count > 0) Then

                '移除所有记录
                ds.Tables(0).Rows.Clear()
            End If
            '重新写入，这时XML文件中就只剩根节点了

            ds.WriteXml(GetXmlFullPath(strXmlPath))

            Return True

        Catch ex As Exception

            Return False
        End Try
    End Function

    '删除指定Index值的行的方法为:
    Public Shared Function DeleteXmlRowByIndex(ByVal strXmlPath As String, ByVal iDeleteRow As Integer) As Boolean
        Try
            Dim ds As DataSet = New DataSet()
            ds.ReadXml(GetXmlFullPath(strXmlPath))
            If (ds.Tables(0).Rows.Count > 0) Then
                '删除符号条件的行
                ds.Tables(0).Rows(iDeleteRow).Delete()
            End If
            ds.WriteXml(GetXmlFullPath(strXmlPath))
            Return True

        Catch ex As Exception

            Return False
        End Try
    End Function
    '删除指定User和Name值的行的方法为,只删除一条记录:
    Public Shared Function DeleteXmlRowByUserAndName(ByVal strXmlPath As String, ByVal User As String, ByVal Name As String) As Boolean
        Try
            Dim ds As DataSet = New DataSet()
            ds.ReadXml(GetXmlFullPath(strXmlPath))
            If (ds.Tables(0).Rows.Count > 0) Then
                '删除符合条件的行
                For Each row As DataRow In ds.Tables(0).Rows
                    If row.Item("User") = User And row.Item("Name") = Name Then
                        '删除行后,跳出,否则将出错,行已经变化,无法继续枚举
                        row.Delete()
                        Exit For
                    End If
                Next
                'For i As Integer = 0 To ds.Tables(0).Rows.Count - 1
                '    If ds.Tables(0).Rows(i).Item("User") = User And ds.Tables(0).Rows(i).Item("Name") = Name Then
                '        ds.Tables(0).Rows(i).Delete()
                '    End If
                'Next
            End If
            ds.WriteXml(GetXmlFullPath(strXmlPath))
            Return True

        Catch ex As Exception

            Return False
        End Try
    End Function
    '删除指定字段名和值的行的方法为,只删除一条记录:
    Public Shared Function DeleteXmlRowByFieldAndValue(ByVal strXmlPath As String, ByVal Field() As String, ByVal Value() As String) As Boolean
        Try
            Dim ds As DataSet = New DataSet()
            ds.ReadXml(GetXmlFullPath(strXmlPath))
            Dim Flag As Boolean
            If (ds.Tables(0).Rows.Count > 0) Then
                '删除符合条件的行
                For Each row As DataRow In ds.Tables(0).Rows
                    Flag = True
                    For i As Short = 0 To Field.Length - 1
                        If row.Item(Field(i)) <> Value(i) Then
                            Flag = False
                        End If
                    Next
                    If Flag Then
                        '删除行后,跳出,否则将出错,行已经变化,无法继续枚举
                        row.Delete()
                        Exit For
                    End If
                Next
            End If
            ds.WriteXml(GetXmlFullPath(strXmlPath))
            Return True

        Catch ex As Exception

            Return False
        End Try
    End Function
    '删除指定User的行的方法为:
    Public Shared Function DeleteXmlRowByUser(ByVal strXmlPath As String, ByVal User As String, ByVal Name As String) As Boolean
        Try
            Dim dv As DataView
            Dim ds As DataSet = New DataSet()
            ds.ReadXml(GetXmlFullPath(strXmlPath))
            If (ds.Tables(0).Rows.Count > 0) Then
                '删除符号条件的行
                'For Each row As DataRow In ds.Tables(0).Rows
                '    If row.Item("User") = User Then
                '        row.Delete()
                '    End If
                'Next
                dv = ds.Tables(0).DefaultView
                dv.RowFilter = "User='" & User & "'"

            End If
            ds.WriteXml(GetXmlFullPath(strXmlPath))
            Return True

        Catch ex As Exception

            Return False
        End Try
    End Function
    '修改指定User和Name值的行的方法为,只修改一条记录:
    Public Shared Function ModifyXmlRowByUserAndName(ByVal strXmlPath As String, _
        ByVal User As String, ByVal Name As String, ByVal Pwd As String, ByVal EnableEdit As Boolean, _
        ByVal EnableDel As Boolean, ByVal EnableUser As String) As Boolean
        Try
            Dim ds As DataSet = New DataSet()
            ds.ReadXml(GetXmlFullPath(strXmlPath))
            If (ds.Tables(0).Rows.Count > 0) Then
                '删除符号条件的行
                For Each row As DataRow In ds.Tables(0).Rows
                    If row.Item("User") = User And row.Item("Name") = Name Then
                        '删除行后,跳出,否则将出错,行已经变化,无法继续枚举
                        row("Pwd") = Pwd
                        row("EnableEdit") = EnableEdit
                        row("EnableDel") = EnableDel
                        row("EnableUser") = EnableUser
                        Exit For
                    End If
                Next
            End If
            ds.WriteXml(GetXmlFullPath(strXmlPath))
            Return True

        Catch ex As Exception

            Return False
        End Try
    End Function
    '通过DataSet检查 ShareFile.xml中数据的正确性和完备性
    '通过DataSet检查 ShareDir.xml中数据的正确性和完备性
    '参数FileName为ShareFile.xml文件或ShareDir.xml
    'bIsFile为True,检查的是 ShareFile.xml，False则检查 ShareDir.xml
    '如果记录数为０则删除该文件,
    Public Shared Sub CheckShareFile(ByVal strxmlPath As String, ByVal bIsFile As Boolean)
        '判断是否有重复共享文件或目录（同一个用户共享同一个文件或目录两次或以上）
        Ini_ShareXml(bIsFile)
        Dim ds As New DataSet
        '测试是否加快读取XML速度
        ds.ReadXmlSchema(GetXmlFullPath(strxmlPath))
        ds.ReadXml(GetXmlFullPath(strxmlPath), XmlReadMode.IgnoreSchema)

        Dim OnlyDs As DataSet

        OnlyDs = ds.Copy
        OnlyDs.AcceptChanges()
        For i As Integer = 0 To ds.Tables(0).Rows.Count - 2
            For j As Integer = i + 1 To ds.Tables(0).Rows.Count - 1
                If ds.Tables(0).Rows(i).Item("User") = ds.Tables(0).Rows(j).Item("User") _
                    And ds.Tables(0).Rows(i).Item("Name") = ds.Tables(0).Rows(j).Item("Name") Then
                    Try
                        OnlyDs.Tables(0).Rows(i).Delete()   ' 删除copy 表中重复行,只比较User和FileName是否相同
                    Catch ex As Exception

                    End Try

                End If
            Next
        Next
        '检查共享是否存在,不存在则删除
        For i As Integer = OnlyDs.Tables(0).Rows.Count - 1 To 0 Step -1
            If Not OnlyDs.Tables(0).Rows(i).RowState = DataRowState.Deleted Then
                Dim row As DataRow = OnlyDs.Tables(0).Rows(i)
                Dim tName As String
                tName = Path.Combine(row("Path").ToString, row("Name").ToString)
                If bIsFile Then '共享的是文件
                    If Not File.Exists(tName) Then
                        row.Delete()
                    End If
                Else
                    If Not Directory.Exists(tName) Then
                        row.Delete()
                    End If
                End If

            End If
        Next
        If OnlyDs.HasChanges Then   '数据集有变化时，重写XML数据
            OnlyDs.WriteXml(GetXmlFullPath(strxmlPath))
        End If
        ds = Nothing
        OnlyDs = Nothing


    End Sub

    'bIsFile为True,建立ShareFile.xml文件l，False建立ShareDir.xml文件
    '当文件存在但没有任何记录时，删除文件重新建立，同时建立一条记录
    Private Shared Sub Ini_ShareXml(ByVal bIsFile As Boolean)
        '"~/XML/ShareFile.xml"文件不存在则建立该文件，在设置共享时建立问题
        Dim ds As New DataSet
        Dim dt As DataTable
        If IsNothing(System.Web.HttpContext.Current.Session("User")) Then
            Return
        End If
        Dim User As String = System.Web.HttpContext.Current.Session("User")
        Dim strUserDir As String
        strUserDir = Path.Combine(Data.C_ServerDir, User)
        Dim strPath As String
        Dim Name As String
        If bIsFile Then
            If File.Exists(GetXmlFullPath(Data.C_ShareFileXmlMapPath)) Then
                ds.ReadXml(GetXmlFullPath(Data.C_ShareFileXmlMapPath))
                If ds.Tables.Count = 0 Then
                    File.Delete(GetXmlFullPath(Data.C_ShareFileXmlMapPath))
                Else
                    ds = Nothing
                    Return
                End If
            End If
            dt = ds.Tables.Add("File")
            Name = "temp.txt"
            strPath = Path.Combine(strUserDir, Name)
            Dim Writer As New StreamWriter(strPath, False)
            Writer.WriteLine("这个文件是为共享自动创建的")
            Writer.Close()
        Else
            If File.Exists(GetXmlFullPath(Data.C_ShareDirXmlMapPath)) Then
                ds.ReadXml(GetXmlFullPath(Data.C_ShareDirXmlMapPath))
                If ds.Tables.Count = 0 Then
                    File.Delete(GetXmlFullPath(Data.C_ShareDirXmlMapPath))
                Else
                    ds = Nothing
                    Return
                End If
            End If
            Name = "temp"
            strPath = Path.Combine(strUserDir, Name)
            Directory.CreateDirectory(strPath)
            dt = ds.Tables.Add("Dir")
        End If
        dt.Columns.Add("User")
        dt.Columns.Add("Pwd")
        dt.Columns.Add("Name")
        dt.Columns.Add("Path")
        dt.Columns.Add("EnableEdit")
        dt.Columns.Add("EnableDel")
        dt.Columns.Add("EnableUser")
        Dim Value() As String = {User, "", Name, strUserDir, "False", "False", "False"}
        dt.Rows.Add(Value)
        If bIsFile Then
            dt.WriteXml(GetXmlFullPath(Data.C_ShareFileXmlMapPath))
        Else
            dt.WriteXml(GetXmlFullPath(Data.C_ShareDirXmlMapPath))
        End If
    End Sub


End Class