⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 wm.sys_aspcheck.asp

📁 网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。
💻 ASP
字号:
🔍 
<!--#include file="WM.Sys_Cook.asp"-->
<%
Response.Buffer = true

Dim hx,startime,action
startime=timer()
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=td2><TD>" & theTestObj(i,0) & ""
      	Outstr = Outstr & ""&theTestObj(i,1)&""
      	Outstr = Outstr & "</td>"
    	If Not IsObjInstalled(theTestObj(i,0)) Then 
      	Outstr = Outstr & "<td Class=font2><b>×</b></td>"
    	Else
      	Outstr = Outstr & "<td Class=font3><b>√</b> " & getver(theTestObj(i,0)) & "</td>"
		End If
      	Outstr = Outstr & "</tr>" & 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

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

formatvariables=cstr(server.htmlencode(str))
End Function
End class

Dim theTestObj(26,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) = WR_Setting(14)
	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 邮件收发)</a>"
	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 的图像读写组件)"
	theTestObj(26,0) = "Persits.Jpeg"
	theTestObj(26,1) = "(AspJpeg 图像读写组件)"


%>
<SCRIPT language="JavaScript" runat="server">
	function getEngVerjs(){
		try{
			return ScriptEngineMajorVersion() +"."+ScriptEngineMinorVersion()+"."+ ScriptEngineBuildVersion() + " ";
		}catch(e){
			return "服务器不支持此项检测";
		}
		
	}
</SCRIPT>
<SCRIPT language="VBScript" runat="server">
	Function getEngVerVBS()
		getEngVerVBS=ScriptEngineMajorVersion() &"."&ScriptEngineMinorVersion() &"." & ScriptEngineBuildVersion() & " "
	End Function
</SCRIPT>
<script language="javascript">
<!--
function Checksearchbox()
{
if(form1.ClassName.value == "")
{
	alert("请输入你要检测的组件名！");
	form1.ClassName.focus();
	return false;
}
}
-->
</SCRIPT>
<%
action=request("action")
if action="testzujian" then
call ObjTest2
end if

Call menu
Call SystemTest
Call ObjTest

set hx= nothing

Sub menu
%>
<table width="100%" border="0" align="center" cellpadding="3" cellspacing="1" class=td1>
<tr class=td2><td>&nbsp;<a href="#SystemTest">服务器有关参数</a> |
<a href="#ObjTest">服务器组件情况</a></td></tr>
</table>
<%
End Sub
Sub smenu(i)
%>
<a href="#top" title="返回顶部"><font face='Webdings' color=#FFFFFF>5</font></a> <span id=txt<%=i%> name=txt<%=i%>><a href='#' title='关闭此项'><font face='Wingdings' color=#FFFFFF>x</font></a></span> 
<%
End Sub
Sub SystemTest
On Error Resume Next
%>
<a name="SystemTest"></a> 
<table width="100%" border="0" align="center" cellpadding="5" cellspacing="1" class=td1>
  <tr class=td4> 
    <td colspan=4><strong>服务器有关参数</strong></td>
  </tr>
        <tr class=td2> 
          <td width="120">服务器名</td>
          <td width="180"><%=Request.ServerVariables("SERVER_NAME")%></td>
          <td width="120">服务器操作系统</td>
          <td width="180"><%=Request.ServerVariables("OS")%></td>
        </tr>
        <tr class=td2> 
          <td>服务器IP</td><td><%=Request.ServerVariables("LOCAL_ADDR")%></td>
          <td>服务器端口</td><td><%=Request.ServerVariables("SERVER_PORT")%></td>
        </tr>
        <tr class=td2> 
          <td>服务器时间</td><td><%=now%></td>
          <td>服务器CPU数量</td><td><%=Request.ServerVariables("NUMBER_OF_PROCESSORS")%> 个</td>
        </tr>
        <tr class=td2> 
          <td>IIS版本</td><td><%=Request.ServerVariables("SERVER_SOFTWARE")%></td>
          <td>脚本超时时间</td><td><%=Server.ScriptTimeout%> 秒</td>
        </tr>
        <tr class=td2> 
          <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变量<br> </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=td2> 
          <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=td2> 
          <td>服务器解译引擎</td>
          <td colspan="3">jscript: <%= getEngVerjs() %> | VBScript: <%=getEngVerVBS()%></td>
        </tr>
        <tr class=td2> 
          <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

End Sub

