mainfile.aspx.vb

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

                Dim tempGif As String
                tempGif = "../filetype/" & strExt.Substring(1) & ".gif"

                If System.IO.File.Exists(Server.MapPath(tempGif)) Then
                    subtn.ImageUrl = "../filetype/" & strExt.Substring(1) & ".gif"
                Else
                    subtn.ImageUrl = Data.C_smilefacegifMapPath
                End If

                subtn.Text = GetShortDirOrFile(file)
                subtn.NavigateUrl = "Download.aspx?File=" & Server.UrlEncode(file)
                node.ChildNodes.Add(subtn)
                fileNames = Nothing
            Next
        Catch ex As Exception

        End Try

    End Sub


    Public Sub AddDirectory(ByVal strPath As String, ByVal nodeFather As TreeNode)
        Dim node As New TreeNode
        '先添加本目录，从文件夹路径分析出文件夹名称
        'd:server转换为D:\server形式
        strPath = Path.GetFullPath(strPath) 'strPath
        '仅获得目录名称,不包含路径
        node.Text = GetShortDirOrFile(strPath)

        node.ImageUrl = Data.C_foldergifMapPath
        node.NavigateUrl = "MainFile.aspx?Folder=" & Server.UrlEncode(strPath)
        nodeFather.ChildNodes.Add(node)
        '在TreeView相应Node下加载文件
        AddFile(strPath, node)
        Try
            Dim str() As String = Directory.GetDirectories(strPath)
            '遍历该目录的子文件夹
            For i As Integer = 0 To str.GetUpperBound(0)
                AddDirectory(str(i), node)
            Next
        Catch ex As Exception

            Stop

        End Try
        node = Nothing
    End Sub
    '返回不包含路径的文件名或目录名
    Private Function GetShortDirOrFile(ByVal strPath As String) As String
        Dim i As Integer
        i = strPath.LastIndexOf("\")
        If i > 0 Then
            Return strPath.Substring(strPath.LastIndexOf("\") + 1)
        Else
            Return strPath
        End If
    End Function
#End Region

#Region "GridView查询选中项操作代码"
    'GridView控件的EnableViewState="true" 必须设置为true,因为需要获得选择项的值
    '从GridView中查询选中项的目录名或文件名（是全路径），加入到泛型List中
    Private Function GetSelectFileOrDirName() As List(Of String)
        'Dim selCell As Short = 1
        Dim b As CheckBox
        Dim dgi As GridViewRow
        Dim listFileDir As New List(Of String)
        CurrentPath = Session("CurrentPath").ToString
        Try
            For Each dgi In GridView1.Rows
                b = CType(dgi.FindControl("Chk"), CheckBox)
                'b = CType(dgi.Cells(selCell).Controls(1), CheckBox) 也可以获得
                If b.Checked Then
                    Dim hy As HyperLink = CType(dgi.FindControl("NameLink"), HyperLink)
                    Dim thePath As String
                    thePath = Path.Combine(CurrentPath, hy.Text)
                    listFileDir.Add(thePath)
                End If
            Next
        Catch ex As Exception

        End Try
        Return listFileDir
    End Function
    '从GridView中查询是否有选中项，若有则返回true
    Private Function HaveSelectFileOrDirName() As Boolean
        Dim b As CheckBox
        Dim dgi As GridViewRow
        Try
            For Each dgi In GridView1.Rows
                b = CType(dgi.FindControl("Chk"), CheckBox)
                If b.Checked Then
                    Return True
                End If
            Next
        Catch ex As Exception

        End Try
        Return False
    End Function
#End Region

#Region "压缩和解压通过过程"
    Protected Sub Compress_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles Compress.Click
        If Me.HaveSelectFileOrDirName Then
            '确定压缩文件名称
            Dim rarFileName As String
            Dim strExtName As String
            strExtName = Path.GetExtension(funcParam.Value)
            If strExtName.ToLower = ".rar" Then
                rarFileName = funcParam.Value
            ElseIf strExtName = String.Empty Then
                rarFileName = funcParam.Value & ".rar"
            Else
                rarFileName = Now.ToShortDateString & ".rar"
            End If
            CompressBySelect(rarFileName) '压缩选中项
        Else
            Me.StatusMessage.Text = "请选中若干文件或目录"
        End If
    End Sub

    Protected Sub DeCompress_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles DeCompress.Click
        If HaveSelectFileOrDirName() Then
            '获得选中的文件，判断是否是rar文件
            Dim strFileorDirName As String
            Dim rarFileName As String
            Try
                For Each strFileorDirName In GetSelectFileOrDirName()
                    '判断是是文件
                    If File.Exists(strFileorDirName) Then
                        '判断其扩展名
                        If Path.GetExtension(strFileorDirName).ToLower = ".rar" Then
                            rarFileName = strFileorDirName
                            '解压rar文件到当前路径
                            DeCompress_(rarFileName, Session("CurrentPath").ToString)
                        End If
                    End If
                Next
            Catch ex As Exception

            End Try
        Else
            Me.StatusMessage.Text = "请选中若干文件或目录"
        End If
    End Sub


    '_FileOrDirName为要压缩的文件或目录名，_RarFileName为包含路径的存档名,,Path为存档路径
    Private Sub Compress_(ByVal _RarFileName As String, ByVal Path As String, ByVal _FileOrDirName As String)
        WinRar(_RarFileName, Path, True, _FileOrDirName)
        BindData()
    End Sub
    '压缩选中项到CrarFileName文件中
    Private Sub CompressBySelect(ByVal rarFileName As String)
        Try
            '一个目录（或文件）、一个目录（或文件）进行压缩
            For Each strFileorDirName As String In GetSelectFileOrDirName()
                Compress_(rarFileName, Session("CurrentPath").ToString, strFileorDirName)
            Next
        Catch ex As Exception

        End Try
    End Sub
    '_RarFileName为包含路径的要解压的rar文件,Path为解压路径
    Private Sub DeCompress_(ByVal _RarFileName As String, ByVal Path As String)
        WinRar(_RarFileName, Path, False)
        BindData()
    End Sub
    '压缩或解压通用过程；_RarFileName为rar文件，path为工作目录，compress为true时为压缩，false时解压；
    '在压缩时，_FileOrDirName指定要压缩的目录或文件，而解压时，则不需提供_FileOrDirName的值
    Private Sub WinRar(ByVal _RarFileName As String, ByVal Path As String, ByVal Compress As Boolean, Optional ByVal _FileOrDirName As String = "")
        Dim the_rar As String
        Dim the_Reg As RegistryKey
        Dim the_Obj As Object
        Dim the_Info As String
        Dim the_StartInfo As ProcessStartInfo
        Dim the_Process As Process
        Dim newFilename As String
        Try
            the_Reg = Registry.ClassesRoot.OpenSubKey("Applications\WinRAR.exe\Shell\Open\Command")
            the_Obj = the_Reg.GetValue("")
            the_rar = the_Obj.ToString()
            the_Reg.Close()
            the_rar = the_rar.Substring(1, the_rar.Length - 7)
            newFilename = "temp" + Now.Ticks.ToString
            If Compress Then
                'a为命令：压缩；-r为开关：把目录压缩进去；-ed为不添加空目录,-ep1从名称中排除基本目录
                the_Info = " a -ep1 " + "-r " + _RarFileName + " " + _FileOrDirName
            Else
                'x为命令：用绝对路径解压文件；-o-不覆盖已存在文件;-o+ 覆盖已存在文件
                the_Info = " x -o-" + " -inul " + _RarFileName
            End If
            the_StartInfo = New ProcessStartInfo
            the_StartInfo.FileName = the_rar
            the_StartInfo.Arguments = the_Info
            the_StartInfo.WindowStyle = ProcessWindowStyle.Hidden
            the_StartInfo.WorkingDirectory = Path
            the_Process = New Process
            the_Process.StartInfo = the_StartInfo
            the_Process.Start()
            ' 等待程序装载完成()
            the_Process.WaitForInputIdle()
            '等待进行程退出
            the_Process.WaitForExit()
            '继续执行下面的代码
        Catch ex As Exception
            'do nothing
        Finally

        End Try
    End Sub

#End Region

#Region "上传下载查找"
    '上传文件,注:Server.Transfer("Upload.aspx")与超连接在性能上有什么区别
    Protected Sub upload_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles upload.Click
        Server.Transfer("/WebDisk/FileManager/Upload.aspx")
    End Sub
    '下载选中文件夹或文件，１、先将选中项在当前目录压缩成一个rar文件，２、下载该文件，３、删除该文件
    Protected Sub btndown_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles btndown.Click
        If HaveSelectFileOrDirName() Then
            '1、确定压缩文件名称
            Dim rarFileName As String
            rarFileName = Now.Ticks & ".rar"
            CompressBySelect(rarFileName) '压缩选中项
            '２、下载该文件
            rarFileName = Path.Combine(Session("CurrentPath"), rarFileName)
            Server.Transfer("/WebDisk/FileManager/Download.aspx?File=" & Server.UrlEncode(rarFileName)) '对中文进行编码
            '３、删除该文件,有问题，没有执行该语句
            File.Delete(rarFileName)
        Else
            Me.StatusMessage.Text = "请选中若干文件或目录"
        End If
    End Sub
    '在当前路径下查找文件
    Protected Sub search_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles search.Click
        If funcParam.Value <> String.Empty Then
            Server.Transfer("/WebDisk/FileManager/Search.aspx?Content=" & Server.UrlEncode(funcParam.Value))
        End If
    End Sub
#End Region

#Region "共享显示样式"
    '将选中项通过泛型传递到"ShareSetup.aspx"页面
    Protected Sub share_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles share.Click
        If HaveSelectFileOrDirName() Then
            Dim list As List(Of String) = Me.GetSelectFileOrDirName
            '通过Session将list传递到ShareSetup.aspx页面
            Session("SelectItem") = list
            Server.Transfer("/WebDisk/FileManager/ShareSetup.aspx")
        Else
            Me.StatusMessage.Text = "请选中若干文件或目录"
        End If
    End Sub

    Protected Sub showTreeOrTable_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles showTreeOrTable.Click
        If PanelTree.Visible Then
            PanelTree.Visible = False
        Else
            PanelTree.Visible = True
        End If
        If GridView1.Visible Then
            GridView1.Visible = False
        Else
            GridView1.Visible = True
        End If
    End Sub
#End Region

#Region "移动和拷贝代码"
    '选中项进行移动
    Protected Sub Moveto_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles Moveto.Click
        If HaveSelectFileOrDirName() Then
            MoveCopy(True)
        Else
            Me.StatusMessage.Text = "请若干选中文件"
        End If
    End Sub
    '选中项进行移动
    Protected Sub Copyto_Click(ByVal sender As Object, ByVal e As System.Web.UI.ImageClickEventArgs) Handles CopyTo.Click
        If HaveSelectFileOrDirName() Then
            MoveCopy(False)
        Else
            Me.StatusMessage.Text = "请若干选中文件"
        End If
    End Sub
    '参数IsMove=True，表示移动文件和文件夹，IsMove=False表示拷贝文件
    Private Sub MoveCopy(ByVal IsMove As Boolean)
        Dim list As List(Of String)
        list = GetSelectFileOrDirName()
        Dim thePath As String
        CurrentPath = Session("CurrentPath")
        thePath = Path.Combine(CurrentPath, funcParam.Value) '判断后自动加入"\",thePath为目标路径
        If Directory.Exists(thePath) Then
            For Each strName As String In list
                '排除移动到自己的目录
                If Not strName.ToLower = thePath.ToLower Then
                    Try
                        If IsMove Then
                            '移动文件
                            If File.Exists(strName) Then
                                '文件已存在解决办法 
                                Dim tName As String = FileDirServer.GetFileNameFromPath(strName)
                                File.Move(strName, Path.Combine(thePath, tName))
                            ElseIf Directory.Exists(strName) Then
                                Directory.Move(strName, thePath)
                            End If
                        Else '只copy文件，不copy文件夹
                            Dim tName As String = FileDirServer.GetFileNameFromPath(strName)
                            File.Copy(strName, Path.Combine(thePath, tName))
                        End If
                    Catch ex As Exception
                        StatusMessage.Text = ex.Message
                    End Try

                End If
            Next
            BindData()
        Else
            StatusMessage.Text = funcParam.Value & "目录不存在"
        End If

    End Sub
#End Region


End Class