<%
end sub
' *******************************************************************************
' [ B ] 服务器概况
' *******************************************************************************
sub servinfo()
%>
Application 变量 <%=Application.Contents.count%> 个<%if Application.Contents.count>0 then Response.Write "[列表]"%>,
Session 变量 <%=Session.Contents.count%> 个 <%if Session.Contents.count>0 then Response.Write "[列表]"%>
ServerVariables
<%=Request.ServerVariables.Count%> 个 <%if Request.ServerVariables.Count>0 then Response.Write "[Request.ServerVariables 列表]"%>
服务器CPU通道数
<%=okCPUS%> 个
<%
call ObjTest("WScript.Shell")
if isobj then
set WSshell=server.CreateObject("WScript.Shell")
%>
服务器CPU详情
<%=okCPU%>
全部服务器环境
<%=WSshell.Environment.count%> 个 <%if WSshell.Environment.count>0 then Response.Write "[WSshell.Environment 列表]"%>
<%
end if
%>
<%
end sub
%>
<%
' 获取服务器常用参数
sub getsysinfo()
on error resume next
Set WshShell = server.CreateObject("WScript.Shell")
Set WshSysEnv = WshShell.Environment("SYSTEM")
okOS = cstr(WshSysEnv("OS"))
okCPUS = cstr(WshSysEnv("NUMBER_OF_PROCESSORS"))
okCPU = cstr(WshSysEnv("PROCESSOR_IDENTIFIER"))
if isempty(okCPUS) then
okCPUS = Request.ServerVariables("NUMBER_OF_PROCESSORS")
end if
if okCPUS & "" = "" then
okCPUS = "(未知)"
end if
if okOS & "" = "" then
okOS = "(未知)"
end if
end sub
' *******************************************************************************
' [ C ] Application 变量列表
' *******************************************************************************
sub applist()
%>
Application 变量列表
变 量 名 称
值
<%for each apps in Application.Contents%>
<%=apps%>
<%
if isobject(Application.Contents(apps)) then
Response.Write "[对象]"
elseif isarray(Application.Contents(apps)) then
Response.Write "[数组]"
else
Response.Write cHtml(Application.Contents(apps))
end if
%>
<%next%>
<%
end sub
' *******************************************************************************
' [ D ] Session 变量列表
' *******************************************************************************
sub seslist()
%>
Session 变量列表
变 量 名 称
值
<%for each apps in Session.Contents%>
<%=apps%>
<%=cHtml(Session.Contents(apps))%>
<%next%>
<%
end sub
' *******************************************************************************
' [ E ] Request.ServerVariables 变量列表
' *******************************************************************************
sub sevalist()
%>
Request.ServerVariables 变量列表(含客户端信息)
变 量 名 称
值
<%for each apps in Request.ServerVariables%>
<%=apps%>
<%=cHtml(Request.ServerVariables(apps))%>
<%next%>
<%
end sub
' *******************************************************************************
' [ F ] Request.ServerVariables 变量列表
' *******************************************************************************
sub wsslist()
on error resume next
Set WSshell = server.CreateObject("WScript.Shell")
%>
WScript.Shell.Environments 变量列表
变 量 名 称
值
<%for each envs in WSshell.Environment
envsa = split(envs,"=")
%>
[查看上述组件的详细介绍和下载地址]
<%
end sub
' *******************************************************************************
' [ H ] 磁盘信息
' *******************************************************************************
sub disklist()
on error resume next
ObjTest("Scripting.FileSystemObject")
if isobj then
set fsoobj=server.CreateObject("Scripting.FileSystemObject")
%>
磁盘和文件夹
■ 服务器磁盘信息
盘符和磁盘类型
就绪
卷标
文件系统
可用空间
总空间
<%
' 测试磁盘信息的想法来自“COCOON ASP 探针”
set drvObj=fsoobj.Drives
for each d in drvObj
%>
<%
if d.DriveLetter = "A" then '为防止影响服务器，不检查软驱
Response.Write "
"
else
%>
<%=cIsReady(d.isReady)%>
<%=d.VolumeName%>
<%=d.FileSystem%>
<%=cSize(d.FreeSpace)%>
<%=cSize(d.TotalSize)%>
<%
end if
%>
<%
next
%>
“×”表示磁盘没有就绪或者当前IIS站点没有对该磁盘的操作权限。
■ 当前文件夹信息
<%
Response.Flush
dPath = server.MapPath("./")
set dDir = fsoObj.GetFolder(dPath)
set dDrive = fsoObj.GetDrive(dDir.Drive)
%>
文件夹: <%=dPath%>
已用空间
可用空间
文件夹数
文件数
创建时间
<%=cSize(dDir.Size)%>
<%=cSize(dDrive.AvailableSpace)%>
<%=dDir.SubFolders.Count%>
<%=dDir.Files.Count%>
<%=dDir.DateCreated%>
<%
Response.Flush
end if
end sub
' *******************************************************************************
' [ I ] 磁盘速度
' *******************************************************************************
sub diskspeed()
on error resume next
%>
磁盘文件操作速度测试
<%
ObjTest("Scripting.FileSystemObject")
if isobj then
set fsoobj=server.CreateObject("Scripting.FileSystemObject")
' 测试文件读写的想法来自“迷城浪子”
Response.Write "
正在重复创建、写入和删除文本文件50次..."
dim thetime3,tempfile,iserr
iserr=false
t1=timer
tempfile=server.MapPath("./") & "\aspchecktest.txt"
for i=1 to 50
Err.Clear
set tempfileOBJ = FsoObj.CreateTextFile(tempfile,true)
if Err <> 0 then
Response.Write "创建文件错误！
"
iserr=true
Err.Clear
exit for
end if
tempfileOBJ.WriteLine "Only for test. Ajiang ASPcheck"
if Err <> 0 then
Response.Write "写入文件错误！
"
iserr=true
Err.Clear
exit for
end if
tempfileOBJ.close
Set tempfileOBJ = FsoObj.GetFile(tempfile)
tempfileOBJ.Delete
if Err <> 0 then
Response.Write "删除文件错误！
"
iserr=true
Err.Clear
exit for
end if
set tempfileOBJ=nothing
next
t2=timer
if iserr <> true then
thetime3=cstr(int(( (t2-t1)*10000 )+0.5)/10)
Response.Write "...已完成！" & thetime3 & "毫秒。 "
Response.Flush
%>
<%
end if
Response.Flush
set fsoobj=nothing
end if
end sub
' *******************************************************************************
' [ J ] 脚本运算速度
' *******************************************************************************
sub tspeed()
%>
ASP脚本解释和运算速度测试
<%
Response.Flush
'感谢网际同学录 http://www.5719.net 推荐使用timer函数
'因为只进行50万次计算，所以去掉了是否检测的选项而直接检测
Response.Write "整数运算测试，正在进行50万次加法运算..."
dim t1,t2,lsabc,thetime,thetime2
t1=timer
for i=1 to 500000
lsabc= 1 + 1
next
t2=timer
thetime=cstr(int(( (t2-t1)*10000 )+0.5)/10)
Response.Write "...已完成！" & thetime & "毫秒。 "
Response.Write "浮点运算测试，正在进行20万次开方运算..."
t1=timer
for i=1 to 200000
lsabc= 2^0.5
next
t2=timer
thetime2=cstr(int(( (t2-t1)*10000 )+0.5)/10)
Response.Write "...已完成！" & thetime2 & "毫秒。 "
%>
<%
end sub
' *******************************************************************************
' [ K ] 网络连接速度测试
' *******************************************************************************
sub tnet()
%>
<%
else
haveok=false
if Request("ok") <> "" then haveok=true
if Request.ServerVariables("HTTP_REFERER") & "" <> "" then haveok=false
if Request("tm") = "" then haveok=false
if haveok=false then
%>
正在测试您与当前服务器之间的连接速度，请稍等....
<%
Response.Flush
for i=1 to 1000
Response.Write "" & vbcrlf
if i mod 100=0 then
%>
<%
end if
next
%>
<%
Response.Flush :Response.end
else
ttime=clng(Request("tm")) + 1
tnetspeed=100000/(ttime)
tnetspeed2=tnetspeed * 8
twidth=int(tnetspeed * 0.16)+5
if twidth> 300 then twidth=300
tnetspeed=formatnumber(tnetspeed,2,,,0)
tnetspeed2=formatnumber(tnetspeed2,2,,,0)
%>
<%
end if
end if
end sub
' *******************************************************************************
' [ L ] 不安全组件检测
' *******************************************************************************
sub tsafe()
%>
[点击这里参考阿江的安全配置方法]
<%
end sub
' *******************************************************************************
' [ M ] 系统用户和进程检测
' *******************************************************************************
sub userlist()
%>
系统用户(組)和进程检测
如果下面列出了系统用户和进程，则说明系统存在安全隐患。
类 型
名称及详情
<%
on error resume next
for each obj in getObject("WinNT://.")
err.clear
%>
<%
if err then
Response.Write "系统用户(組)"
else
Response.Write "系统进程"
end if
%>
[点击这里参考阿江的安全配置方法]
<%
end sub
' *******************************************************************************
' [ N ] 主菜单
' *******************************************************************************
sub mmenu()
%>
<%
end sub
' *******************************************************************************
' 其他函数和子程序
' *******************************************************************************
' 展示栏目
sub BodyGo(gCon)
select case gCon
case "A"
call aspyes()
case "B"
call servinfo()
case "C"
call applist()
case "D"
call seslist()
case "E"
call sevalist()
case "F"
call wsslist()
case "G"
call comlist()
case "H"
call disklist()
case "I"
call diskspeed()
case "J"
call tspeed()
case "K"
call tnet()
case "L"
call tsafe()
case "M"
call userlist()
case "N"
call mmenu()
end select
end sub
' 检测不安全组件
Function okObj(runstr)
On Error Resume Next
Response.Write ""
okObj = true
Err = 0
Execute runstr & ".exec()"
If 429 = Err Then
okObj = false
end if
Err = 0
Response.Write ""
if okObj then
okObj="√ 危险"
else
okObj="× 安全"
end if
End Function
' 转换字串为HTML代码
function cHtml(iText)
cHtml = iText
cHtml = server.HTMLEncode(cHtml)
cHtml = replace(cHtml,chr(10)," ")
end function
' 转换磁盘类型为中文
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
' 将是否可用转换为对号和错号
function cIsReady(trd)
Select Case trd
case true: cIsReady="√"
case false: cIsReady="×"
End Select
end function
' 转换字节数为简写形式
function cSize(tSize)
if tSize>=1073741824 then
cSize=int((tSize/1073741824)*1000)/1000 & " GB"
elseif tSize>=1048576 then
cSize=int((tSize/1048576)*1000)/1000 & " MB"
elseif tSize>=1024 then
cSize=int((tSize/1024)*1000)/1000 & " KB"
else
cSize=tSize & "B"
end if
end function
'检查组件是否被支持及组件版本的子程序
sub ObjTest(strObj)
on error resume next
IsObj=false
VerObj=""
set TestObj=server.CreateObject (strObj)
If -2147221005 <> Err then '感谢网友iAmFisher的宝贵建议
IsObj = True
VerObj = TestObj.version
if VerObj="" or isnull(VerObj) then VerObj=TestObj.about
end if
set TestObj=nothing
End sub
%>