folderfilelist.asp

SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit%>
<!--#include file="../../Conn.asp"-->
<!--#include file="../../SysCls/KS_CommonCls.asp"-->
<!--#include file="../../SysCls/KS_FileIcon.asp"-->
<!--#include file="../Inc/Session1.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 SP2 Free
'Copyright (C) 2006-2008 Kesion.Com  All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407 
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail  :[e-mail] [e-mail]
'官方网站：http://www.kesion.com  
'演示站点：http://test.kesion.com 
'郑重声明:
'    ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
'    ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
'    ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New FolderFileList
KSCls.Execute()
Set KSCls = Nothing

Class FolderFileList
        Private KSCMS
		Private Sub Class_Initialize()
		  Set KSCMS=New CommonCls
		End Sub
        Private Sub Class_Terminate()
		 Call KSCMS.CloseConn()
		 Set KSCMS=Nothing
		End Sub
		'主体部分
		Sub Execute()
		Dim CurrPath, FsoObj, SubFolderObj, FolderObj, FileObj, I, FsoItem, OType
		Dim ParentPath, FileExtName, AllowShowExtNameStr
		Dim ShowVirtualPath
		Dim CanBackFlag
		Set FsoObj = Server.CreateObject(KSCMS.GetConfig("FsoObjName"))
		Dim InstallDir, UpFilesDir, Hypothesized, ChannelID
		
		InstallDir = KSCMS.GetConfig("InstallDir")
		UpFilesDir = KSCMS.GetConfig("UpFilesDir")
		Hypothesized = KSCMS.GetConfig("InstallDir")
		
		On Error Resume Next
		OType = Request("Type")
		If OType <> "" Then
			Dim Path, PhysicalPath
			If OType = "DelFolder" Then
				Path = Request("Path")
				If Path <> "" Then
					Path = Server.MapPath(Path)
					If FsoObj.FolderExists(Path) = True Then FsoObj.DeleteFolder Path
				End If
			ElseIf OType = "DelFile" Then
				Dim DelFileName
				Path = Request("Path")
				DelFileName = Request("FileName")
				If (DelFileName <> "") And (Path <> "") Then
					Path = Server.MapPath(Path)
					If FsoObj.FileExists(Path & "\" & DelFileName) = True Then FsoObj.DeleteFile Path & "\" & DelFileName
				End If
			ElseIf OType = "AddFolder" Then
				Path = Request("Path")
				If Path <> "" Then
					Path = Server.MapPath(Path)
					If FsoObj.FolderExists(Path) = True Then
						Response.Write ("<script>alert('对不起，目录已经存在！');</script>")
					Else
						FsoObj.CreateFolder Path
					End If
				End If
			ElseIf OType = "FileReName" Then
				Dim NewFileName, OldFileName
				Path = Request("Path")
				If Path <> "" Then
					NewFileName = Request("NewFileName")
					OldFileName = Request("OldFileName")
					If (NewFileName <> "") And (OldFileName <> "") Then
						PhysicalPath = Server.MapPath(Path) & "\" & OldFileName
						If FsoObj.FileExists(PhysicalPath) = True Then
							PhysicalPath = Server.MapPath(Path) & "\" & NewFileName
							If FsoObj.FileExists(PhysicalPath) = False Then
								Set FileObj = FsoObj.GetFile(Server.MapPath(Path) & "\" & OldFileName)
								FileObj.name = NewFileName
								Set FileObj = Nothing
							End If
						End If
					End If
				End If
			ElseIf OType = "FolderReName" Then
				Dim NewPathName, OldPathName
				Path = Request("Path")
				If Path <> "" Then
					NewPathName = Request("NewPathName")
					OldPathName = Request("OldPathName")
					If (NewPathName <> "") And (OldPathName <> "") Then
						PhysicalPath = Server.MapPath(Path) & "\" & OldPathName
						If FsoObj.FolderExists(PhysicalPath) = True Then
							PhysicalPath = Server.MapPath(Path) & "\" & NewPathName
							If FsoObj.FolderExists(PhysicalPath) = False Then
								Set FileObj = FsoObj.GetFolder(Server.MapPath(Path) & "\" & OldPathName)
								FileObj.name = NewPathName
								Set FileObj = Nothing
							End If
						End If
					End If
				End If
			End If
		End If
		
		ShowVirtualPath = KSCMS.G("ShowVirtualPath")
		AllowShowExtNameStr = "jpg,txt,gif,bmp"
		CurrPath = KSCMS.G("CurrPath")
		ChannelID = KSCMS.G("ChannelID")
		If ChannelID = "" Or Not IsNumeric(ChannelID) Then ChannelID = 0
		If CurrPath = "" Then
			ParentPath = ""
		Else
			ParentPath = Mid(CurrPath, 1, InStrRev(CurrPath, "/") - 1)
			If ParentPath = "" Then
				ParentPath = Left(InstallDir, Len(InstallDir) - 1)
			End If
		End If
		If ChannelID <> 0 Then
		 Session("CurrPath") = CurrPath
		End If
		Set FolderObj = FsoObj.GetFolder(Server.MapPath(CurrPath))
		Set SubFolderObj = FolderObj.SubFolders
		Set FileObj = FolderObj.Files
		
		
		Response.Write "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.01 Transitional//EN"">"
		Response.Write "<html>"
		Response.Write "<head>"
		Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"
		Response.Write "<title>文件和目录列表</title>"
		Response.Write "</head>"
		Response.Write "<link href=""../inc/Admin_Style.CSS"" rel=""stylesheet"">"
		Response.Write "<body topmargin=""0"" leftmargin=""0"" onClick=""SelectFolder();"">"
		Response.Write "<table width=""99%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""0"">"
		Response.Write "  <tr>"
		Response.Write "    <td width=""70%"" class=""sort""> <div align=""center"">文件/文件夹名</div></td>"
		Response.Write "    <td width=""30%"" class=""sort""> <div align=""center"">大小</div></td>"
		Response.Write "  </tr>"
		 
		   If (CurrPath <> InstallDir & Left(UpFilesDir, Len(UpFilesDir) - 1)) And (ParentPath <> "") And Session("CurrPath") <> CurrPath Then
			 CanBackFlag = 1 '设置状态为可返回
		  
		Response.Write "  <tr title=""上级目录" & ParentPath & """>"
		Response.Write "    <td><table width=""117"" border=""0"" cellpadding=""0"" cellspacing=""0"">"
		Response.Write "        <tr>"
		Response.Write "          <td width=""24""><font color=""#FFFFFF""><img src=""../Images/arrow.gif""></font></td>"
		Response.Write "          <td><span onClick=""SelectUpFolder(this);"" onDblClick=""OpenParentFolder();"">返回上级目录</span></td>"
		Response.Write "        </tr>"
		Response.Write "      </table></td>"
		Response.Write "    <td></td>"
		Response.Write "  </tr>"
		
		 Else
		 CanBackFlag = 0  '设置状态为不可返回
		End If
		For Each FsoItem In SubFolderObj
		
		Response.Write "  <tr>"
		Response.Write "    <td width=""30%""><table border=""0"" cellspacing=""0"" cellpadding=""0"">"
		Response.Write "        <tr title=""双击鼠标进入此目录"">"
		Response.Write "          <td  width=""24""><img src=""../images/Folder/folderclosed.gif""></td>"
		Response.Write "         <td> <span class=""FolderItem"" Path=""" & FsoItem.name & """ onDblClick=""OpenFolder(this);"">"
		Response.Write FsoItem.name
		Response.Write "            </span> </td>"
		Response.Write "        </tr>"
		Response.Write "      </table></td>"
		Response.Write "    <td><div align=""Right"">"
		Response.Write FsoItem.size
		Response.Write "      字节 </div></td>"
		Response.Write "  </tr>"
		
		Next
		For Each FsoItem In FileObj
			FileExtName = LCase(Mid(FsoItem.name, InStrRev(FsoItem.name, ".") + 1))

		
		Response.Write "  <tr>"
		Response.Write "    <td width=""30%""><table border=""0"" cellspacing=""0"" cellpadding=""0"">"
		Response.Write "        <tr title=""双击鼠标进入此目录"">"
		Response.Write "          <td  width=""24""><img src='"&InstallDir&"syscls/fileicon/"&GetFileIcon(FsoItem.name)&"' border=0 width=""16"" height=""16"" align=""absmiddle"" alt='"& FsoItem.Type&"'</td>"
		Response.Write "         <td> <span class=""FolderItem"" File=""" & FsoItem.name & """ onDblClick=""SetFile(this);"" onClick=""SelectFile(this);"">"
		Response.Write FsoItem.name
		Response.Write "            </span> </td>"
		Response.Write "        </tr>"
		Response.Write "      </table></td>"
		Response.Write "    <td><div align=""Right"">"
		Response.Write FsoItem.size
		Response.Write "        &nbsp;字节 </div></td>"
		Response.Write "  </tr>"
		
		Next
		
		Response.Write "</table>"
		Response.Write "</body>"
		Response.Write "</html>"
		
		If Err Then
		 Response.Write ("<Script> alert('系统检测到网站信息配置有误,请检查!');window.close()</Script>")
		 Err.Clear
		End If
		Set FsoObj = Nothing
		Set SubFolderObj = Nothing
		Set FileObj = Nothing
		
		Response.Write "<script language=""JavaScript"">" & vbCrLf
		Response.Write "var CurrPath='" & CurrPath & "';" & vbCrLf
		Response.Write "var Hypothesized='" & Hypothesized & "';" & vbCrLf
		Response.Write "var ShowVirtualPath='" & ShowVirtualPath & "';" & vbCrLf
		Response.Write "var ParentPath='" & ParentPath & "';" & vbCrLf
		Response.Write "var CanBackFlag=" & CanBackFlag & ";" & vbCrLf
		Response.Write "</script>"
		Response.Write "<script src=""../Common/FolderFIleList.JS"" language=""javascript""></script>"
		End Sub
		Function CheckFileShowTF(AllowShowExtNameStr, ExtName)
			If ExtName = "" Then
				CheckFileShowTF = False
			Else
				If InStr(1, AllowShowExtNameStr, ExtName) = 0 Then
					CheckFileShowTF = False
				Else
					CheckFileShowTF = True
				End If
			End If
		End Function
End Class
%>