⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 netdisk.aspx.vb

📁 采用VB.net编写的网络硬盘,这只是一个模型,对编写网络硬盘的朋友有一定的引导做用
💻 VB
字号:
Imports System.IO
Imports System.Drawing
Imports System.Web.UI.HtmlControls

Public Class NetDisk
    Inherits System.Web.UI.Page

#Region " Web 窗体设计器生成的代码 "

    '该调用是 Web 窗体设计器所必需的。
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()

    End Sub

    '注意: 以下占位符声明是 Web 窗体设计器所必需的。
    '不要删除或移动它。
    Protected ND As Pub3one = New Pub3one
    Private designerPlaceholderDeclaration As System.Object
    Protected WithEvents Info As System.Web.UI.WebControls.Label
    Protected WithEvents Label1 As System.Web.UI.WebControls.Label
    Protected WithEvents Label2 As System.Web.UI.WebControls.Label
    Protected WithEvents Label3 As System.Web.UI.WebControls.Label
    Protected WithEvents FileList As System.Web.UI.WebControls.ListBox
    Protected WithEvents BtnOpen As System.Web.UI.WebControls.Button
    Protected WithEvents BtnDelete As System.Web.UI.WebControls.Button
    Protected WithEvents NewDirName As System.Web.UI.WebControls.TextBox
    Protected WithEvents BtnUpLoad As System.Web.UI.WebControls.Button
    Protected WithEvents BtnNewDir As System.Web.UI.WebControls.Button
    Protected WithEvents chkReadOnly As System.Web.UI.WebControls.CheckBox
    Protected WithEvents chkHidden As System.Web.UI.WebControls.CheckBox
    Protected WithEvents WebFile As System.Web.UI.HtmlControls.HtmlInputFile
    Protected CurrentPath As String = "C:\UserDir\"

    Private Sub Page_Init(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Init
        'CODEGEN: 此方法调用是 Web 窗体设计器所必需的
        '不要使用代码编辑器修改它。
        InitializeComponent()
    End Sub

#End Region

    Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        '在此处放置初始化页的用户代码
        If Page.IsPostBack = False Then
            'CurrentPath= "C:\UserDir\"  '设置当前目录
            If Directory.Exists("C:\UserDir\") = False Then '若该目录不存在,创建该目录

                Directory.CreateDirectory("C:\UserDir\")
                LoadDir(CurrentPath)  '初始化装入目录

            End If
        End If
    End Sub

    Private Function LoadDir(ByVal FullPath As String)

        CurrentPath = FullPath

        Dim values As ArrayList = New ArrayList

        Dim MyFiles(), MyDirs() As String

        MyFiles = Directory.GetFiles(FullPath)       '得到该目录下所有文件

        If CurrentPath <> "C:\UserDir" Then          '若不是顶级目录,增加返回上级目录选项

            values.Add("返回上级目录")

        End If

        values.AddRange(MyFiles)                     '加入文件

        MyDirs = Directory.GetDirectories(FullPath)  '得到该目录下所有目录

        values.AddRange(MyDirs)                      '加入目录

        FileList.DataSource = values                 '设定数据源

        FileList.DataBind()                          '绑定数据

    End Function

    Private Sub BtnDelete_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnDelete.Click
        DeleteThings(FileList.SelectedItem.Text)
    End Sub

    Private Function DeleteThings(ByVal FullPath As String)

        If FullPath.IndexOf(".") > 0 Then '删除文件
            File.Delete(FullPath)
            LoadDir(CurrentPath)  '重新载入当前目录
        Else    '删除目录
            Directory.Delete(FullPath)
            LoadDir(CurrentPath) '重新载入当前目录
        End If

    End Function

    Private Sub BtnUpLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnUpLoad.Click

        If WebFile.PostedFile.FileName = "" Then
            Response.Write("<script>alert('请先选择要上传的文件')</script>")
            Return
        End If

        Try
            Dim spliter() As Char = {"\\"}
            Dim FileName() As String = WebFile.PostedFile.FileName.Split(spliter, 10)
            Dim FullPath As String = CurrentPath + "\" + FileName(FileName.Length - 1)
            '生成完整文件名
            WebFile.PostedFile.SaveAs(FullPath)  '保存文件
            LoadDir(CurrentPath)                 '重新载入当前目录
        Catch
            Response.Write("<script>alert('上传文件失败,请与管理员联系')</script>")
        End Try

    End Sub


    Private Sub BtnOpen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnOpen.Click

        If FileList.SelectedItem.Text = "返回上级目录" Then '返回上级目录
            Dim ParentPath As String = Directory.GetParent(CurrentPath).ToString()
            LoadDir(ParentPath)
            Return
        ElseIf (FileList.SelectedItem.Text.IndexOf(".") > 0) Then '打开文件
            FileDownload(FileList.SelectedItem.Text)
        Else    '打开目录
            CurrentPath = FileList.SelectedItem.Text
            LoadDir(FileList.SelectedItem.Text)
        End If

    End Sub

    Private Function FileDownload(ByVal FullFileName As String)

        Dim DownloadFile As FileInfo = New FileInfo(FullFileName)  '设置要下载的文件

        Response.Clear()                            '清除缓冲区流中的所有内容输出

        Response.ClearHeaders()                     '清除缓冲区流中的所有头

        Response.Buffer = False                    '设置缓冲输出为false

        '设置输出流的 HTTP MIME 类型为application/octet-stream

        Response.ContentType = "application/octet-stream"

        '将 HTTP 头添加到输出流

        Response.AppendHeader("Content-Disposition", "attachment;filename=" + HttpUtility.UrlEncode(DownloadFile.FullName, System.Text.Encoding.UTF8))

        Response.AppendHeader("Content-Length", DownloadFile.Length.ToString())

        '将指定的文件直接写入 HTTP 内容输出流。

        Response.WriteFile(DownloadFile.FullName)

        Response.Flush()       '向客户端发送当前所有缓冲的输出

        Response.End()         '将当前所有缓冲的输出发送到客户端

    End Function



    Private Sub BtnNewDir_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnNewDir.Click
        If NewDirName.Text = "" Then
            Response.Write("<script>alert('请先输入要创建的新文件夹名')</script>")
            Return
        End If

        Dim FullDirName As String = CurrentPath + "\" + NewDirName.Text    '生成完整路径

        Try
            If Directory.Exists(FullDirName) Then
                Response.Write("<script>alert('已存在该文件夹,请更换名称')</script>")
                Return
            End If

            Dim DirInfo As DirectoryInfo = Directory.CreateDirectory(FullDirName)  '创建目录

            If chkReadOnly.Checked = True Then

                If chkHidden.Checked = False Then
                    DirInfo.Attributes = FileAttributes.ReadOnly
                Else
                    DirInfo.Attributes = FileAttributes.ReadOnly Or FileAttributes.Hidden
                End If

            Else

                If chkHidden.Checked = True Then
                    DirInfo.Attributes = FileAttributes.Hidden
                End If

            End If
            LoadDir(CurrentPath)  '重新载入当前目录
        Catch
            Response.Write("<script>alert('创建文件夹失败,请与管理员联系')</script>")
        End Try
    End Sub

    Private Sub FileList_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles FileList.SelectedIndexChanged

    End Sub
End Class

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -