driver.asp

BS在线文件管理系统,采用asp编程,实现了对文件的简单管理,并且有比较方便的各种功能的实现.-BS online document management system, using asp prog

<Script RunAt=Server Language="VBScript">
'----------------驱动器可用空间
Function ShowAvailableSpace(drvPath)
On error resume next
    Dim fs, d, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(drvPath))
    s = s & "总容量： " &FormatNumber((d.TotalSize/1024)/1024, 0)&"MB&#13;&#10;"
    s = s & "卷标：" &d.VolumeName&"&#13;&#10;"
    s = s & "可用空间：" & FormatNumber((d.AvailableSpace/1024)/1024, 0) 
    s = s & "MB"
    call ShowFileSystemType(drvPath)
if err then
	s = ""
end if
err.clear
    response.write(s&"""")
    Set fs = Nothing
End Function

'------------判断磁盘是否准备好
Function ShowPer(drvPath)
On error resume next
    Dim fs, d, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    if fs.DriveExists(drvPath) then
    Set d = fs.GetDrive(fs.GetDriveName(drvPath))
	if d.IsReady then
	 call ShowAvailableSpace(d)
	else
	 response.write("驱动器"&d&" 没有准备好！""")
	end if
    else
     response.write("驱动器"&drvPath&"不存在！""")
    end if
    Set fs = Nothing
End Function

'----------------驱动器类型
Function ShowDriveType(drvpath)
On error resume next
    Dim fs, d, s, t
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(drvpath)
    Select Case d.DriveType
        Case 0: t = "<img src=images\drive_D.gif title=""未知磁盘"">"
        Case 1: t = "<img src=images\drive_f.gif title=""可移动磁盘"">"
        Case 2: t = "<img src=images\drive_h.gif title=""固定磁盘"">"
        Case 3: t = "<img src=images\drive_n.gif title=""网络磁盘"">"
        Case 4: t = "<img src=images\drive_l.gif title=""CD-ROM磁盘"">"
        Case 5: t = "<img src=images\drive_r.gif title=""RAM 磁盘"">"
    End Select
    response.write(t)
    Set fs = Nothing
End Function

'------------文件系统类型
Function ShowFileSystemType(drvpath)
On error resume next
    Dim fs,d, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(drvpath)
    s = d.FileSystem
    response.write("文件系统："&s&"&#13;&#10;")
    Set fs = Nothing
End Function

'------------程序正文开始，获取驱动器列表
Function ShowDriveList
On error resume next
    Dim fs, d, dc
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dc = fs.Drives
	response.write("服务器共有如下"&dc.Count&"个驱动器<br>")
		response.write("<table border=0><tr>")
	For Each d in dc
		response.write("<td>")
	 call ShowDriveType(Cstr(d.DriveLetter&":\"))
		response.write("</td><td>")
		response.write("<a title=""")
	 call ShowPer(Cstr(d.DriveLetter&":"))
		response.write(" href='main.asp?dir=" & d.DriveLetter & ":\' target='mainFrame'>驱动器" & d.DriveLetter & "</a>")
		response.write("</td>")
	Next
		response.write("</tr></table>")
    Set fs = Nothing
End Function

'--------------------------------------检验是否正确路径
Function CheckCorrectPath(thePath)
    Dim fs, d, dc, path, noLetter(8), i, letter, length
	noLetter(0)="<"
	noLetter(1)=">"
	noLetter(2)="/"
	noLetter(3)=""""
	noLetter(4)="?"
	noLetter(5)="*"
	noLetter(6)="&"
	noLetter(7)=":"
	noLetter(8)="|"
    path=LCase(Cstr(trim(thePath)))
    Length=Len(path)
'--------------------------长度小于2退出
If Length < 2 then
	CheckCorrectPath=false
	Exit Function
end if
'--------------------------
If Mid(path,2,1) = ":" then
'-------------------------------------
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.DriveExists(left(path,2)&"\") then
	If Length >= 3 then
	    If mid(path,3,1) <> "\" then
		CheckCorrectPath=false
		Exit Function
	    else
		i = 3
		While i <= Length
		    For each letter in NoLetter
			If letter = mid(path,i,1) then
			    CheckCorrectPath=false
			    Exit Function
			end if
		    next
		i = i+1
		wend
	    end if
	end if
	Set dc = nothing
	Set fs = nothing
    else
	Set fs = Nothing
	CheckCorrectPath=false	
	Exit Function
    end if
else
    CheckCorrectPath=false
    Exit Function
end if
CheckCorrectPath=true
End Function
</script>