<%
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">
<!--
window.status = " ** 风动网目录文件罗列脚本 ** ";
function showOrHide(id) {
if (getObjectById(id).style.display=="none")
{getObjectById(id).style.display='block';}
else
{getObjectById(id).style.display='none';}
}
function display(id,ctrl) {
if (getObjectById(ctrl).checked==true)
{getObjectById(id).style.display='block';}
else
{getObjectById(id).style.display='none';}
}
function displayObject(id,flag) {
if (flag==true)
{getObjectById(id).style.display='block';}
else
{getObjectById(id).style.display='none';}
}
function getObjectById(id) {
return document.getElementById(id);
}
//-->
</script>
<%
Dim ListPath, Depth, CurDepth
ListPath = Replace(Request.Form("ListPath"), "\", "/")
If Not ListPath = Empty Then
%>
<script language="JavaScript">
<!--
window.status = "服务器正在罗列,请稍候 ... (按空格可以控制屏幕滚动)"
Timer = window.setInterval("window.scroll(0, document.body.scrollHeight);", 50);
var Timer;
var stopScroll;
function document.onkeydown() {
if (event.keyCode == 32) {
if (stopScroll == false) {
winScroll();
stopScroll = true;
}
else {
window.clearInterval(Timer);
stopScroll = false;
}
}
}
function winScroll(){
Timer = window.setInterval("window.scroll(0, document.body.scrollHeight);", 100);
}
function document.onstop(){
window.status = "罗列中断!"
window.setTimeout("window.clearInterval(Timer);", 1000);
}
//-->
</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">
<!--
window.status = "罗列完毕!"
window.setTimeout("window.clearInterval(Timer);", 1000);
//-->
</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">
<!--
window.status = "罗列出错!"
window.setTimeout("window.clearInterval(Timer);", 1000);
//-->
</script>
</body>
</html>
<%
End Sub
%>
当前位置：
支持(0) | 
反对(0)
顶端 
底部
![电子邮件:[ ddsfasd@163.com ]](http://bbs.kesion.com/club/images/email.gif){kind=small}
