📄 netdisk.aspx.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 + -