<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%> <% option explicit response.charset = "UTF-8" session.codepage = 65001 session.timeout = 1440 server.scripttimeout = 9999 '*************************** '名稱：目錄列表類 '作者：逸品 '日期：2010-4-28 '網址：m.survivalescaperooms.com '描述：目錄列表類，支持畸形目錄名 '*************************** Class FsoCls Private Fso Public FsoObj Private Sub Class_Initialize Set Fso=CreateObject("Scripting.FileSystemObject") Set FsoObj=Fso End Sub Private Sub Class_Terminate Set Fso=Nothing Set FsoObj=Nothing End Sub Function IsFolderExists(FolderPath) If fso.FolderExists(FolderPath) Then IsFolderExists = true Else IsFolderExists = false End If End Function Function FolderItem(ByVal FolderDir) If Instr(FolderDir,":/")>0 Then FolderDir="http://?/"&FolderDir&"/" Else FolderDir="http://?/"&Server.MapPath(FolderDir)&"/" End If If IsFolderExists(FolderDir) = False Then FolderItem=False Exit Function End if Dim FolderObj,FolderList,F,i i=1 Set FolderObj=Fso.GetFolder(FolderDir) Set FolderList=FolderObj.SubFolders FolderItem="目錄總數："&FolderObj.SubFolders.Count&"<hr>" & vbcrlf FolderItem=FolderItem&"文件總數："&FolderObj.Files.count&"<hr>" & vbcrlf
For Each F In FolderList 'Response.Write F.ShortName 'Response.Write (instr(1,F.ShortName,"~",1)) If IsFolderExists(FolderDir&F.Name) = True Then Response.Write ("T<br>" & vbcrlf) If(instr(1,F.Name,".",0)>0) Then Response.Write ("T") F.Name=Replace(F.Name,".","-") End if FolderItem=FolderItem&i&"├─文件夾→"&F.Name&"<br>" & vbcrlf i=i+1 Next Set FolderList=Nothing Set FolderObj=Nothing End Function End Class %> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="zh-cn"> <head> <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> <title>目錄列表類 支持畸形目錄名</title> </head> <body> <% Dim F: Set F = new FsoCls Response.write F.FolderItem("/") %> </body> </html>
