nc_filemanagecls.asp

来自「多用户管理分权限发布、管理软件信息； 自由选择系统默认为静态HTML或动态A」· ASP 代码 · 共 577 行 · 第 1/2 页

		End If

		If n - CurrentPage < 1 Then
			strTemp = strTemp & "下一页 尾页"
		Else
			strTemp = strTemp & "<a href='" & sfilename & "page=" & (CurrentPage + 1) & "&path=" & Request("path") & "'>下一页</a>&nbsp;"
			strTemp = strTemp & "<a href='" & sfilename & "page=" & n & "&path=" & Request("path") & "'>尾页</a>"
		End If
		strTemp = strTemp & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
		strTemp = strTemp & "&nbsp;转到：<select name='page' size='1' onchange='javascript:submit()'>"
		For i = 1 To n
			strTemp = strTemp & "<option value='" & i & "'"
			If CInt(CurrentPage) = CInt(i) Then strTemp = strTemp & " selected "
			strTemp = strTemp & ">第" & i & "页</option>"
		Next
		strTemp = strTemp & "</select>"
		strTemp = strTemp & "</td></tr></form></table>"
		Response.Write strTemp
	End Sub
	'*******************************************
	'过程作用：编辑文件
	'*******************************************
	Sub EditFile()
		Dim filename, FileText, FileHTML
		Dim objFSO, objCountFile
		filename = Request("FileName")
		FileHTML = Request.Form("HTML")
		On Error Resume Next
		Set objFSO = Server.CreateObject(Newasp.Script_FSO)
		If Request("stype") = "save" Then
			Set FSO = CreateObject(Newasp.Script_FSO)
			Set f = FSO.OpenTextFile(Server.MapPath(filename), 2, True)
			f.Write FileHTML
			f.Close
			Set FSO = Nothing
			Set f = Nothing
			Response.Write "<script>opener.window.location.reload()</script>"
			Response.Write "<meta http-equiv='refresh' content='0;URL=javascript:window.close()'>"
		ElseIf Request("stype") = "edit" Then
			If objFSO.FileExists(Server.MapPath(filename)) Then
				Set FSO = CreateObject(Newasp.Script_FSO)
				Set f = FSO.OpenTextFile(Server.MapPath(filename), 1, True)
				FileText = f.ReadAll
				f.Close
				Set FSO = Nothing
				Set f = Nothing
			Else
				ErrMsg = ErrMsg & "发生错误，文件已经被删除或者损坏！"
				Founderr = True
				Exit Sub
			End If
			Response.Write "<table width=""96%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""1"" class=""tableBorder"">" & vbCrLf
			Response.Write "<tr><th height=""22"">在线编辑" & filename & " </th></tr>" & vbCrLf
			Response.Write "<form name=""form1"" method=""post"" action=""admin_filemanage.asp?action=edit&stype=save"">" & vbCrLf
			Response.Write "<td width=""80%"" align=""center"" class=""forumRow"">" & vbCrLf
			Response.Write "<textarea id=""FileText"" name=""html"" style=""width:100%;"" rows=""20"">" & Server.HTMLEncode(FileText) & "</textarea>" & vbCrLf
			Response.Write "<input type=""hidden"" name=""FileName"" value=""" & filename & """>" & vbCrLf
			Response.Write "    <br>" & vbCrLf
			Response.Write "    <input type=""button"" name=""Submit1"" value=""关闭窗口"" class=""button"" onClick=""window.close()"">　 " & vbCrLf
			Response.Write "    <input type=""reset"" name=""Submit2"" value=""重 置"" class=""button"">　 " & vbCrLf
			Response.Write "    <input type=""submit"" name=""Submit"" value=""保存文件"" class=""button"" onclick=""{if(confirm('您确定要保存文件么？\n此操作不可恢复！')){this.document.form1.submit();return true;}return false;}"">　 " & vbCrLf
			Response.Write "    <a href=""javascript:admin_Size(-20,'Thtml')""><img src=""images/minus.gif"" unselectable=""on"" border='0'></a> <a href=""javascript:admin_Size(20,'Thtml')""><img src=""images/plus.gif"" unselectable=""on"" border='0'></a>" & vbCrLf
			Response.Write "（<font color=#808080>操作前最好先备份文件!</font>）</td></form>" & vbCrLf
			Response.Write "</tr>" & vbCrLf
			Response.Write "</table>" & vbCrLf
		End If
	End Sub
	'*******************************************
	'函数作用：格式化文件的大小
	'*******************************************
	Function GetFileSize(Size)
		Dim FileSize
		FileSize = Size / 1024
		FileSize = FormatNumber(FileSize, 2)
		If FileSize < 1024 And FileSize > 1 Then
			GetFileSize = "<font color=red>" & FileSize & "</font>&nbsp;KB"
		ElseIf FileSize > 1024 Then
			GetFileSize = "<font color=red>" & FormatNumber(FileSize / 1024, 2) & "</font>&nbsp;MB"
		Else
			GetFileSize = "<font color=red>" & Size & "</font>&nbsp;Bytes"
		End If
	End Function
	'*******************************************
	'函数作用：取得文件的后缀名
	'*******************************************
	Function GetExtensionName(Name)
		Dim filename
		filename = Split(Name, ".")
		GetExtensionName = filename(UBound(filename))
	End Function
	'*******************************************
	'函数作用：返回文件类型
	'*******************************************
	Function GetFileIcon(Name)
		Dim filename, Icon
		filename = LCase(GetExtensionName(Name))
		Select Case filename
			Case "asp"
				Icon = "asp.gif"
			Case "bmp"
				Icon = "bmp.gif"
			Case "doc"
				Icon = "doc.gif"
			Case "exe"
				Icon = "exe.gif"
			Case "gif"
				Icon = "gif.gif"
			Case "jpg"
				Icon = "jpg.gif"
			Case "chm"
				Icon = "chm.gif"
			Case "htm", "html"
				Icon = "htm.gif"
			Case "log"
				Icon = "log.gif"
			Case "mdb"
				Icon = "mdb.gif"
			Case "swf"
				Icon = "swf.gif"
			Case "txt"
				Icon = "txt.gif"
			Case "wav"
				Icon = "wav.gif"
			Case "xls"
				Icon = "xls.gif"
			Case "rar", "zip"
				Icon = "zip.gif"
			Case "css"
				Icon = "css.gif"
			Case Else
				Icon = "none.gif"
		End Select
		GetFileIcon = Icon
	End Function
	'*******************************************
	'过程作用：删除选定的文件或文件夹
	'*******************************************
	Sub DelAll()
		Dim FolderId, FileId, ThisDir, FileNum, FolderNum, FilePath, FolderPath
		FolderId = Split(Request.Form("FolderId"), ",")
		FileId = Split(Request.Form("FileId"), ",")
		ThisDir = Trim(Request.Form("ThisDir"))
		FileNum = 0
		FolderNum = 0
		If UBound(FolderId) <> -1 Then '删除文件夹
			For i = 0 To UBound(FolderId)
				FolderPath = Server.MapPath(ThisDir & Trim(FolderId(i)))
				If FSO.FolderExists(FolderPath) Then
					FSO.DeleteFolder FolderPath, True
					FolderNum = FolderNum + 1
				End If
			Next
		End If
		If UBound(FileId) <> -1 Then '删除文件
			For j = 0 To UBound(FileId)
				FilePath = Server.MapPath(ThisDir & Trim(FileId(j)))
				If FSO.FileExists(FilePath) Then
					FSO.DeleteFile FilePath, True
					FileNum = FileNum + 1
				End If
			Next
		End If
		Response.redirect (Request.ServerVariables("HTTP_REFERER"))
	End Sub
	'*******************************************
	'过程作用：使选定的文件或文件夹改名
	'*******************************************
	Sub rename()
		Dim ThisDir, NewName, OldName, NewName1
		Set FSO = Server.CreateObject(Newasp.Script_FSO)
		ThisDir = Trim(Request.Form("ThisDir"))
		FolderName = Trim(Request.Form("FolderName"))
		filename = Trim(Request.Form("FileName"))
		If Len(Trim(Request.Form("NewName"))) = 0 Then
			ErrMsg = "<li>请输入文件或文件夹名称！</li>"
			Founderr = True
			Exit Sub
		Else
			NewName = Trim(Request.Form("NewName"))
		End If
		On Error Resume Next
		Set FSO = Server.CreateObject(Newasp.Script_FSO)
		If Len(FolderName) <> 0 Then '文件夹改名
			NewName1 = Server.MapPath(ThisDir & NewName)
			OldName = Server.MapPath(ThisDir & FolderName)
			If Not FSO.FolderExists(NewName1) Then
				FSO.MoveFolder OldName, NewName1
				Response.redirect (Request.ServerVariables("HTTP_REFERER"))
			Else
				ErrMsg = ErrMsg & "<li>有同名文件夹，请换个文件夹名</li>"
				Founderr = True
				Exit Sub
			End If
		End If
		If Len(filename) <> 0 Then '文件改名
			NewName1 = Server.MapPath(ThisDir & NewName)
			OldName = Server.MapPath(ThisDir & filename)
			If Not FSO.FileExists(NewName1) Then
				FSO.MoveFile OldName, NewName1
				Response.redirect (Request.ServerVariables("HTTP_REFERER"))
			Else
				ErrMsg = ErrMsg & "<li>有同名文件，请换个文件名</li>"
				Founderr = True
			End If
		End If
		FSO.Close
		Set FSO = Nothing
	End Sub
	'*******************************************
	'过程作用：新建文件
	'*******************************************
	Sub CreateNewFile()
		Dim NewFile, NewFilePath, FsoFile, NewFileDir
		NewFileDir = Trim(Request.Form("ThisDir"))
		If Len(Trim(Request.Form("CreateName"))) = 0 Then
			ErrMsg = "<li>请输入文件夹名称！</li>"
			Founderr = True
			Exit Sub
		Else
			NewFile = Trim(Request.Form("CreateName"))
		End If
		NewFile = Trim(Request.Form("CreateName"))
		NewFilePath = Server.MapPath(NewFileDir & NewFile)
		Set FSO = Server.CreateObject(Newasp.Script_FSO)
		If Not FSO.FileExists(NewFilePath) And Not FSO.FolderExists(NewFilePath) Then
			Set FsoFile = FSO.CreateTextFile(NewFilePath)
			FsoFile.WriteLine
			FsoFile.Close
			Set FsoFile = Nothing
			Set FSO = Nothing
			Response.redirect (Request.ServerVariables("HTTP_REFERER"))
		Else
			ErrMsg = ErrMsg & "<li>有同名文件，请换个文件名</li>"
			Founderr = True
		End If
	End Sub
	'*******************************************
	'过程作用：新建文件夹
	'*******************************************
	Sub CreateNewFolder()
		Dim NewFolder, NewFolderPath, objFSO
		NewFolderPath = Trim(Request.Form("ThisDir"))
		If Len(Trim(Request.Form("CreateName"))) = 0 Then
			ErrMsg = "<li>请输入文件夹名称！</li>"
			Founderr = True
			Exit Sub
		Else
			NewFolder = Trim(Request.Form("CreateName"))
		End If
		NewFolderPath = Server.MapPath(NewFolderPath & NewFolder)
		On Error Resume Next
		Set objFSO = Server.CreateObject(Newasp.Script_FSO)
		If Not objFSO.FolderExists(NewFolderPath) Then
			objFSO.CreateFolder (NewFolderPath)
			Response.redirect (Request.ServerVariables("HTTP_REFERER"))
		Else
			ErrMsg = ErrMsg & "<li>有同名文件夹，请换个文件夹名</li>"
			Founderr = True
		End If
		objFSO.Close
		Set objFSO = Nothing
	End Sub
	'*******************************************
	'函数作用：在文件名后加上字符串连接
	'*******************************************
	Function JoinChar(strUrl)
		If strUrl = "" Then
			JoinChar = ""
			Exit Function
		End If
		If InStr(strUrl, "?") < Len(strUrl) Then
			If InStr(strUrl, "?") > 1 Then
				If InStr(strUrl, "&") < Len(strUrl) Then
					JoinChar = strUrl & "&"
				Else
					JoinChar = strUrl
				End If
			Else
				JoinChar = strUrl & "?"
			End If
		Else
			JoinChar = strUrl
		End If
	End Function

End Class
%>