ASP+FSO实现的服务器目录名和文件名罗列脚本-优快云博客

这是一个用于罗列指定目录下所有文件的ASP脚本。用户可以通过设置不同的参数来定制罗列行为，例如指定要罗列的目录、文件类型、罗列的层数等。脚本还支持在浏览器窗口输出结果、生成文本日志文件以及显示文件大小和扩展名。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

<%
Response.Buffer = False
Server.ScriptTimeOut = 360000000
On error Resume next
%>
<html>
<head>
<title>::. 风动网目录文件罗列脚本 .::</title>
<style type="text/css">
Body {font-size: 12px; font-family: "verdana", "arial", "helvetica", "sans-serif"}
a {color: #000000; text-decoration: none}
</STYLE>
</head>
<body>
<div align="center">
<form align="center" action="?" method="post" ID="Form1">
<fieldset style="width: 350px;">
<legend align="center" οnclick="showOrHide('syspanel');" style="cursor: hand;" title="点击[显示/隐藏]此框"><b><big>风动网目录文件罗列脚本</big></b></legend>
<div id="syspanel">
目录: <input type="text" name="ListPath" size="40"
title="这里指服务器上的目录, 可以是盘符或路径." ID="Text1"><br>
类型: <input type="text" name="FileType" size="40"
title="你所要罗列文件的类型,
如[.exe .rar],中间可用任意字符隔开
不填即列所有类型文件." ID="Text2"><br>
层数: <input type="text" name="Depth" size="40"
title="你所要罗列目录的层数, 不填即列所有层数." ID="Text3"><br>
<span id="param1ctrl" style="display: none;">路径: <input type="text" name="LogPath" size="40"
title="目录清单文件保存的路径, 也是指服务器上的." ID="Text4"><br></span>
参数: <input type="checkbox" name="Param" value="file" checked
title="是否罗列出文件." ID="Checkbox1"> 列文件
<input type="checkbox" name="Param1" value="txtlog" οnclick="display('param1ctrl','Param1');"
title="是否生成目录清单文件." ID="Checkbox2"> 生成txt
<input type="checkbox" name="Param2" value="scrout" checked
title="是否在浏览器窗口中输出." ID="Checkbox3"> 屏幕输出<br>　　
<input type="checkbox" name="Param3" value="fsout" checked
title="是否显示文件大小." ID="Checkbox2"> 显示文件大小
<input type="checkbox" name="Param4" value="fenout" checked
title="是否显示文件扩展名." ID="Checkbox2"> 显示文件扩展名<br><br>　　
<input type="submit" value="     开   始   罗   列     " title="罗列过程中按空格可以控制屏幕滚动" ID="Submit1" NAME="Submit1">
</div>
</fieldset>
</form>
</div>
<script language="JavaScript">

</script>
<%
Dim ListPath, Depth, CurDepth
ListPath = Replace(Request.Form("ListPath"), "/", "/")
If Not ListPath = Empty Then
%>
<script language="JavaScript">

</script>
<%
If Right(ListPath, 1) <> "/" Then ListPath = ListPath & "/"
If Not Request.Form("Depth") = "" Then Depth = Int(Request.Form("Depth"))
FileType = LCase(Request.Form("FileType"))
Param = Request.Form("Param")
Param1 = Request.Form("Param1")
Param2 = Request.Form("Param2")
Param3 = Request.Form("Param3")
Param4 = Request.Form("Param4")

Set ListParentObject = Server.CreateObject("Scripting.FileSystemObject")
If Len(ListPath) <= 4 Then
   If ListParentObject.DriveExists(ListPath) Then
    Set ListDriveObject = ListParentObject.GetDrive(ListPath)
    If ListDriveObject.IsReady = True Then
     Set ListPathObject = ListDriveObject.RootFolder
    Else
     errmsg = "<br>对不起,当前驱动器未准备就绪!"
     ErrOccur(errmsg)
     Response.End
    End If
   Else
    errmsg = "<br>对不起,当前驱动器不存在!"
    ErrOccur(errmsg)
    Response.End
   End If
Else
   If ListParentObject.FolderExists(ListPath) Then
    Set ListPathObject = ListParentObject.GetFolder(ListPath)
   Else

    errmsg = "<br>对不起,当前路径不存在!"
    ErrOccur(errmsg)
    Response.End
   End If

End If
If Param1 = "txtlog" Then
   Dim LogPath
   LogPath = Replace(Request.Form("LogPath"), "/", "/")
   Set FSO = Server.CreateObject("Scripting.FileSystemObject")
   If (FSO.FolderExists(LogPath)) Then

    If (Right(LogPath, 1) <> "/") Then LogPath = LogPath & "/"
    Set FO = FSO.CreateTextFile(LogPath & Replace(Replace(ListPath, "/", "-"), ":", "-") & ".txt")
   Else
    Response.Write "<font color=""red"">输入路径不存在, 日志文件将被保存在与该脚本相同的目录下.</font><br><br>"
    Set FO = FSO.CreateTextFile(Server.MapPath(Replace(Replace(ListPath, "/", "-"), ":", "-") & ".txt"))
   End If
End If
Response.Write "<font color=""brown"">▊</font> 目录　　"
Response.Write "<font color=""green"">▊</font> 文件<br><br>"
Response.Write "<b><font color=""red"">[" & ListPath & "]</font></b><br>"
If Param1 = "txtlog" Then FO.Write(ListPath) & VbCrLf
Call ListAllPath(ListPath, "0", False)
Response.Write "<br><br><b><font color=""red"">罗列完毕!</font></b>"
%>

<script language="JavaScript">

</script>
<%
If Param1 = "txtlog" Then

   Set FO = Nothing
   Set FSO = Nothing
End If
End If
%>
</body>
</html>
<%

Function ListAllPath(byval CurPath, byval Symbol, byval LastFolder)

Dim CurFolderIndex
CurFolderIndex = 0
CurDepth = CurDepth + 1
If LastFolder = True Then

   Symbol = Symbol & "1"
Else

   Symbol = Symbol & "2"
End If

If Depth <> "" Then

   If CurDepth >= Depth + 1 Then Exit Function
End If
If Len(ListPath) <= 4 Then
   Set ListDriveObject = ListParentObject.GetDrive(CurPath)
   Set ListPathObject = ListDriveObject.RootFolder
Else
   Set ListPathObject = ListParentObject.GetFolder(CurPath)
End If
If InStr(Param, "file") > 0 Then Call ListAllFile(CurPath, Symbol, LastFolder)
TotalFolderNum = ListPathObject.SubFolders.Count
For Each ListPath In ListPathObject.SubFolders
   CurFolderIndex = CurFolderIndex + 1
   If ListPath.Attributes <> 22 Then
    If ListPath.Size <= 1024 Then
     PathSize = 1
    Else
     PathSize = FormatNumber(ListPath.Size/1024,0)
    End If
    StrTemp = Nums2Symbols(Mid(Symbol, 3))
    If Param2 = "scrout" Then Response.Write StrTemp
    If Param1 = "txtlog" Then FO.Write(StrTemp)
    If CurFolderIndex = TotalFolderNum Then
     If Param2 = "scrout" Then Response.Write("└─")
     If Param1 = "txtlog" Then FO.Write("└─")
     LastFolder1 = True
    Else

     If Param2 = "scrout" Then Response.Write("├─")
     If Param1 = "txtlog" Then FO.Write("├─")
     LastFolder1 = False
    End If
    If Param2 = "scrout" Then
   Response.Write("<font color=""brown"">" & ListPath.Name)
   If Param3 = "fsout" Then Response.Write("　　" & PathSize & "KB")
   Response.Write("</font><br>")
End If
    If Param1 = "txtlog" Then
   FO.Write(ListPath.Name)
   If Param3 = "fsout" Then FO.Write("　　" & PathSize & "KB")
   FO.Write(VbCrLf)
End If
    Call ListAllPath(ListPath, Symbol, LastFolder1)
    CurDepth = CurDepth - 1
   Else
    If CurFolderIndex = TotalFolderNum Then
     If Param2 = "scrout" Then Response.Write("└─")
     If Param1 = "txtlog" Then FO.Write("└─")
     LastFolder1 = True
    Else

     If Param2 = "scrout" Then Response.Write("├─")
     If Param1 = "txtlog" Then FO.Write("├─")
     LastFolder1 = False
    End If
    If Param2 = "scrout" Then Response.Write("<font color=""brown"">" & ListPath.Name & "　　系统文件夹</font><br>")
    If Param1 = "txtlog" Then FO.Write(ListPath.Name & "　　系统文件夹" & VbCrLf)
   End If
Next

End Function

Function ListAllFile(byval CurPath, byval Symbol, byval LastFolder)

Set ListFileObject = ListParentObject.GetFolder(CurPath)
TotalFolderNum = ListFileObject.SubFolders.Count

For Each ListFile In ListFileObject.Files
   If ListFile.Size <= 1024 Then
    FileSize = 1
   Else
    FileSize = FormatNumber(ListFile.Size/1024,0)
   End If
   If InStr(ListFile.Name, ".") Then
    FType = ListParentObject.GetExtensionName(ListFile.Name)'Mid(ListFile.Name, InstrRev(ListFile.Name, "."))
   End If
   If Instr(FileType, LCase(FType)) > 0 Or FileType = "" Then
    StrTemp = Nums2Symbols(Mid(Symbol, 3))
    If Param2 = "scrout" Then Response.Write(StrTemp)
    If Param1 = "txtlog" Then FO.Write(StrTemp)
    If TotalFolderNum = 0 Then
     If Param2 = "scrout" Then Response.Write("")
     If Param1 = "txtlog" Then FO.Write("")
    Else
     If Param2 = "scrout" Then Response.Write("│")
     If Param1 = "txtlog" Then FO.Write("│")
    End If
    If Param2 = "scrout" Then
   Response.Write("<font color=""green"">")
   If Param4 = "fenout" Then
    Response.Write(ListFile.Name)
   Else
    Response.Write(GetFileName(ListFile.Name))
   End If
   If Param3 = "fsout" Then Response.Write("　　" & FileSize & "KB")
   Response.Write("</font><br>")
End If
    If Param1 = "txtlog" Then
   If Param4 = "fenout" Then
    FO.Write(ListFile.Name)
   Else
    FO.Write(GetFileName(ListFile.Name))
   End If
   If Param3 = "fsout" Then FO.Write("　　" & FileSize & "KB")
   FO.Write(VbCrLf)
End If
   End If
Next

End Function

Function GetFileName(byval FileFullName)
GetFileName = Left(FileFullName, InstrRev(FileFullName, ".")-1)
End Function

Function Num2Symbol(byval Num)
Select Case Num
   Case 0
    Num2Symbol = " "
   Case 1
    Num2Symbol = ""
   Case 2
    Num2Symbol = "│"
End Select
End Function

Function Nums2Symbols(byval Num)
i = Len(Num)
While i > 0
   Nums2Symbols = Nums2Symbols & Num2Symbol(Left(Num, 1))
   Num = Mid(Num, 2)
   i = i - 1
Wend
End Function

Sub ErrOccur(byval errmsg)

If Param2 = "scrout" Then Response.Write "<font color=""red"">" & errmsg & "</font>"
%>
<script language="JavaScript">

</script>
</body>
</html>
<%
End Sub
%>