📄 aspcheck.asp
字号:
<%@ Language="VBScript" CODEPAGE="936"%>
<% Option Explicit %>
<%
Response.Buffer = True
'####################################
'# #
'# ITlearner ASP探针 V1.1 #
'# #
'# http://www.itlearner.com #
'# #
'# 转载本程序时请保留这些信息 #
'# #
'####################################
Dim startime
startime=timer()
Dim hx
Set hx = New Cls_AspCheck
class Cls_AspCheck
Public FileName,WebName,WebUrl,SysName,SysNameE,SysVersion
'检查组件是否被支持
Public Function IsObjInstalled(strClassString)
On Error Resume Next
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If Err Then
IsObjInstalled = False
else
IsObjInstalled = True
end if
Set xTestObj = Nothing
End Function
'检查组件版本
Public Function getver(Classstr)
On Error Resume Next
Dim xTestObj
Set xTestObj = Server.CreateObject(Classstr)
If Err Then
getver=""
else
getver=xTestObj.version
end if
Set xTestObj = Nothing
End Function
Public Function ShowPicBar(Speed)
Dim Outstr
if Speed > 8000 then Speed=8000
Outstr = "<td><img align=absmiddle class=PicBar width='"&formatnumber(Speed/100,0)&"%'> "
Outstr = Outstr & Speed & " Kbps"
Outstr = Outstr & "</td><td>"
Outstr = Outstr & " "&formatnumber(Speed/8,1)&" k/s</td>"
Response.Write(Outstr)
End Function
Public Function GetObjInfo(startnum,endnum)
dim i,Outstr
for i=startnum to endnum
Outstr = Outstr & "<tr bgcolor=#FFFFFF align=center height=18><TD align=left> " & theTestObj(i,0) & ""
Outstr = Outstr & "<font color=#888888> "&theTestObj(i,1)&"</font>"
Outstr = Outstr & "</td>"
If Not IsObjInstalled(theTestObj(i,0)) Then
Outstr = Outstr & "<td align=left> <font color=red><b>×</b></font></td>"
Else
Outstr = Outstr & "<td align=left> <font color=green><b>√</b></font> " & getver(theTestObj(i,0)) & "</td>"
End If
Outstr = Outstr & "</tr>" & vbCrLf
next
Response.Write(Outstr)
End Function
Public Function cdrivetype(tnum)
Select Case tnum
Case 0: cdrivetype = "未知"
Case 1: cdrivetype = "可移动磁盘"
Case 2: cdrivetype = "本地硬盘"
Case 3: cdrivetype = "网络磁盘"
Case 4: cdrivetype = "CD-ROM"
Case 5: cdrivetype = "RAM 磁盘"
End Select
end function
Private Sub Class_Initialize()
WebName="IT学习者"
WebUrl="http://www.itlearner.com"
SysName="ASP探针"
SysNameE="AspCheck"
SysVersion="V1.1"
FileName=Request.ServerVariables("SCRIPT_NAME")
End Sub
Public Function dtype(num)
Select Case num
Case 0: dtype = "未知"
Case 1: dtype = "可移动磁盘"
Case 2: dtype = "本地硬盘"
Case 3: dtype = "网络磁盘"
Case 4: dtype = "CD-ROM"
Case 5: dtype = "RAM 磁盘"
End Select
End Function
Public Function formatdsize(dsize)
if dsize>=1073741824 then
formatdsize=Formatnumber(dsize/1073741824,2) & " GB"
elseif dsize>=1048576 then
formatdsize=Formatnumber(dsize/1048576,2) & " MB"
elseif dsize>=1024 then
formatdsize=Formatnumber(dsize/1024,2) & " KB"
else
formatdsize=dsize & "B"
end if
End Function
Public Sub ShowFooter()
dim Endtime,Runtime,OutStr
Endtime=timer()
OutStr = "<table border=0 cellpadding=0 cellspacing=1 class=tableBorder><tr><td align=center>"
OutStr = OutStr & "<br><p>此程序是<a href=http://www.itlearner.com target=_blank>ITlearner</a>以<a href=http://www.ajiang.net target=_blank>Ajiang</a>和<a href=http://www.ccopus.com/ target=_blank>COCOON</a>的ASP探针的代码为原型，结合部分自已原创的代码精心编写而成。</p>"
OutStr = OutStr & "<p>欢迎访问<a href=http://www.itlearner.com title=IT学习者之家 target=_blank>★IT学习者★</a>，<a href=http://www.itlearner.com/aspcheck/ target=_blank>下载最新版程序</a><br>" & vbcrlf
Runtime=FormatNumber((endtime-startime)*1000,2)
if Runtime>0 then
if Runtime>1000 then
OutStr = OutStr & "页面执行时间：约"& FormatNumber(runtime/1000,2) & "秒"
else
OutStr = OutStr & "页面执行时间：约"& Runtime & "毫秒"
end if
end if
OutStr = OutStr & " "
OutStr = OutStr & "<a href='http://www.it" + "learner.com/aspcheck/' target='_blank'>ITlearner AspCheck " & SysVersion & "</a>"
OutStr = OutStr & "</p></td></tr></table>"
Response.Write(OutStr)
End Sub
End class
Dim theTestObj(25,1)
theTestObj(0,0) = "MSWC.AdRotator"
theTestObj(1,0) = "MSWC.BrowserType"
theTestObj(2,0) = "MSWC.NextLink"
theTestObj(3,0) = "MSWC.Tools"
theTestObj(4,0) = "MSWC.Status"
theTestObj(5,0) = "MSWC.Counters"
theTestObj(6,0) = "MSWC.PermissionChecker"
theTestObj(7,0) = "WScript.Shell"
theTestObj(8,0) = "CDONTS.NewMail"
theTestObj(8,1) = "(虚拟 SMTP 发信)"
theTestObj(9,0) = "Scripting.FileSystemObject"
theTestObj(9,1) = "(FSO 文本文件读写)"
theTestObj(10,0) = "ADODB.Connection"
theTestObj(10,1) = "(ADO 数据对象)"
theTestObj(11,0) = "SoftArtisans.FileUp"
theTestObj(11,1) = "(SA-FileUp 文件上传)"
theTestObj(12,0) = "SoftArtisans.FileManager"
theTestObj(12,1) = "(SoftArtisans 文件管理)"
theTestObj(13,0) = "LyfUpload.UploadFile"
theTestObj(13,1) = "(刘云峰的文件上传组件)"
theTestObj(14,0) = "Persits.Upload.1"
theTestObj(14,1) = "(ASPUpload 文件上传)"
theTestObj(15,0) = "w3.upload"
theTestObj(15,1) = "(Dimac 文件上传)"
theTestObj(16,0) = "JMail.SmtpMail"
theTestObj(16,1) = "(Dimac JMail 邮件收发)</a>"
theTestObj(17,0) = "CDONTS.NewMail"
theTestObj(17,1) = "(虚拟 SMTP 发信)"
theTestObj(18,0) = "Persits.MailSender"
theTestObj(18,1) = "(ASPemail 发信)"
theTestObj(19,0) = "SMTPsvg.Mailer"
theTestObj(19,1) = "(ASPmail 发信)"
theTestObj(20,0) = "DkQmail.Qmail"
theTestObj(20,1) = "(dkQmail 发信)"
theTestObj(21,0) = "Geocel.Mailer"
theTestObj(21,1) = "(Geocel 发信)"
theTestObj(22,0) = "IISmail.Iismail.1"
theTestObj(22,1) = "(IISmail 发信)"
theTestObj(23,0) = "SmtpMail.SmtpMail.1"
theTestObj(23,1) = "(SmtpMail 发信)"
theTestObj(24,0) = "SoftArtisans.ImageGen"
theTestObj(24,1) = "(SA 的图像读写组件)"
theTestObj(25,0) = "W3Image.Image"
theTestObj(25,1) = "(Dimac 的图像读写组件)"
dim action
action=request("action")
%>
<HTML>
<HEAD>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<TITLE>IT学习者ASP探针(AspCheck)<%=hx.SysVersion%>－www.ITlearner.com</TITLE>
<style>
<!--
A { COLOR: #000000; TEXT-DECORATION: none}
A:hover { COLOR: green}
body,td,span { font-size: 9pt}
.input { BACKGROUND-COLOR: #ffffff;BORDER:#0099CF 1px solid;FONT-SIZE: 9pt}
.backc { BACKGROUND-COLOR: #0099CF;BORDER:#0099CF 1px solid;FONT-SIZE: 9pt;color:white}
.PicBar { background-color: #0099CF; border: 1px solid #000000; height: 12px;}
.tableBorder {
BORDER-RIGHT: #183789 1px solid; BORDER-TOP: #183789 1px solid; BORDER-LEFT: #183789 1px solid; BORDER-BOTTOM: #183789 1px solid; BACKGROUND-COLOR: #ffffff; WIDTH: 600;
}
-->
</STYLE>
<SCRIPT language="JavaScript" runat="server">
function getEngVerJs(){
return ScriptEngineMajorVersion() +"."+ScriptEngineMinorVersion()+"."+ ScriptEngineBuildVersion() + " ";
}
</SCRIPT>
<SCRIPT language="VBScript" runat="server">
Function getEngVerVBS()
getEngVerVBS=ScriptEngineMajorVersion() &"."&ScriptEngineMinorVersion() &"." & ScriptEngineBuildVersion() & " "
End Function
</SCRIPT>
<script language="javascript">
<!--
function Checksearchbox()
{
if(form1.classname.value == "")
{
alert("请输入你要检测的组件名！");
form1.classname.focus();
return false;
}
}
function showsubmenu(sid)
{
whichEl = eval("submenu" + sid);
if (whichEl.style.display == "none")
{
eval("submenu" + sid + ".style.display=\"\";");
eval("txt" + sid + ".innerHTML=\"<a href='' title='关闭此项'><font face='Wingdings' color=#FFFFFF>x</font></a>\";");
}
else
{
eval("submenu" + sid + ".style.display=\"none\";");
eval("txt" + sid + ".innerHTML=\"<a href='' title='打开此项'><font face='Wingdings' color=#FFFFFF>y</font></a>\";");
}
}
-->
</SCRIPT>
</HEAD>
<BODY leftmargin="50">
<a name=top></a>
<table width="600" border="0" cellpadding="0" cellspacing="0">
<tr>
<td align="center"><p><font size="6"><strong><a href="http://www.itlearner.com/aspcheck/" target="_blank">ASP
探针</a></strong></font> - V1.1(<a href="http://www.itlearner.com" target="_blank">ITlearner</a>)</p>
</td>
</tr>
</table>
<br>
<%
if request("action")="testzujian" then
call ObjTest2
end if
Call menu
Call SystemTest
Call ObjTest
Call CalculateTest
Call DriveTest
Call SpeedTest
hx.ShowFooter
Set hx= nothing
%>
<%Sub menu%>
选项：<a href="#SystemTest">服务器有关参数</a> | <a href="#ObjTest">服务器组件情况</a> | <a href="#CalcuateTest">服务器运算能力</a>
| <a href="#DriveTest">服务器磁盘信息</a> | <a href="#SpeedTest">服务器连接速度</a>
<%End Sub%>
<%Sub smenu(i)%>
<a href="#top" title="返回顶部"><font face='Webdings' color=#FFFFFF>5</font></a> <span id=txt<%=i%> name=txt<%=i%>><a href='' title='关闭此项'><font face='Wingdings' color=#FFFFFF>x</font></a></span>
<%End Sub%>
<%Sub SystemTest%>
<a name="SystemTest"></a>
<table border="0" cellpadding="0" cellspacing="1" class="tableBorder">
<tr>
<td height="25" align="center" bgcolor="#0099CF" onclick="showsubmenu(0)"><font color=#FFFFFF><strong>服务器有关参数</strong></font>
<%Call smenu(0)%></td>
</tr>
<tr>
<td style="display" id='submenu0'><table border=0 width=100% cellspacing=1 cellpadding=3 bgcolor="#0099CF">
<tr bgcolor="#FFFFFF" height=18>
<td width="130" align=left> 服务器名</td>
<td width="170" height="18"> <%=Request.ServerVariables("SERVER_NAME")%></td>
<td width="130" height="18"> 服务器操作系统</td>
<td width="170" height="18"><%=Request.ServerVariables("OS")%></td>
</tr>
<tr bgcolor="#FFFFFF" height=18>
<td align=left> 服务器IP</td>
<td height="18"> <%=Request.ServerVariables("LOCAL_ADDR")%></td>
<td height="18"> 服务器端口</td>
<td height="18"><%=Request.ServerVariables("SERVER_PORT")%></td>
</tr>
<tr bgcolor="#FFFFFF" height=18>
<td align=left> 服务器时间</td>
<td height="18"> <%=now%></td>
<td height="18"> 服务器CPU数量</td>
<td height="18"><%=Request.ServerVariables("NUMBER_OF_PROCESSORS")%>
个</td>
</tr>
<tr bgcolor="#FFFFFF" height=18>
<td align=left> IIS版本</td>
<td height="18"> <%=Request.ServerVariables("SERVER_SOFTWARE")%></td>
<td height="18"> 脚本超时时间</td>
<td height="18"><%=Server.ScriptTimeout%> 秒</td>
</tr>
<tr bgcolor="#FFFFFF" height=18>
<td align=left> Application变量数</td>
<td height="18"> <%=Application.Contents.Count%>个
<%if Application.Contents.count>0 then response.write "[<a href=""?action=showapp"">遍历Application变量</a>]"%>
</td>
<td height="18"> Session变量数<br> </td>
<td height="18"><%=Session.Contents.Count%>个
<%if Session.Contents.count>0 then response.write "[<a href=""?action=showsession"">遍历Session变量</a>]"%>
</td>
</tr>
<tr bgcolor="#FFFFFF" height=18>
<td height="18" align=left> <a href="?action=showvariables">所有服务器参数</a></td>
<td height="18" align=left> <%=Request.ServerVariables.Count%>个
<%if Request.ServerVariables.Count>0 then response.write "[<a href=""?action=showvariables"">遍历服务器参数</a>]"%>
</td>
<td height="18" align=left> </td>
<td height="18" align=left> </td>
</tr>
<tr bgcolor="#FFFFFF" height=18>
<td align=left> 服务器解译引擎</td>
<td height="18" colspan="3"> JScript: <%= getEngVerJs() %> | VBScript:
<%=getEngVerVBS()%></td>
</tr>
<tr bgcolor="#FFFFFF" height=18>
<td align=left bgcolor="#FFFFFF"> 本文件实际路径</td>
<td height="8" colspan="3" bgcolor="#FFFFFF"> <%=server.mappath(Request.ServerVariables("SCRIPT_NAME"))%></td>
</tr>
</table>
<%
if action="showapp" or action="showsession" or action="showvariables" then
showvariable(action)
end if
%>
</td>
</tr>
</table>
<br>
<%
End Sub
Sub showvariable(action)
%>
<table width="100%" border="0" cellpadding="3" cellspacing="1" bgcolor="#0099CC">
<tr bgcolor="#99CCFF">
<td colspan="2">
<%
if action="showapp" then
Response.Write("■ 遍历Application变量")
elseif action="showsession" then
Response.Write("■ 遍历Session变量")
elseif action="showvariables" then
Response.Write("■ 遍历服务器参数")
end if
Response.Write "(<a href="&hx.FileName&">关闭</a>)"
%>
</td>
</tr>
<tr bgcolor="#FFFFFF">
<td width="130">变量名</td>
<td width="470">值</td>
</tr>
<%
on error resume next
dim thing,xTestObj
if action="showapp" then
set xTestObj=Application.Contents
elseif action="showsession" then
set xTestObj=Session.Contents
elseif action="showvariables" then
set xTestObj=Request.ServerVariables
end if
if err then
Response.Write "<tr bgcolor=#FFFFFF><td colspan=2>没有符合条件的变量</td></tr>"
else
for each thing in xTestObj
Response.Write "<tr bgcolor=#FFFFFF>"
Response.Write "<td>" & thing & "</td>"
Response.Write "<td>" & xTestObj(thing) & "</td>"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -