下面代码是Asp探针
aspCheck.asp
<
%@ Language
=
"
VBScript
"
CODEPAGE
=
"
936
"
%
>
< % Option Explicit % >
< %
Response.Buffer = True
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 GetObjInfo(startnum,endnum)
dim i,Outstr
for i = startnum to endnum
Outstr = Outstr & " <tr class=""item_tr1""><td> " & theTestObj(i, 0 ) & ""
if theTestObj(i, 1 ) <> "" then Outstr = Outstr & " <span class=""font_1""> " & theTestObj(i, 1 ) & " </span> "
Outstr = Outstr & " </td> "
If Not IsObjInstalled(theTestObj(i, 0 )) Then
Outstr = Outstr & " <td><span class=""font_2""><b>×</b></span></td> "
Else
Outstr = Outstr & " <td><span class=""font_3""><b>√</b></span> " & getver(theTestObj(i, 0 )) & " </td> "
End If
Outstr = Outstr & " </tr> " & vbCrLf
next
Response.Write(Outstr)
End Function
Private Sub Class_Initialize()
WebName = " IT学习者 "
WebUrl = " http://www.itlearner.com "
SysName = " ASP探针 "
SysNameE = " AspCheck "
SysVersion = " V1.3 "
FileName = Request.ServerVariables( " SCRIPT_NAME " )
if InStr (FileName, " / " ) then FileName = right (FileName, len (FileName) - InStrRev (FileName, " / " ))
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 Function formatvariables(str)
on error resume next
str = cstr (server.htmlencode(str))
formatvariables = replace (str, chr ( 10 ), " <br> " )
End Function
Public Sub ShowFooter()
dim Endtime,Runtime,OutStr
Endtime = timer ()
OutStr = " <div id=""bottom""> "
OutStr = OutStr & " <p>此程序是<a href=""http://www.itlearner.com"" target=""_blank"">ITlearner</a>以<a href=""http://www.itlearner.com/page/show/4577.htm"" target=""_blank"">Ajiang</a>和<a href=""http://www.itlearner.com/page/show/4580.htm"" target=""_blank"">COCOON</a>的ASP探针的代码为原型,结合部分自已原创的代码精心编写而成。</p> "
OutStr = OutStr & " <p>欢迎访问★<a href=""http://www.itlearner.com"" 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></div> "
Response.Write(OutStr)
End Sub
Public Function getEngVerVBS()
getEngVerVBS = ScriptEngineMajorVersion () & " . " & ScriptEngineMinorVersion () & " . " & ScriptEngineBuildVersion () & " "
End Function
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 ) = " Microsoft.XMLHTTP "
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.ImageGen "
theTestObj( 12 , 1 ) = " (SA 的图像读写组件) "
theTestObj( 13 , 0 ) = " LyfUpload.UploadFile "
theTestObj( 13 , 1 ) = " (刘云峰的文件上传组件) "
theTestObj( 14 , 0 ) = " Persits.Upload "
theTestObj( 14 , 1 ) = " (ASPUpload 文件上传) "
theTestObj( 15 , 0 ) = " w3.upload "
theTestObj( 15 , 1 ) = " (Dimac 文件上传) "
theTestObj( 16 , 0 ) = " JMail.SmtpMail "
theTestObj( 16 , 1 ) = " (Dimac JMail 邮件收发) "
theTestObj( 17 , 0 ) = " CDONTS.NewMail "
theTestObj( 17 , 1 ) = " (虚拟 SMTP 发信) "
theTestObj( 18 , 0 ) = " Persits.MailSender "
theTestObj( 18 , 1 ) = " (ASPemail 发信) "
theTestObj( 19 , 0 ) = " SmtpMail.SmtpMail.1 "
theTestObj( 19 , 1 ) = " (SmtpMail 发信) "
theTestObj( 20 , 0 ) = " PE_Common.Site "
theTestObj( 20 , 1 ) = " (动易2005组件) "
% >
< !DOCTYPE HTML PUBLIC " -//W3C//DTD HTML 4.0 Transitional//EN " >
< html >
< head >
< meta http - equiv = " Content-Type " content = " text/html; charset=gb2312 " >
< title > ASP探针 </ title >
< style type = " text/css " >
< ! --
body {font - size:12px;margin - left :50px;background:#FFF;line - height: 1.5 ;font - family:宋体,arial;color:# 000 ;}
td,span {font - size:12px;word - break:break - all;word - wrap:break - word;line - height: 1.2 ;}
form {margin: 0 ;}
#top {width:600px;margin:8px 0 ;text - align:center;}
#bottom {border:1px dotted # 183789 ;width:600px;margin - top:10px;text - align:center;padding:5px 0 ;}
h3 {font - size:30px;margin: 0 ;}
h3 sub {font - size:14px;font - weight:normal;}
a {color:# 000 ; text - decoration:none}
a:hover {color:#F00;}
.input {border:1px solid #0099CF;}
.btn_c {background:#0099CF;border:1px solid #0099CF;color:#FFF;font - size:12px;}
.PicBar {background:#0099CF;border:1px solid # 000 ;height:12px;vertical - align:middle;}
#txt_speed{position:absolute;height:30px;z - index: 1000 ;}
.frame_box{border: 0 ;width:600px;margin - top:5px;}
.item_title_head{font - weight:bold;}
.item_title{background:#0099CF;text - align:center;color:#FFF;padding:3px;}
.item_title a{color:#FFF;}
.item_title_other{cursor:hand;}
.item_content{width:600px;}
.item_content_head{background:#9CF;text - indent:12px;}
.item_tr1{text - indent:8px;background:#FFF;}
.item_tr2{text - align:center;background:#FFF;height:18px;}
.font_1{color:# 888 ;}
.font_2{color:# 080 ;}
.font_3{color:#F00;}
-->
</ style >
< script language = " JavaScript " runat = " server " >
function getEngVerJs(){
try{
return ScriptEngineMajorVersion () + " . " + ScriptEngineMinorVersion () + " . " + ScriptEngineBuildVersion () + " " ;
}catch(e){
return " 服务器不支持此项检测 " ;
}
}
</ script >
< script language = " JavaScript " type = " text/javascript " >
< ! --
function Checksearchbox(form1){
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= " < span title = ' 关闭此项'>x</span>";");
}
else
{
eval ( " submenu " + sid + " .style.display= " none " ; " );
eval ( " txt " + sid + " .innerHTML= " < span title = ' 打开此项'>y</span>";");
}
}
-->
</ script >
</ head >
< body >
< a name = " top " ></ a >
< div id = " top " >
< h3 >< a href = " <%=hx.FileName%> " > ASP探针 </ a ></ h3 >
</ div >
< %
dim action
action = request( " action " )
select case action
case " Custom_ObjInfo "
Call menu2
% >< div class = " frame_box " >< % Call Custom_ObjInfo% ></ div >
< %Response.End
case " SystemCheck "
Call menu2
Call SystemCheck
end select
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 >< br >
安全: < a href = " ?action=SystemCheck " > 系统用户(组)和进程检测 </ a >< br >
< % End Sub
Sub menu2
Response.Write " <p>返回<a href="" " & hx.FileName & " "">主界面</a></p> "
End Sub
Sub GoTop
Response.Write " <a href=""#top"" title=""返回顶部""><font face=""Webdings"">5</font></a> "
End Sub
% >
< % Sub smenu(i)% >
< font face = " Wingdings " >< span class = " item_title_other " onClick = " showsubmenu(<%=i%>) " id = " txt<%=i%> " >< span title = " 关闭此项 " > x </ span ></ span ></ font >
< % End Sub % >
< % Sub SystemTest
on error resume next
% >
< a name = " SystemTest " ></ a >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 服务器有关参数 </ span >< % Call GoTop% >
< % Call smenu( 0 )% >
</ div >
< div class = " item_content " id = ' submenu0'>
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_tr1 " >
< td width = " 110 " > 服务器名 </ td >
< td width = " 185 " >< % = Request.ServerVariables( " SERVER_NAME " )% ></ td >
< td width = " 110 " > 服务器操作系统 </ td >
< td width = " 185 " >< % = Request.ServerVariables( " OS " )% ></ td >
</ tr >
< tr class = " item_tr1 " >
< td > 服务器IP </ td >
< td >< % = Request.ServerVariables( " LOCAL_ADDR " )% ></ td >
< td > 服务器端口 </ td >
< td >< % = Request.ServerVariables( " SERVER_PORT " )% ></ td >
</ tr >
< tr class = " item_tr1 " >
< td > 服务器时间 </ td >
< td >< % = now % ></ td >
< td > 服务器CPU数量 </ td >
< td >< % = Request.ServerVariables( " NUMBER_OF_PROCESSORS " )% >
个 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > IIS版本 </ td >
< td >< % = Request.ServerVariables( " SERVER_SOFTWARE " )% ></ td >
< td > 脚本超时时间 </ td >
< td >< % = Server.ScriptTimeout% > 秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > Application变量 </ td >
< td >< %Response.Write(Application.Contents.Count & " 个 " )
if Application.Contents.count > 0 then Response.Write( " [<a href=""?action=showapp"">遍历Application变量</a>] " )% >
</ td >
< td > Session变量 </ td >
< td >< %Response.Write(Session.Contents.Count & " 个 " )
if Session.Contents.count > 0 then Response.Write( " [<a href=""?action=showsession"">遍历Session变量</a>] " )% >
</ td >
</ tr >
< tr class = " item_tr1 " >
< td >< a href = " ?action=showvariables " > 所有服务器参数 </ a ></ td >
< td >< %Response.Write(Request.ServerVariables.Count & " 个 " )
if Request.ServerVariables.Count > 0 then Response.Write( " [<a href=""?action=showvariables"">遍历服务器参数</a>] " )% >
</ td >
< td > 服务器环境变量 </ td >
< td >< %
dim WshShell,WshSysEnv
Set WshShell = server.CreateObject( " WScript.Shell " )
Set WshSysEnv = WshShell.Environment
if err then
Response.Write( " 服务器不支持WScript.Shell组件 " )
err.clear
else
Response.Write(WshSysEnv.count & " 个 " )
if WshSysEnv.count > 0 then Response.Write( " [<a href=""?action=showwsh"">遍历环境变量</a>] " )
end if
% >
</ td >
</ tr >
< tr class = " item_tr1 " >
< td > 服务器解译引擎 </ td >
< td colspan = " 3 " > JScript: < % = getEngVerJs() % > | VBScript: < % = hx.getEngVerVBS()% ></ td >
</ tr >
< tr class = " item_tr1 " >
< td > 本文件实际路径 </ td >
< td colspan = " 3 " >< % = server.mappath(Request.ServerVariables( " SCRIPT_NAME " ))% ></ td >
</ tr >
</ table >
< %
if action = " showapp " or action = " showsession " or action = " showvariables " or action = " showwsh " then
showvariable(action)
end if
% >
</ div >
</ div >
< %
End Sub
Sub showvariable(action)
% >
< table width = " 100% " border = " 0 " cellpadding = " 3 " cellspacing = " 1 " bgcolor = " #0099CC " >
< tr class = " item_content_head " >
< td colspan = " 2 " >
< %
' on error resume next
dim Item,xTestObj,outstr
Response.Write( " <font face='Webdings'>4</font> " )
if action = " showapp " then
Response.Write( " 遍历Application变量 " )
set xTestObj = Application.Contents
elseif action = " showsession " then
Response.Write( " 遍历Session变量 " )
set xTestObj = Session.Contents
elseif action = " showvariables " then
Response.Write( " 遍历服务器参数 " )
set xTestObj = Request.ServerVariables
elseif action = " showwsh " then
Response.Write( " 遍历环境变量 " )
dim WshShell
Set WshShell = server.CreateObject( " WScript.Shell " )
set xTestObj = WshShell.Environment
end if
Response.Write " (<a href="" " & hx.FileName & " "">关闭</a>) "
% >
</ td >
</ tr >
< tr bgcolor = " #FFFFFF " >
< td width = " 125 " > 变量名 </ td >
< td width = " 470 " > 值 </ td >
</ tr >
< %
if err then
outstr = " <tr bgcolor=""#FFFFFF""><td colspan=""2"">没有符合条件的变量</td></tr> "
err.clear
else
dim w
if action = " showwsh " then
for each Item in xTestObj
w = split (Item, " = " )
outstr = outstr & " <tr bgcolor=""#FFFFFF""> "
outstr = outstr & " <td> " & w( 0 ) & " </td> "
outstr = outstr & " <td> " & w( 1 ) & " </td> "
outstr = outstr & " </tr> "
next
else
dim i
for each Item in xTestObj
outstr = outstr & " <tr bgcolor=""#FFFFFF""> "
outstr = outstr & " <td> " & Item & " </td> "
outstr = outstr & " <td> "
if IsArray (xTestObj(Item)) then
for i = 0 to ubound (xTestObj(Item)) - 1
if IsArray (xTestObj(Item)(i)) then
outstr = outstr & " 数组 " & " <br> "
else
outstr = outstr & hx.formatvariables(xTestObj(Item)(i)) & " <br> "
end if
next
else
outstr = outstr & hx.formatvariables(xTestObj(Item))
end if
outstr = outstr & " </td> "
outstr = outstr & " </tr> "
next
end if
end if
Response.Write(outstr)
set xTestObj = nothing
% >
</ table >
< % End Sub % >
< % Sub ObjTest% >
< a name = " ObjTest " ></ a >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 服务器组件情况 </ span >< % Call GoTop% >
< % Call smenu( 1 )% >
</ div >
< div class = " item_content " id = ' submenu1'>
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 2 " >< font face = ' Webdings'>4</font> IIS自带的ASP组件</td>
</ tr >
< tr class = " item_tr1 " >
< td width = " 450 " > 组 件 名 称 </ td >
< td width = " 150 " > 支持及版本 </ td >
</ tr >
< %hx.GetObjInfo 0 , 10 % >
</ table >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 2 " >< font face = ' Webdings'>4</font> 网站常用组件 </td>
</ tr >
< tr class = " item_tr1 " >
< td width = " 450 " > 组 件 名 称 </ td >
< td width = " 150 " > 支持及版本 </ td >
</ tr >
< %hx.GetObjInfo 11 , 20 % >
</ table >
< % Call Custom_ObjInfo()% >
</ div >
</ div >
< %
End Sub
Sub Custom_ObjInfo% >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td >< font face = ' Webdings'>4</font> 其他组件支持情况检测 </td>
</ tr >
< tr >
< td height = " 30 " bgcolor = " #FFFFFF " >
< form action = " ?action=Custom_ObjInfo " method = " post " >
输入你要检测的组件的ProgId或ClassId
< input class = " input " type = " text " value = "" name = " classname " size = " 40 " >
< input type = " submit " value = " 确定 " class = " btn_c " name = " submit1 " onClick = " return Checksearchbox(this.form); " >
</ form >
</ td >
</ tr >
< %
Dim strClass
strClass = Trim (Request.Form( " classname " ))
If strClass <> "" then
Response.Write " <tr><td height=""30"" bgcolor=""#FFFFFF"">您指定的组件的检查结果: "
If Not hx.IsObjInstalled(strClass) then
Response.Write " <span class=""font_3"">很遗憾,该服务器不支持 " & strclass & " 组件!</span> "
Else
Response.Write " <span class=""font_3""> "
Response.Write " 恭喜!该服务器支持 " & strclass & " 组件。 "
If hx.getver(strclass) <> "" then
Response.Write " 该组件版本是: " & hx.getver(strclass)
End if
Response.Write " </span> "
End If
Response.Write " </td></tr> "
end if
% >
</ table >
< % End Sub
Sub CalculateTest
% >< a name = " CalcuateTest " ></ a >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 服务器运算能力 </ span >< % Call GoTop% >
< % Call smenu( 2 )% >
</ div >
< div class = " item_content " id = ' submenu2'>
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 3 " >< font face = ' Webdings'>4</font> 让服务器执行50万次加法(整数运算)和20万次开方(浮点运算),记录其所使用的时间。
</ td >
</ tr >
< tr class = " item_tr2 " >
< td width = " 400 " > 可 供 参 考 的 服 务 器 列 表 </ td >
< td width = " 100 " > 整数运算 </ td >
< td width = " 100 " > 浮点运算 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > ITlearner的电脑 & nbsp; (CPU:Celeron 2G & nbsp; 内存:512M) </ td >
< td > 242.19 毫秒 </ td >
< td > 191.41 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > ITlearner的服务器 & nbsp;(CPU:P4 3 .0G(1M) 内存: 1 .5G) </ td >
< td > 187.50 毫秒 </ td >
< td > 171.88 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td >< a href = " http://union.itlearner.com " target = " _blank " > 中国频道虚拟主机 </ a >& nbsp; [ 2005 / 08 / 08 ] </ td >
< td > 375.00 毫秒 </ td >
< td > 328.13 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td >< a href = " http://flash.itlearner.com " target = " _blank " > 东南数据虚拟主机 </ a >& nbsp; [ 2005 / 08 / 08 ] </ td >
< td > 343.75 毫秒 </ td >
< td > 312.50 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td >< a href = " http://www.iva.cn " target = " _blank " > 伊瓦科技虚拟主机 </ a >& nbsp; [ 2005 / 08 / 08 ] </ td >
< td > 203.13 毫秒 </ td >
< td > 187.50 毫秒 </ td >
</ tr >
< %
dim i,t1,t2,tempvalue,runtime1,runtime2
' 开始计算50万次加法所需时间
t1 = timer ()
for i = 1 to 500000
tempvalue = 1 + 1
next
t2 = timer ()
runtime1 = formatnumber ((t2 - t1) * 1000 , 2 )
' 开始计算20万次开方所需时间
t1 = timer ()
for i = 1 to 200000
tempvalue = 2 ^ 0.5
next
t2 = timer ()
runtime2 = formatnumber ((t2 - t1) * 1000 , 2 )
% >
< tr class = " item_tr1 " >
< td >< span class = " font_3 " > 您正在使用的这台服务器 </ span >& nbsp; < input name = " button " type = " button " class = " btn_c " onClick = " document.location.href='<%=hx.FileName%>' " value = " 重新测试 " >
</ td >
< td >< span class = " font_3 " >< % = runtime1% > 毫秒 </ span ></ td >
< td >< span class = " font_3 " >< % = runtime2% > 毫秒 </ span ></ td >
</ tr >
</ table >
</ div >
</ div >
< %
End Sub
Sub DriveTest
On Error Resume Next
Dim fo,d,xTestObj
set fo = Server.Createobject( " Scripting.FileSystemObject " )
set xTestObj = fo.Drives
% >
< a name = " DriveTest " ></ a >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 服务器磁盘信息 </ span >< % Call GoTop% >
< % Call smenu( 4 )% >
</ div >
< div class = " item_content " id = ' submenu4'>
< % if hx.IsObjInstalled( " Scripting.FileSystemObject " ) then % >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 7 " >< font face = ' Webdings'>4</font> 服务器磁盘信息</td>
</ tr >
< tr class = " item_tr1 " >
< td width = " 90 " > 磁盘类型 </ td >
< td width = " 35 " > 盘符 </ td >
< td width = " 35 " > 可用 </ td >
< td width = " 100 " > 卷标 </ td >
< td width = " 80 " > 文件系统 </ td >
< td width = " 130 " > 可用空间 </ td >
< td width = " 130 " > 总空间 </ td >
</ tr >
< %
for each d in xTestObj
Response.write " <tr class=""item_tr1""> "
Response.write " <td> " & hx.dtype(d.DriveType) & " </td> "
Response.write " <td> " & d.DriveLetter & " </td> "
if d.DriveLetter = " A " then
Response.Write " <td colspan=""5"">为防止影响服务器,不检查软驱</td> "
else
Response.write " <td> "
if d.isready then
Response.Write " √ "
Response.write " </td> "
Response.write " <td> " & d.VolumeName & " </td> "
Response.write " <td> " & d.FileSystem & " </td> "
Response.write " <td> " & hx.formatdsize(d.FreeSpace) & " </td> "
Response.write " <td> " & hx.formatdsize(d.TotalSize) & " </td> "
else
Response.Write " × "
Response.Write " <td colspan=4> 可能是磁盘有问题,或者程序没有读取权限</td> "
end if
end if
next % >
</ table >
< %
Dim filePath,fileDir,fileDrive
filePath = server.MapPath( " . " )
set fileDir = fo.GetFolder(filePath)
set fileDrive = fo.GetDrive(fileDir.Drive)
% >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 6 " >< font face = ' Webdings'>4</font> 当前文件夹信息 (<%=filePath%>)</td>
</ tr >
< tr class = " item_tr2 " >
< td width = " 100 " > 已用空间 </ td >
< td width = " 100 " > 可用空间 </ td >
< td width = " 70 " > 文件夹数 </ td >
< td width = " 70 " > 文件数 </ td >
< td width = " 130 " > 创建时间 </ td >
< td width = " 130 " > 修改时间 </ td >
</ tr >
< %
Response.write " <tr class=""item_tr2""> "
Response.write " <td> " & hx.formatdsize(fileDir.Size) & " </td> "
Response.write " <td> "
Response.write hx.formatdsize(fileDrive.AvailableSpace)
if err then
Response.write " 没有权限读取 "
error .clear
end if
Response.write " </td> "
Response.write " <td> " & fileDir.SubFolders.Count & " </td> "
Response.write " <td> " & fileDir.Files.Count & " </td> "
Response.write " <td> " & fileDir.DateCreated & " </td> "
Response.write " <td> " & fileDir.DateLastModified & " </td> "
Dim i,t1,t2,runtime,TestFileName
Dim tempfo
t1 = timer ()
TestFileName = server.mappath( " ITlearner_Test.txt " )
for i = 1 to 30
set tempfo = fo.CreateTextFile(TestFileName, true )
tempfo.WriteLine " It's a test file. "
set tempfo = nothing
set tempfo = fo.OpenTextFile(TestFileName, 8 , 0 )
tempfo.WriteLine " It's a test file. "
set tempfo = nothing
set tempfo = fo.GetFile(TestFileName)
tempfo.delete True
set tempfo = nothing
next
t2 = timer ()
runtime = formatnumber ((t2 - t1) * 1000 , 2 )
% >
</ table >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 2 " >< font face = ' Webdings'>4</font> 磁盘文件操作速度测试 (重复创建、写入、追加和删除文本文件30次,记录其所使用的时间)</td>
</ tr >
< tr class = " item_tr2 " >
< td width = " 400 " > 可 供 参 考 的 服 务 器 列 表 </ td >
< td width = " 200 " > 完成时间 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > ITlearner的电脑 & nbsp; (CPU:Celeron 2G & nbsp; 内存:512M) </ td >
< td > 203.13 ~ 250.00 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > ITlearner的服务器 & nbsp;(CPU:P4 3 .0G(1M) 内存: 1 .5G) </ td >
< td > 140.63 ~ 157.23 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 中国频道虚拟主机 & nbsp; [ 2005 / 08 / 08 ] </ td >
< td > 656.25 ~ 718.75 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 东南数据虚拟主机 & nbsp; [ 2005 / 08 / 08 ] </ td >
< td > 500.25 ~ 578.13 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td >< span class = " font_3 " > 您正在使用的这台服务器 </ span >& nbsp; < input name = " button2 " type = " button " class = btn_c onClick = " document.location.href='<%=hx.FileName%>' " value = " 重新测试 " >
</ td >
< td >< span class = " font_3 " >< % = runtime% > 毫秒 </ span ></ td >
</ tr >
</ table >
< %
else
Response.write " 您的服务器或租用的空间不支持FSO组件,无法进行此项测试! "
end if % >
</ div >
</ div >
< %
End Sub
Sub SpeedTest
Response.Flush()
% >
< a name = " SpeedTest " ></ a >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 服务器连接速度 </ span >< % Call GoTop% >< % Call smenu( 3 )% >
</ div >
< % if action = " SpeedTest " then % >
< div id = " txt_speed " > 网速测试中,请稍候... </ div >
< % end if % >
< div class = " item_content " id = ' submenu3'>
< table width = " 100% " border = " 0 " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_tr1 " >
< td width = " 80 " > 接入设备 </ td >
< td width = " 405 " > 连接速度(理想值) </ td >
< td width = " 115 " > 下载速度(理想值) </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 56k Modem </ td >
< td >< img src = "" alt = "" class = " PicBar " width = " 1% " > 56 Kbps </ td >< td > 7.0 k / s </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 2M ADSL </ td >
< td >< img src = "" alt = "" class = " PicBar " width = " 10% " > 2000 Kbps </ td >< td > 250.0 k / s </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 5M FTTP </ td >
< td >< img src = "" alt = "" class = " PicBar " width = " 180 " > 5000 Kbps </ td >
< td > 625.0 k / s </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 当前连接 </ td >
< td >
< %
if action = " SpeedTest " then
dim i
With Response
.Write( " <script language=""JavaScript"" type=""text/javascript"">var tSpeedStart=new Date();</script> " )
.Write( " <!-- " ) & chr ( 13 ) & chr ( 10 )
for i = 1 to 1000
.Write( " ITlearner-AspCheck-v1.3############################################################################# " ) & chr ( 13 ) & chr ( 10 )
next
.Write( " --> " ) & chr ( 13 ) & chr ( 10 )
.Write( " <script language=""JavaScript"" type=""text/javascript"">var tSpeedEnd=new Date();</script> " ) & chr ( 13 ) & chr ( 10 )
.Write( " <script language=""JavaScript"" type=""text/javascript""> " )
.Write( " var iSpeedTime=0;iSpeedTime=(tSpeedEnd - tSpeedStart) / 1000; " )
.Write( " if(iSpeedTime>0) iKbps=Math.round(Math.round(100 * 8 / iSpeedTime * 10.5) / 10); else iKbps=10000 ; " )
.Write( " var iShowPer=Math.round(iKbps / 100); " )
.Write( " if(iShowPer<1) iShowPer=1; else if(iShowPer>82) iShowPer=82; " )
.Write( " </script> " ) & chr ( 13 ) & chr ( 10 )
.Write( " <script language=""JavaScript"" type=""text/javascript""> " )
.Write( " document.write('<img class=""PicBar"" width=""' + iShowPer + '%""> ' + iKbps + ' Kbps'); " )
.Write( " </script> " ) & chr ( 13 ) & chr ( 10 )
.Write( " </td><td><a href=""?action=SpeedTest"" title=""测试连接速度""><u> " )
.Write( " <script language=""JavaScript"" type=""text/javascript""> " )
.Write( " document.write(Math.round(iKbps/8*10)/10+ ' k/s'); " )
.Write( " </script> " ) & chr ( 13 ) & chr ( 10 )
.Write( " </u></a> " )
.Write( " <script language=""JavaScript"" type=""text/javascript""> " )
.Write( " txt_speed.innerHTML=""网速测试完毕!""; " )
.Write( " txt_speed.style.display=""none""; " )
.Write( " </script> " ) & chr ( 13 ) & chr ( 10 )
End With
else
Response.Write " </td><td><a href=""?action=SpeedTest#SpeedTest"" title=""测试连接速度""><u>开始测试</u></a> "
end if
% >
</ td >
</ tr >
</ table >
</ div >
</ div >
< % End Sub % >
< % Sub SystemCheck()% >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 系统用户(组)和进程检测 </ span >
</ div >
< div class = " item_content " >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 2 " >< font face = ' Webdings'>4</font> 如果下面列出了系统用户(组)和进程,则说明系统可能存在安全隐患。</td>
</ tr >
< tr bgcolor = " #EFEFEF " >
< td width = " 80 " align = " center " > 类 型 </ td >< td width = " 400 " > 名称及详情 </ td >
</ tr >
< % dim obj
on error resume next
for each obj in getObject ( " WinNT://. " )
% >
< tr bgcolor = " #FFFFFF " >
< td align = " center " >< ! --< % = obj.path% >-->
< % if err = 438 then Response.Write " 系统用户(组) " : else Response.Write " 系统进程 " % >
</ td >
< td >< %Response.Write obj.Name
if not error then Response.Write " ( " & obj.displayname & " )<br> " & obj.path% >
</ td >
</ tr >
< % err.clear
next
% >
</ table >
</ div >
</ div >
< %
Response.End
End Sub % >
</ body >
</ html >
< % Option Explicit % >
< %
Response.Buffer = True
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 GetObjInfo(startnum,endnum)
dim i,Outstr
for i = startnum to endnum
Outstr = Outstr & " <tr class=""item_tr1""><td> " & theTestObj(i, 0 ) & ""
if theTestObj(i, 1 ) <> "" then Outstr = Outstr & " <span class=""font_1""> " & theTestObj(i, 1 ) & " </span> "
Outstr = Outstr & " </td> "
If Not IsObjInstalled(theTestObj(i, 0 )) Then
Outstr = Outstr & " <td><span class=""font_2""><b>×</b></span></td> "
Else
Outstr = Outstr & " <td><span class=""font_3""><b>√</b></span> " & getver(theTestObj(i, 0 )) & " </td> "
End If
Outstr = Outstr & " </tr> " & vbCrLf
next
Response.Write(Outstr)
End Function
Private Sub Class_Initialize()
WebName = " IT学习者 "
WebUrl = " http://www.itlearner.com "
SysName = " ASP探针 "
SysNameE = " AspCheck "
SysVersion = " V1.3 "
FileName = Request.ServerVariables( " SCRIPT_NAME " )
if InStr (FileName, " / " ) then FileName = right (FileName, len (FileName) - InStrRev (FileName, " / " ))
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 Function formatvariables(str)
on error resume next
str = cstr (server.htmlencode(str))
formatvariables = replace (str, chr ( 10 ), " <br> " )
End Function
Public Sub ShowFooter()
dim Endtime,Runtime,OutStr
Endtime = timer ()
OutStr = " <div id=""bottom""> "
OutStr = OutStr & " <p>此程序是<a href=""http://www.itlearner.com"" target=""_blank"">ITlearner</a>以<a href=""http://www.itlearner.com/page/show/4577.htm"" target=""_blank"">Ajiang</a>和<a href=""http://www.itlearner.com/page/show/4580.htm"" target=""_blank"">COCOON</a>的ASP探针的代码为原型,结合部分自已原创的代码精心编写而成。</p> "
OutStr = OutStr & " <p>欢迎访问★<a href=""http://www.itlearner.com"" 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></div> "
Response.Write(OutStr)
End Sub
Public Function getEngVerVBS()
getEngVerVBS = ScriptEngineMajorVersion () & " . " & ScriptEngineMinorVersion () & " . " & ScriptEngineBuildVersion () & " "
End Function
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 ) = " Microsoft.XMLHTTP "
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.ImageGen "
theTestObj( 12 , 1 ) = " (SA 的图像读写组件) "
theTestObj( 13 , 0 ) = " LyfUpload.UploadFile "
theTestObj( 13 , 1 ) = " (刘云峰的文件上传组件) "
theTestObj( 14 , 0 ) = " Persits.Upload "
theTestObj( 14 , 1 ) = " (ASPUpload 文件上传) "
theTestObj( 15 , 0 ) = " w3.upload "
theTestObj( 15 , 1 ) = " (Dimac 文件上传) "
theTestObj( 16 , 0 ) = " JMail.SmtpMail "
theTestObj( 16 , 1 ) = " (Dimac JMail 邮件收发) "
theTestObj( 17 , 0 ) = " CDONTS.NewMail "
theTestObj( 17 , 1 ) = " (虚拟 SMTP 发信) "
theTestObj( 18 , 0 ) = " Persits.MailSender "
theTestObj( 18 , 1 ) = " (ASPemail 发信) "
theTestObj( 19 , 0 ) = " SmtpMail.SmtpMail.1 "
theTestObj( 19 , 1 ) = " (SmtpMail 发信) "
theTestObj( 20 , 0 ) = " PE_Common.Site "
theTestObj( 20 , 1 ) = " (动易2005组件) "
% >
< !DOCTYPE HTML PUBLIC " -//W3C//DTD HTML 4.0 Transitional//EN " >
< html >
< head >
< meta http - equiv = " Content-Type " content = " text/html; charset=gb2312 " >
< title > ASP探针 </ title >
< style type = " text/css " >
< ! --
body {font - size:12px;margin - left :50px;background:#FFF;line - height: 1.5 ;font - family:宋体,arial;color:# 000 ;}
td,span {font - size:12px;word - break:break - all;word - wrap:break - word;line - height: 1.2 ;}
form {margin: 0 ;}
#top {width:600px;margin:8px 0 ;text - align:center;}
#bottom {border:1px dotted # 183789 ;width:600px;margin - top:10px;text - align:center;padding:5px 0 ;}
h3 {font - size:30px;margin: 0 ;}
h3 sub {font - size:14px;font - weight:normal;}
a {color:# 000 ; text - decoration:none}
a:hover {color:#F00;}
.input {border:1px solid #0099CF;}
.btn_c {background:#0099CF;border:1px solid #0099CF;color:#FFF;font - size:12px;}
.PicBar {background:#0099CF;border:1px solid # 000 ;height:12px;vertical - align:middle;}
#txt_speed{position:absolute;height:30px;z - index: 1000 ;}
.frame_box{border: 0 ;width:600px;margin - top:5px;}
.item_title_head{font - weight:bold;}
.item_title{background:#0099CF;text - align:center;color:#FFF;padding:3px;}
.item_title a{color:#FFF;}
.item_title_other{cursor:hand;}
.item_content{width:600px;}
.item_content_head{background:#9CF;text - indent:12px;}
.item_tr1{text - indent:8px;background:#FFF;}
.item_tr2{text - align:center;background:#FFF;height:18px;}
.font_1{color:# 888 ;}
.font_2{color:# 080 ;}
.font_3{color:#F00;}
-->
</ style >
< script language = " JavaScript " runat = " server " >
function getEngVerJs(){
try{
return ScriptEngineMajorVersion () + " . " + ScriptEngineMinorVersion () + " . " + ScriptEngineBuildVersion () + " " ;
}catch(e){
return " 服务器不支持此项检测 " ;
}
}
</ script >
< script language = " JavaScript " type = " text/javascript " >
< ! --
function Checksearchbox(form1){
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= " < span title = ' 关闭此项'>x</span>";");
}
else
{
eval ( " submenu " + sid + " .style.display= " none " ; " );
eval ( " txt " + sid + " .innerHTML= " < span title = ' 打开此项'>y</span>";");
}
}
-->
</ script >
</ head >
< body >
< a name = " top " ></ a >
< div id = " top " >
< h3 >< a href = " <%=hx.FileName%> " > ASP探针 </ a ></ h3 >
</ div >
< %
dim action
action = request( " action " )
select case action
case " Custom_ObjInfo "
Call menu2
% >< div class = " frame_box " >< % Call Custom_ObjInfo% ></ div >
< %Response.End
case " SystemCheck "
Call menu2
Call SystemCheck
end select
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 >< br >
安全: < a href = " ?action=SystemCheck " > 系统用户(组)和进程检测 </ a >< br >
< % End Sub
Sub menu2
Response.Write " <p>返回<a href="" " & hx.FileName & " "">主界面</a></p> "
End Sub
Sub GoTop
Response.Write " <a href=""#top"" title=""返回顶部""><font face=""Webdings"">5</font></a> "
End Sub
% >
< % Sub smenu(i)% >
< font face = " Wingdings " >< span class = " item_title_other " onClick = " showsubmenu(<%=i%>) " id = " txt<%=i%> " >< span title = " 关闭此项 " > x </ span ></ span ></ font >
< % End Sub % >
< % Sub SystemTest
on error resume next
% >
< a name = " SystemTest " ></ a >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 服务器有关参数 </ span >< % Call GoTop% >
< % Call smenu( 0 )% >
</ div >
< div class = " item_content " id = ' submenu0'>
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_tr1 " >
< td width = " 110 " > 服务器名 </ td >
< td width = " 185 " >< % = Request.ServerVariables( " SERVER_NAME " )% ></ td >
< td width = " 110 " > 服务器操作系统 </ td >
< td width = " 185 " >< % = Request.ServerVariables( " OS " )% ></ td >
</ tr >
< tr class = " item_tr1 " >
< td > 服务器IP </ td >
< td >< % = Request.ServerVariables( " LOCAL_ADDR " )% ></ td >
< td > 服务器端口 </ td >
< td >< % = Request.ServerVariables( " SERVER_PORT " )% ></ td >
</ tr >
< tr class = " item_tr1 " >
< td > 服务器时间 </ td >
< td >< % = now % ></ td >
< td > 服务器CPU数量 </ td >
< td >< % = Request.ServerVariables( " NUMBER_OF_PROCESSORS " )% >
个 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > IIS版本 </ td >
< td >< % = Request.ServerVariables( " SERVER_SOFTWARE " )% ></ td >
< td > 脚本超时时间 </ td >
< td >< % = Server.ScriptTimeout% > 秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > Application变量 </ td >
< td >< %Response.Write(Application.Contents.Count & " 个 " )
if Application.Contents.count > 0 then Response.Write( " [<a href=""?action=showapp"">遍历Application变量</a>] " )% >
</ td >
< td > Session变量 </ td >
< td >< %Response.Write(Session.Contents.Count & " 个 " )
if Session.Contents.count > 0 then Response.Write( " [<a href=""?action=showsession"">遍历Session变量</a>] " )% >
</ td >
</ tr >
< tr class = " item_tr1 " >
< td >< a href = " ?action=showvariables " > 所有服务器参数 </ a ></ td >
< td >< %Response.Write(Request.ServerVariables.Count & " 个 " )
if Request.ServerVariables.Count > 0 then Response.Write( " [<a href=""?action=showvariables"">遍历服务器参数</a>] " )% >
</ td >
< td > 服务器环境变量 </ td >
< td >< %
dim WshShell,WshSysEnv
Set WshShell = server.CreateObject( " WScript.Shell " )
Set WshSysEnv = WshShell.Environment
if err then
Response.Write( " 服务器不支持WScript.Shell组件 " )
err.clear
else
Response.Write(WshSysEnv.count & " 个 " )
if WshSysEnv.count > 0 then Response.Write( " [<a href=""?action=showwsh"">遍历环境变量</a>] " )
end if
% >
</ td >
</ tr >
< tr class = " item_tr1 " >
< td > 服务器解译引擎 </ td >
< td colspan = " 3 " > JScript: < % = getEngVerJs() % > | VBScript: < % = hx.getEngVerVBS()% ></ td >
</ tr >
< tr class = " item_tr1 " >
< td > 本文件实际路径 </ td >
< td colspan = " 3 " >< % = server.mappath(Request.ServerVariables( " SCRIPT_NAME " ))% ></ td >
</ tr >
</ table >
< %
if action = " showapp " or action = " showsession " or action = " showvariables " or action = " showwsh " then
showvariable(action)
end if
% >
</ div >
</ div >
< %
End Sub
Sub showvariable(action)
% >
< table width = " 100% " border = " 0 " cellpadding = " 3 " cellspacing = " 1 " bgcolor = " #0099CC " >
< tr class = " item_content_head " >
< td colspan = " 2 " >
< %
' on error resume next
dim Item,xTestObj,outstr
Response.Write( " <font face='Webdings'>4</font> " )
if action = " showapp " then
Response.Write( " 遍历Application变量 " )
set xTestObj = Application.Contents
elseif action = " showsession " then
Response.Write( " 遍历Session变量 " )
set xTestObj = Session.Contents
elseif action = " showvariables " then
Response.Write( " 遍历服务器参数 " )
set xTestObj = Request.ServerVariables
elseif action = " showwsh " then
Response.Write( " 遍历环境变量 " )
dim WshShell
Set WshShell = server.CreateObject( " WScript.Shell " )
set xTestObj = WshShell.Environment
end if
Response.Write " (<a href="" " & hx.FileName & " "">关闭</a>) "
% >
</ td >
</ tr >
< tr bgcolor = " #FFFFFF " >
< td width = " 125 " > 变量名 </ td >
< td width = " 470 " > 值 </ td >
</ tr >
< %
if err then
outstr = " <tr bgcolor=""#FFFFFF""><td colspan=""2"">没有符合条件的变量</td></tr> "
err.clear
else
dim w
if action = " showwsh " then
for each Item in xTestObj
w = split (Item, " = " )
outstr = outstr & " <tr bgcolor=""#FFFFFF""> "
outstr = outstr & " <td> " & w( 0 ) & " </td> "
outstr = outstr & " <td> " & w( 1 ) & " </td> "
outstr = outstr & " </tr> "
next
else
dim i
for each Item in xTestObj
outstr = outstr & " <tr bgcolor=""#FFFFFF""> "
outstr = outstr & " <td> " & Item & " </td> "
outstr = outstr & " <td> "
if IsArray (xTestObj(Item)) then
for i = 0 to ubound (xTestObj(Item)) - 1
if IsArray (xTestObj(Item)(i)) then
outstr = outstr & " 数组 " & " <br> "
else
outstr = outstr & hx.formatvariables(xTestObj(Item)(i)) & " <br> "
end if
next
else
outstr = outstr & hx.formatvariables(xTestObj(Item))
end if
outstr = outstr & " </td> "
outstr = outstr & " </tr> "
next
end if
end if
Response.Write(outstr)
set xTestObj = nothing
% >
</ table >
< % End Sub % >
< % Sub ObjTest% >
< a name = " ObjTest " ></ a >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 服务器组件情况 </ span >< % Call GoTop% >
< % Call smenu( 1 )% >
</ div >
< div class = " item_content " id = ' submenu1'>
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 2 " >< font face = ' Webdings'>4</font> IIS自带的ASP组件</td>
</ tr >
< tr class = " item_tr1 " >
< td width = " 450 " > 组 件 名 称 </ td >
< td width = " 150 " > 支持及版本 </ td >
</ tr >
< %hx.GetObjInfo 0 , 10 % >
</ table >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 2 " >< font face = ' Webdings'>4</font> 网站常用组件 </td>
</ tr >
< tr class = " item_tr1 " >
< td width = " 450 " > 组 件 名 称 </ td >
< td width = " 150 " > 支持及版本 </ td >
</ tr >
< %hx.GetObjInfo 11 , 20 % >
</ table >
< % Call Custom_ObjInfo()% >
</ div >
</ div >
< %
End Sub
Sub Custom_ObjInfo% >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td >< font face = ' Webdings'>4</font> 其他组件支持情况检测 </td>
</ tr >
< tr >
< td height = " 30 " bgcolor = " #FFFFFF " >
< form action = " ?action=Custom_ObjInfo " method = " post " >
输入你要检测的组件的ProgId或ClassId
< input class = " input " type = " text " value = "" name = " classname " size = " 40 " >
< input type = " submit " value = " 确定 " class = " btn_c " name = " submit1 " onClick = " return Checksearchbox(this.form); " >
</ form >
</ td >
</ tr >
< %
Dim strClass
strClass = Trim (Request.Form( " classname " ))
If strClass <> "" then
Response.Write " <tr><td height=""30"" bgcolor=""#FFFFFF"">您指定的组件的检查结果: "
If Not hx.IsObjInstalled(strClass) then
Response.Write " <span class=""font_3"">很遗憾,该服务器不支持 " & strclass & " 组件!</span> "
Else
Response.Write " <span class=""font_3""> "
Response.Write " 恭喜!该服务器支持 " & strclass & " 组件。 "
If hx.getver(strclass) <> "" then
Response.Write " 该组件版本是: " & hx.getver(strclass)
End if
Response.Write " </span> "
End If
Response.Write " </td></tr> "
end if
% >
</ table >
< % End Sub
Sub CalculateTest
% >< a name = " CalcuateTest " ></ a >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 服务器运算能力 </ span >< % Call GoTop% >
< % Call smenu( 2 )% >
</ div >
< div class = " item_content " id = ' submenu2'>
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 3 " >< font face = ' Webdings'>4</font> 让服务器执行50万次加法(整数运算)和20万次开方(浮点运算),记录其所使用的时间。
</ td >
</ tr >
< tr class = " item_tr2 " >
< td width = " 400 " > 可 供 参 考 的 服 务 器 列 表 </ td >
< td width = " 100 " > 整数运算 </ td >
< td width = " 100 " > 浮点运算 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > ITlearner的电脑 & nbsp; (CPU:Celeron 2G & nbsp; 内存:512M) </ td >
< td > 242.19 毫秒 </ td >
< td > 191.41 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > ITlearner的服务器 & nbsp;(CPU:P4 3 .0G(1M) 内存: 1 .5G) </ td >
< td > 187.50 毫秒 </ td >
< td > 171.88 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td >< a href = " http://union.itlearner.com " target = " _blank " > 中国频道虚拟主机 </ a >& nbsp; [ 2005 / 08 / 08 ] </ td >
< td > 375.00 毫秒 </ td >
< td > 328.13 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td >< a href = " http://flash.itlearner.com " target = " _blank " > 东南数据虚拟主机 </ a >& nbsp; [ 2005 / 08 / 08 ] </ td >
< td > 343.75 毫秒 </ td >
< td > 312.50 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td >< a href = " http://www.iva.cn " target = " _blank " > 伊瓦科技虚拟主机 </ a >& nbsp; [ 2005 / 08 / 08 ] </ td >
< td > 203.13 毫秒 </ td >
< td > 187.50 毫秒 </ td >
</ tr >
< %
dim i,t1,t2,tempvalue,runtime1,runtime2
' 开始计算50万次加法所需时间
t1 = timer ()
for i = 1 to 500000
tempvalue = 1 + 1
next
t2 = timer ()
runtime1 = formatnumber ((t2 - t1) * 1000 , 2 )
' 开始计算20万次开方所需时间
t1 = timer ()
for i = 1 to 200000
tempvalue = 2 ^ 0.5
next
t2 = timer ()
runtime2 = formatnumber ((t2 - t1) * 1000 , 2 )
% >
< tr class = " item_tr1 " >
< td >< span class = " font_3 " > 您正在使用的这台服务器 </ span >& nbsp; < input name = " button " type = " button " class = " btn_c " onClick = " document.location.href='<%=hx.FileName%>' " value = " 重新测试 " >
</ td >
< td >< span class = " font_3 " >< % = runtime1% > 毫秒 </ span ></ td >
< td >< span class = " font_3 " >< % = runtime2% > 毫秒 </ span ></ td >
</ tr >
</ table >
</ div >
</ div >
< %
End Sub
Sub DriveTest
On Error Resume Next
Dim fo,d,xTestObj
set fo = Server.Createobject( " Scripting.FileSystemObject " )
set xTestObj = fo.Drives
% >
< a name = " DriveTest " ></ a >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 服务器磁盘信息 </ span >< % Call GoTop% >
< % Call smenu( 4 )% >
</ div >
< div class = " item_content " id = ' submenu4'>
< % if hx.IsObjInstalled( " Scripting.FileSystemObject " ) then % >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 7 " >< font face = ' Webdings'>4</font> 服务器磁盘信息</td>
</ tr >
< tr class = " item_tr1 " >
< td width = " 90 " > 磁盘类型 </ td >
< td width = " 35 " > 盘符 </ td >
< td width = " 35 " > 可用 </ td >
< td width = " 100 " > 卷标 </ td >
< td width = " 80 " > 文件系统 </ td >
< td width = " 130 " > 可用空间 </ td >
< td width = " 130 " > 总空间 </ td >
</ tr >
< %
for each d in xTestObj
Response.write " <tr class=""item_tr1""> "
Response.write " <td> " & hx.dtype(d.DriveType) & " </td> "
Response.write " <td> " & d.DriveLetter & " </td> "
if d.DriveLetter = " A " then
Response.Write " <td colspan=""5"">为防止影响服务器,不检查软驱</td> "
else
Response.write " <td> "
if d.isready then
Response.Write " √ "
Response.write " </td> "
Response.write " <td> " & d.VolumeName & " </td> "
Response.write " <td> " & d.FileSystem & " </td> "
Response.write " <td> " & hx.formatdsize(d.FreeSpace) & " </td> "
Response.write " <td> " & hx.formatdsize(d.TotalSize) & " </td> "
else
Response.Write " × "
Response.Write " <td colspan=4> 可能是磁盘有问题,或者程序没有读取权限</td> "
end if
end if
next % >
</ table >
< %
Dim filePath,fileDir,fileDrive
filePath = server.MapPath( " . " )
set fileDir = fo.GetFolder(filePath)
set fileDrive = fo.GetDrive(fileDir.Drive)
% >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 6 " >< font face = ' Webdings'>4</font> 当前文件夹信息 (<%=filePath%>)</td>
</ tr >
< tr class = " item_tr2 " >
< td width = " 100 " > 已用空间 </ td >
< td width = " 100 " > 可用空间 </ td >
< td width = " 70 " > 文件夹数 </ td >
< td width = " 70 " > 文件数 </ td >
< td width = " 130 " > 创建时间 </ td >
< td width = " 130 " > 修改时间 </ td >
</ tr >
< %
Response.write " <tr class=""item_tr2""> "
Response.write " <td> " & hx.formatdsize(fileDir.Size) & " </td> "
Response.write " <td> "
Response.write hx.formatdsize(fileDrive.AvailableSpace)
if err then
Response.write " 没有权限读取 "
error .clear
end if
Response.write " </td> "
Response.write " <td> " & fileDir.SubFolders.Count & " </td> "
Response.write " <td> " & fileDir.Files.Count & " </td> "
Response.write " <td> " & fileDir.DateCreated & " </td> "
Response.write " <td> " & fileDir.DateLastModified & " </td> "
Dim i,t1,t2,runtime,TestFileName
Dim tempfo
t1 = timer ()
TestFileName = server.mappath( " ITlearner_Test.txt " )
for i = 1 to 30
set tempfo = fo.CreateTextFile(TestFileName, true )
tempfo.WriteLine " It's a test file. "
set tempfo = nothing
set tempfo = fo.OpenTextFile(TestFileName, 8 , 0 )
tempfo.WriteLine " It's a test file. "
set tempfo = nothing
set tempfo = fo.GetFile(TestFileName)
tempfo.delete True
set tempfo = nothing
next
t2 = timer ()
runtime = formatnumber ((t2 - t1) * 1000 , 2 )
% >
</ table >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 2 " >< font face = ' Webdings'>4</font> 磁盘文件操作速度测试 (重复创建、写入、追加和删除文本文件30次,记录其所使用的时间)</td>
</ tr >
< tr class = " item_tr2 " >
< td width = " 400 " > 可 供 参 考 的 服 务 器 列 表 </ td >
< td width = " 200 " > 完成时间 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > ITlearner的电脑 & nbsp; (CPU:Celeron 2G & nbsp; 内存:512M) </ td >
< td > 203.13 ~ 250.00 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > ITlearner的服务器 & nbsp;(CPU:P4 3 .0G(1M) 内存: 1 .5G) </ td >
< td > 140.63 ~ 157.23 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 中国频道虚拟主机 & nbsp; [ 2005 / 08 / 08 ] </ td >
< td > 656.25 ~ 718.75 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 东南数据虚拟主机 & nbsp; [ 2005 / 08 / 08 ] </ td >
< td > 500.25 ~ 578.13 毫秒 </ td >
</ tr >
< tr class = " item_tr1 " >
< td >< span class = " font_3 " > 您正在使用的这台服务器 </ span >& nbsp; < input name = " button2 " type = " button " class = btn_c onClick = " document.location.href='<%=hx.FileName%>' " value = " 重新测试 " >
</ td >
< td >< span class = " font_3 " >< % = runtime% > 毫秒 </ span ></ td >
</ tr >
</ table >
< %
else
Response.write " 您的服务器或租用的空间不支持FSO组件,无法进行此项测试! "
end if % >
</ div >
</ div >
< %
End Sub
Sub SpeedTest
Response.Flush()
% >
< a name = " SpeedTest " ></ a >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 服务器连接速度 </ span >< % Call GoTop% >< % Call smenu( 3 )% >
</ div >
< % if action = " SpeedTest " then % >
< div id = " txt_speed " > 网速测试中,请稍候... </ div >
< % end if % >
< div class = " item_content " id = ' submenu3'>
< table width = " 100% " border = " 0 " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_tr1 " >
< td width = " 80 " > 接入设备 </ td >
< td width = " 405 " > 连接速度(理想值) </ td >
< td width = " 115 " > 下载速度(理想值) </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 56k Modem </ td >
< td >< img src = "" alt = "" class = " PicBar " width = " 1% " > 56 Kbps </ td >< td > 7.0 k / s </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 2M ADSL </ td >
< td >< img src = "" alt = "" class = " PicBar " width = " 10% " > 2000 Kbps </ td >< td > 250.0 k / s </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 5M FTTP </ td >
< td >< img src = "" alt = "" class = " PicBar " width = " 180 " > 5000 Kbps </ td >
< td > 625.0 k / s </ td >
</ tr >
< tr class = " item_tr1 " >
< td > 当前连接 </ td >
< td >
< %
if action = " SpeedTest " then
dim i
With Response
.Write( " <script language=""JavaScript"" type=""text/javascript"">var tSpeedStart=new Date();</script> " )
.Write( " <!-- " ) & chr ( 13 ) & chr ( 10 )
for i = 1 to 1000
.Write( " ITlearner-AspCheck-v1.3############################################################################# " ) & chr ( 13 ) & chr ( 10 )
next
.Write( " --> " ) & chr ( 13 ) & chr ( 10 )
.Write( " <script language=""JavaScript"" type=""text/javascript"">var tSpeedEnd=new Date();</script> " ) & chr ( 13 ) & chr ( 10 )
.Write( " <script language=""JavaScript"" type=""text/javascript""> " )
.Write( " var iSpeedTime=0;iSpeedTime=(tSpeedEnd - tSpeedStart) / 1000; " )
.Write( " if(iSpeedTime>0) iKbps=Math.round(Math.round(100 * 8 / iSpeedTime * 10.5) / 10); else iKbps=10000 ; " )
.Write( " var iShowPer=Math.round(iKbps / 100); " )
.Write( " if(iShowPer<1) iShowPer=1; else if(iShowPer>82) iShowPer=82; " )
.Write( " </script> " ) & chr ( 13 ) & chr ( 10 )
.Write( " <script language=""JavaScript"" type=""text/javascript""> " )
.Write( " document.write('<img class=""PicBar"" width=""' + iShowPer + '%""> ' + iKbps + ' Kbps'); " )
.Write( " </script> " ) & chr ( 13 ) & chr ( 10 )
.Write( " </td><td><a href=""?action=SpeedTest"" title=""测试连接速度""><u> " )
.Write( " <script language=""JavaScript"" type=""text/javascript""> " )
.Write( " document.write(Math.round(iKbps/8*10)/10+ ' k/s'); " )
.Write( " </script> " ) & chr ( 13 ) & chr ( 10 )
.Write( " </u></a> " )
.Write( " <script language=""JavaScript"" type=""text/javascript""> " )
.Write( " txt_speed.innerHTML=""网速测试完毕!""; " )
.Write( " txt_speed.style.display=""none""; " )
.Write( " </script> " ) & chr ( 13 ) & chr ( 10 )
End With
else
Response.Write " </td><td><a href=""?action=SpeedTest#SpeedTest"" title=""测试连接速度""><u>开始测试</u></a> "
end if
% >
</ td >
</ tr >
</ table >
</ div >
</ div >
< % End Sub % >
< % Sub SystemCheck()% >
< div class = " frame_box " >
< div class = " item_title " >
< span class = " item_title_head " > 系统用户(组)和进程检测 </ span >
</ div >
< div class = " item_content " >
< table border = " 0 " width = " 100% " cellspacing = " 1 " cellpadding = " 3 " bgcolor = " #0099CF " >
< tr class = " item_content_head " >
< td colspan = " 2 " >< font face = ' Webdings'>4</font> 如果下面列出了系统用户(组)和进程,则说明系统可能存在安全隐患。</td>
</ tr >
< tr bgcolor = " #EFEFEF " >
< td width = " 80 " align = " center " > 类 型 </ td >< td width = " 400 " > 名称及详情 </ td >
</ tr >
< % dim obj
on error resume next
for each obj in getObject ( " WinNT://. " )
% >
< tr bgcolor = " #FFFFFF " >
< td align = " center " >< ! --< % = obj.path% >-->
< % if err = 438 then Response.Write " 系统用户(组) " : else Response.Write " 系统进程 " % >
</ td >
< td >< %Response.Write obj.Name
if not error then Response.Write " ( " & obj.displayname & " )<br> " & obj.path% >
</ td >
</ tr >
< % err.clear
next
% >
</ table >
</ div >
</ div >
< %
Response.End
End Sub % >
</ body >
</ html >