driver.asp

BS在线文件管理系统的源码和说明

<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 = d&"所在驱动器 " & UCase(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&"""")
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
	 'call ShowDriveType(d)
	 response.write("驱动器"&d&" 没有准备好！""")
	end if
    else
     response.write("驱动器"&drvPath&"不存在！""")
    end if
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)
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;")
End Function

'------------驱动器可用空间
Function ShowFreeSpace(drvPath)
On error resume next
    Dim fs, d, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(drvPath))
    s = "驱动器 " & UCase(drvPath) & " - " 
    s = s & d.VolumeName 
    s = s & "可用： " & FormatNumber(d.FreeSpace/1024, 0) 
    s = s & "KB"
    response.write("文件系统："&s)
End Function

'------------驱动器根目录
Function ShowRootFolder(drvPath)
On error resume next
    Dim fs, d, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(drvPath))
    s=d.RootFolder
    response.write("驱动器根目录："&s& "&nbsp;序列号： " & d.SerialNumber&"<hr>")
End Function

'------------驱动器是否是网络驱动器--------'此段代码有误
Function ShowDriveInfo(drvpath)
On error resume next
    Dim fs, d, s 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))
    if d.ShareName="" then
     call ShowPer(d)
    else
    s = "驱动器 " & d.DriveLetter & ": - " & d.ShareName
    response.write(s)
    end if
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='" & Request.ServerVariables("Script_name") & "?dir=" & d.DriveLetter & ":\'>驱动器" & d.DriveLetter & "</a>")
		response.write("</td>")
	Next
		response.write("</tr></table>")
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
	CheckCorrectPath=false	
	Exit Function
    end if
else
    CheckCorrectPath=false
    Exit Function
end if
CheckCorrectPath=true
End Function
</script>