📄 admin_filemanage.asp

📁 大型黄页系统,精美黄页flash演示,10m
💻 ASP
📖 第 1 页 / 共 2 页
字号:
上一页 12
'*******************************************

Sub EditFile()
	Dim filename, FileText, FileHTML
	Dim objFSO, objCountFile
	filename = Request("FileName")
	FileHTML = Request.Form("HTML")
	On Error Resume Next
	Set objFSO = Server.CreateObject(DownsysClass.Script_FSO)
	If Request("stype") = "save" Then
		Set FSO = CreateObject(DownsysClass.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(DownsysClass.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(DownsysClass.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(DownsysClass.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(DownsysClass.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(DownsysClass.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
%>
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -