怎样才能实现按顺序取得或显示目录树及该目录下的文件名-领先建站CMS提供服务商我们专注于CMS建站产品的研发

1608 查看	0 回复

主题：[求助]怎样才能实现按顺序取得或显示目录树及该目录下的文件名 [收藏主题]

dzxlyh 当前离线

23 主题	0 广播	0 粉丝

级别:学前班

用户积分:1024 分
登录次数:105 次
注册时间:2006/4/28
最后登录:2011/12/6

dzxlyh 发表于：2007/6/13 17:56:00 | 只看该作者查看该作者主题楼主

做考试题库就用#科汛在线考试系统!

我根据下面的代码，运行后出现目录及文件顺序混乱。

请问：

我要怎样才能实现按顺序取得或显示目录树及该目录下的文件名？

我的源代码如下：

<%
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">
<table border="1" width="100%">
<tr>
  <td align=center><a href="listdir.asp">::. 风动网目录文件罗列脚本 .::</a></td>
</tr>
</table>
<form align="center" action="?" method="post" ID="Form1">
<fieldset style="width: 350px;">
<legend align="center" onclick="showOrHide('syspanel');" style="cursor: hand;" title="点击[显示/隐藏]此框"><b><big>风动网目录文件罗列脚本</big></b></legend>
<div id="syspanel">
目录: <input type="text" name="ListPath" value="D:\Inetpub\Test1\eWebEditor4.8\UploadFile" size="40" title="这里指服务器上的目录, 可以是盘符或路径." ID="Text1"><br>
层数: <input type="text" name="Depth" size="40" title="你所要罗列目录的层数, 不填即列所有层数." ID="Text3"><br>
参数: <input type="checkbox" name="Param" value="file" checked title="是否罗列出文件." ID="Checkbox1">
列文件<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 & "/"      '目录

ListPath = Server.MapPath(ListPath)

If Not Request.Form("Depth") = "" Then Depth = Int(Request.Form("Depth"))   '层数
FileType = LCase(Request.Form("FileType"))          '显示的文件类型
Param = Request.Form("Param")

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

Response.Write "<font color=""brown"">▊</font> 目录　　"
Response.Write "<font color=""green"">▊</font> 文件<br><br>"
Response.Write "<b><font color=""red"">[" & ListPath & "]</font></b><br>"

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>
<%

'Call ListAllPath(ListPath, "0", False)

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

Dim CurFolderIndex,FSOListPath,ListAllPath1,ListAllPath0,ListAllPath3,ListAllPath4,i
i=1
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
Call ListAllFile(CurPath, Symbol, LastFolder)  '是否列出文件
TotalFolderNum = ListPathObject.SubFolders.Count   '统计同级目录数
For Each FSOListPath In ListPathObject.SubFolders
  CurFolderIndex = CurFolderIndex + 1

   If FSOListPath.Size <= 1024 Then       '该目录下所有文件大小合计
    PathSize = 1
   Else
    PathSize = FormatNumber(FSOListPath.Size/1024,0)
   End If

   StrTemp = Nums2Symbols(Mid(Symbol, 3))      '前面留几个空

   If CurFolderIndex = TotalFolderNum Then
    ListAllPath1 = StrTemp &"└─--<font color=""brown"">" & FSOListPath.Name &"</font><br>"  '输出到屏幕
    LastFolder1 = True
   Else
    ListAllPath1 = StrTemp &"├─--<font color=""brown"">" & FSOListPath.Name &"</font><br>"  '输出到屏幕
    LastFolder1 = False
   End If

   Call ListAllPath(FSOListPath, Symbol, LastFolder1)
   ListAllPath = ListAllPath1 & ListAllPath
   CurDepth = CurDepth - 1              '目录层数
Next
Response.Write ListAllPath
End Function

Function ListAllFile(byval CurPath, byval Symbol, byval LastFolder)
Dim ListAllFile1
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)
  End If
  If Instr(FileType, LCase(FType)) > 0 Or FileType = "" Then
   StrTemp = Nums2Symbols(Mid(Symbol, 3))
   If TotalFolderNum = 0 Then
    ListAllFile1 = StrTemp &""
   Else
    ListAllFile1 = StrTemp &"│"
   End If

   ListAllFile1 = ListAllFile1 &"<font color=""green"">"& ListFile.Name &"</font><br>"
  End If

  ListAllFile = ListAllFile & ListAllFile1
Next
Response.Write(ListAllFile)

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
%>

做新职业技能培训平台就选#科汛网校

支持(0) |

反对(0)

顶端

底部

＜上一主题 | 下一主题＞

<< 返回列表

首页 1