Sub showvariable(action)
%>
<table width="100%" border="0" align="center" cellpadding="5" cellspacing="1" class=td1>
  <tr class=td4> 
    <td colspan="2">
      <%
	On Error Resume Next
	dim Item,xTestObj,outstr
	if action="showapp" then
		Response.Write("<font face='Webdings'>4</font> 遍历Application变量")
		set xTestObj=Application.Contents
	elseif action="showSession" then
		Response.Write("<font face='Webdings'>4</font> 遍历Session变量")
		set xTestObj=Session.Contents
	elseif action="showvariables" then
		Response.Write("<font face='Webdings'>4</font> 遍历服务器参数")
		set xTestObj=Request.ServerVariables
	elseif action="showwsh" then
		Response.Write("<font face='Webdings'>4</font> 遍历环境变量")
		dim WshShell
		set WshShell = server.CreateObject("WScript.Shell")
		set xTestObj=WshShell.Environment
	end if
		Response.Write "(<a href=WM.Sys_Aspcheck.asp class=white>关闭</a>)"
	%>
    </td>
  </tr>
  <tr class=td2> 
    <td width="20%">变量名</td>
    <td width="80%">值</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 class=td2>"
				outstr = outstr & "<td>" & w(0) & "</td>" 
				outstr = outstr & "<td>" & w(1) & "</td>" 
				outstr = outstr & "</tr>" 		
			next
		else
			dim i
			for each Item in xTestObj
			    If Item = "DllConn" Then Item="ConnTypeStr"
				outstr = outstr & "<tr class=td2>"
				outstr = outstr & "<td>" & Item & "</td>" 				
				outstr = outstr & "<td>"
				  if IsArray(xTestObj(Item)) then		
					for i=0 to ubound(xTestObj(Item))-1
					  outstr = outstr & Left(Replace(Replace(hx.formatvariables(xTestObj(Item)(i)),"<","&lt;"),vbCrLf,""),30) & "<br>"
					next
				  else
					outstr = outstr & Left(Replace(Replace(hx.formatvariables(xTestObj(Item)),"<","&lt;"),vbCrLf,""),30)
				  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>
<table width="100%" border="0" align="center" cellpadding="5" cellspacing="1" class=td1>
  <tr class=td4> 
    <td colspan=4><strong>服务器组件情况</strong></td>
  </tr>
        <tr class=td3> 
          <td colspan="2"><font face='Webdings'>4</font> IIS自带的ASP组件</td>
        </tr>
        <tr class=td2> 
          <td width=65% align="center">组 件 名 称</td>
          <td width=36% align="center">支持及版本</td>
        </tr>
        <%hx.GetObjInfo 0,10%>
        <tr class=td3> 
          <td colspan="2"><font face='Webdings'>4</font> 常见的文件上传和管理组件 </td>
        </tr>
        <tr class=td2> 
          <td align="center">组 件 名 称</td>
          <td align="center">支持及版本</td>
        </tr>
        <%hx.GetObjInfo 11,15%>
        <tr class=td3> 
          <td colspan="2"><font face='Webdings'>4</font> 常见的收发邮件组件</td>
        </tr>
        <tr class=td2> 
          <td align="center">组 件 名 称</td>
          <td align="center">支持及版本</td>
        </tr>
        <%hx.GetObjInfo 16,23%>
        <tr class=td3> 
          <td colspan="2"><font face='Webdings'>4</font> 图像处理组件</td>
        </tr>
        <tr class=td2> 
          <td align="center">组 件 名 称</td>
          <td align="center">支持及版本</td>
        </tr>
        <%hx.GetObjInfo 24,26%>
        <tr class=td3> 
          <td colspan="2"><font face='Webdings'>4</font> 其他组件支持情况检测 </td>
        </tr>
        <FORM action=?action=testzujian method=post id=form1 name=form1 onSubmit="JavaScript:return Checksearchbox();">
          <tr class=td2> 
            <td colspan="2">输入你要检测的组件的ProgId.ClassId 
              <input class=input type=text value="" name="ClassName" size=40> 
              <INPUT type=submit value=" 确 定 " id=submit1 name=submit1> 
            </td>
          </tr>
        </FORM>
      </table>

<%
End Sub
Sub ObjTest2
	Dim strClass
    strClass = Trim(Request.Form("ClassName"))
    If strClass <> "" then
	
    Response.Write "<br><div align=center>您指定的组件的检查结果："
      If Not hx.IsObjInstalled(strClass) then 
        Response.Write "<br><font color=red>很遗憾，该服务器不支持" & strclass & "组件！</font>"
      Else
        Response.Write "<br><font color=green>"
		Response.Write " 恭喜！该服务器支持 " & strclass & " 组件。"
		If hx.getver(strclass)<>"" then
		Response.Write " 该组件版本是：" & hx.getver(strclass)
		End if
		Response.Write "</font>"
      End If
      Response.Write "<br>"
    end if
	
	Response.Write "<a href=WM.Sys_Aspcheck.asp>返回</a></div>"
	Response.End
End Sub
Call ClassEnd()
Call GetBottom()
%>
</BODY>
</HTML>

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -