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 & " " & theTestObj(i,0) & "" Outstr = Outstr & " "&theTestObj(i,1)&"" Outstr = Outstr & "" If Not IsObjInstalled(theTestObj(i,0)) Then Outstr = Outstr & " ×" Else Outstr = Outstr & " √ " & getver(theTestObj(i,0)) & "" End If Outstr = Outstr & "" & 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="学习者" WebUrl="http://www.learner.com" SysName="ASP探针" SysNameE="AspCheck" SysVersion="V1.2" 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 Function formatvariables(str) on error resume next str = cstr(server.htmlencode(str)) formatvariables=replace(str,chr(10),"
") End Function Public Sub ShowFooter() dim Endtime,Runtime,OutStr Endtime=timer() OutStr = "

" OutStr = OutStr & "" OutStr = OutStr & "" & 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 & "" OutStr = OutStr & "

" 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) = "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.FileManager" theTestObj(12,1) = "(SoftArtisans 文件管理)" 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) = "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 的图像读写组件)" %> ASP探针 <% dim action action=request("action") if 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%> 选项：服务器有关参数 | 服务器组件情况 | 服务器运算能力 | 服务器磁盘信息 | 服务器连接速度 <%End Sub%> <%Sub smenu(i)%> 5 name=txt<%=i%>>x <%End Sub%> <%Sub SystemTest on error resume next %>

服务器有关参数 <%Call smenu(0)%>

服务器名	<%=Request.ServerVariables("SERVER_NAME")%>	服务器操作系统	<%=Request.ServerVariables("OS")%>
服务器IP	<%=Request.ServerVariables("LOCAL_ADDR")%>	服务器端口	<%=Request.ServerVariables("SERVER_PORT")%>
服务器时间	<%=now%>	服务器CPU数量	<%=Request.ServerVariables("NUMBER_OF_PROCESSORS")%> 个
IIS版本	<%=Request.ServerVariables("SERVER_SOFTWARE")%>	脚本超时时间	<%=Server.ScriptTimeout%> 秒
Application变量	<%Response.Write(Application.Contents.Count & "个 ") if Application.Contents.count>0 then Response.Write("[遍历Application变量]")%>	Session变量	<%Response.Write(Session.Contents.Count&"个 ") if Session.Contents.count>0 then Response.Write("[遍历Session变量]")%>
所有服务器参数	<%Response.Write(Request.ServerVariables.Count&"个 ") if Request.ServerVariables.Count>0 then Response.Write("[遍历服务器参数]")%>	服务器环境变量	<% 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("[遍历环境变量]") end if %>
服务器解译引擎	JScript: <%= getEngVerJs() %> \| VBScript: <%=getEngVerVBS()%>
本文件实际路径	<%=server.mappath(Request.ServerVariables("SCRIPT_NAME"))%>

<% if action="showapp" or action="showsession" or action="showvariables" or action="showwsh" then showvariable(action) end if %>

<% End Sub Sub showvariable(action) %> <% if err then outstr = "" err.clear else dim w if action="showwsh" then for each Item in xTestObj w=split(Item,"=") outstr = outstr & "" outstr = outstr & "" outstr = outstr & "" outstr = outstr & "" next else dim i for each Item in xTestObj outstr = outstr & "" outstr = outstr & "" outstr = outstr & "" outstr = outstr & "" next end if end if Response.Write(outstr) set xTestObj=nothing %>

<% on error resume next dim Item,xTestObj,outstr if action="showapp" then Response.Write("4 遍历Application变量") set xTestObj=Application.Contents elseif action="showsession" then Response.Write("4 遍历Session变量") set xTestObj=Session.Contents elseif action="showvariables" then Response.Write("4 遍历服务器参数") set xTestObj=Request.ServerVariables elseif action="showwsh" then Response.Write("4 遍历环境变量") dim WshShell Set WshShell = server.CreateObject("WScript.Shell") set xTestObj=WshShell.Environment end if Response.Write "(关闭)" %>
变量名	值
没有符合条件的变量
" & w(0) & "	" & w(1) & "
" & Item & "	" if IsArray(xTestObj(Item)) then for i=0 to ubound(xTestObj(Item))-1 outstr = outstr & hx.formatvariables(xTestObj(Item)(i)) & " " next else outstr = outstr & hx.formatvariables(xTestObj(Item)) end if outstr = outstr & "

<%End Sub%> <%Sub ObjTest%>

服务器组件情况 <%Call smenu(1)%>

<%hx.GetObjInfo 0,10%>

4 IIS自带的ASP组件
组件名称	支持及版本

<%hx.GetObjInfo 11,15%>

4 常见的文件上传和管理组件
组件名称	支持及版本

<%hx.GetObjInfo 16,23%>

4 常见的收发邮件组件
组件名称	支持及版本

<%hx.GetObjInfo 24,25%>

4 图像处理组件
组件名称	支持及版本

4 其他组件支持情况检测

输入你要检测的组件的ProgId或ClassId

<% End Sub Sub ObjTest2 Dim strClass strClass = Trim(Request.Form("classname")) If strClass <> "" then Response.Write "
您指定的组件的检查结果：" If Not hx.IsObjInstalled(strClass) then Response.Write "
很遗憾，该服务器不支持" & strclass & "组件！" Else Response.Write "
" Response.Write " 恭喜！该服务器支持" & strclass & "组件。" If hx.getver(strclass)<>"" then Response.Write " 该组件版本是：" & hx.getver(strclass) End if Response.Write "" End If Response.Write "
" end if Response.Write "

" Response.End End Sub Sub CalculateTest %>

服务器运算能力 <%Call smenu(2)%>

<% 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) %>

4 让服务器执行50万次加法(整数运算)和20万次开方(浮点运算)，记录其所使用的时间。
可供参考的服务器列表	整数运算	浮点运算
ITlearner公司的电脑 (CPU:Athlon1.6G 内存:512M)	269.53 毫秒	328.13 毫秒
ITlearner家里的电脑 (CPU:Celeron 2G 内存:512M)	250.00 毫秒	296.88 毫秒
公司的网站服务器 (CPU:XEON2.4G 内存:2G)	281.25 毫秒	234.38 毫秒
中国频道虚拟主机 [2004/6/18 9:10]	375.00 毫秒	328.13 毫秒
您正在使用的这台服务器	<%=runtime1%> 毫秒	<%=runtime2%> 毫秒

<% End Sub Sub DriveTest On Error Resume Next Dim fo,d,xTestObj set fo=Server.Createobject("Scripting.FileSystemObject") set xTestObj=fo.Drives %>

服务器磁盘信息 <%Call smenu(4)%>

<%if hx.IsObjInstalled("Scripting.FileSystemObject") then%> <% for each d in xTestObj Response.write "" Response.write "" Response.write "" if d.DriveLetter = "A" then Response.Write "" else Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" else Response.Write "×" Response.Write "" end if end if next%>

4 服务器磁盘信息

磁盘类型

盘符

可用

卷标

文件系统

可用空间

总空间

"&hx.dtype(d.DriveType)&"

"&d.DriveLetter&"

为防止影响服务器，不检查软驱

" if d.isready then Response.Write "√" Response.write "

"&d.VolumeName&"

"&d.FileSystem&"

"&hx.formatdsize(d.FreeSpace)&"

"&hx.formatdsize(d.TotalSize)&"

可能是磁盘有问题，或者程序没有读取权限

<% Dim filePath,fileDir,fileDrive filePath = server.MapPath(".") set fileDir = fo.GetFolder(filePath) set fileDrive = fo.GetDrive(fileDir.Drive) %> <% Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write " " Response.write " " 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) %>

4 当前文件夹信息 (<%=filePath%>)
已用空间	可用空间	文件夹数	文件数	创建时间	修改时间
"&hx.formatdsize(fileDir.Size)&"	" Response.write hx.formatdsize(fileDrive.AvailableSpace) if err then Response.write "没有权限读取" error.clear end if Response.write "	"&fileDir.SubFolders.Count&"	"&fileDir.Files.Count&"	"&fileDir.DateCreated&"	"&fileDir.DateLastModified&"

4 磁盘文件操作速度测试 (重复创建、写入、追加和删除文本文件30次，记录其所使用的时间)
可供参考的服务器列表	完成时间
ITlearner公司的电脑 (CPU:Athlon1.6G 内存:512M)	218.75 ~ 269.53 毫秒
ITlearner家里的电脑 (CPU:Celeron 2G 内存:512M)	203.13 ~ 250.00 毫秒
公司的网站服务器 (CPU:XEON2.4G 内存:2G)	187.50 ~ 234.38 毫秒
中国频道虚拟主机 [2004/6/18 9:10]	656.25 ~ 718.75 毫秒
您正在使用的这台服务器	<%=runtime%> 毫秒

<% else Response.write " 您的服务器或租用的空间不支持FSO组件，无法进行此项测试!" end if%>

<% End Sub Sub SpeedTest Response.Flush() %> <% if action="SpeedTest" then%>

网速测试中，请稍候...

<% end if%>

服务器连接速度 <%smenu(3)%>

<% if action="SpeedTest" then dim i Response.Write("") Response.Write("") & chr(13) & chr(10) Response.Write("") & chr(13) & chr(10) Response.Write("") & chr(13) & chr(10) Response.Write("") & chr(13) & chr(10) Response.Write("" %> <% else Response.Write "" end if %>

接入设备	连接速度(理想值)	下载速度(理想值)
56k Modem	56 Kbps	7.0 k/s
64k ISDN	64 Kbps	8.0 k/s
512k ADSL	512 Kbps	64.0 k/s
1.5M Cable	1500 Kbps	187.5 k/s
5M FTTP	5000 Kbps	625.0 k/s
当前连接速度	") Response.Write("") & chr(13) & chr(10) Response.Write "		开始测试

<%End Sub%>