<%@ LANGUAGE="VBSCRIPT" %><%
Response.Expires = 0
Response.buffer=false
On Error Resume Next
objcheckversion=1
%>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<style>
td {
font-family: Verdana,Arial;
font-size: 10pt;
}
.status {
font-family: Verdana,Arial;
font-size: 10pt;
}
</style>
<title>Installed Objects Scanner</title>
</head>
<body bgcolor="#FFFFFF" leftmargin="40" marginwidth="40" marginheight="40">
<%
Response.Write("<div class=" "status" " id=" "status" ">Please wait...<br>" )
Dim strList
Dim Output
'the following Function gets the standard components names from my webserver
'Leave this URL as is!
ListURL = "http://www.bier-voting.de/objcheck/objects.asp"
Function GetURL2(URL)
Set objHTTP = Server.CreateObject("Microsoft.XMLHTTP" )
objHTTP.Open "GET" , URL, false
objHTTP.sEnd
strList = CStr(objHTTP.ResponseText)
Set objHTTP = Nothing
End Function
Function GetURL(URL)
Set xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP" )
xmlhttp.Open "GET" , url, false
xmlhttp.send()
strList = CStr(xmlhttp.responseText)
Set xmlhttp = Nothing
End Function
Function IsObjInstalled(strClassString)
' initialize default values
IsObjInstalled = False
Err = 0
' testing code
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then
IsObjInstalled = True
End If
' cleanup
Set xTestObj = Nothing
Err = 0
End Function
If IsObjInstalled("MSXML2.ServerXMLHTTP" ) Then
method = 1
ElseIf IsObjInstalled("Microsoft.XMLHTTP" ) Then
method = 2
Else
method = 0
End If
Err = 0
'For adding new classnames To the list and For statistical things, and For my pleasure ;-)
ListURL = ListURL & "?site=" & Server.URLEncode(Request.ServerVariables("SERVER_NAME" ) & Request.ServerVariables("URL" ))
If request("classname" ) <> "" Then
ListURL = ListURL & "&classname=" & request("classname" )
End If
randomize
ListURL = ListURL & "&nocache=" & Server.URLEncode(rnd*10000)
If method=1 OR method=2 Then
Response.Write("Getting list...<br>" )
GetURL(ListURL)
If Not 0 = Err Then
Response.Write("MSXML2.ServerXMLHTTP not available, using Microsoft.XMLHTTP ...<br>" )
GetURL2(ListURL)
End If
Err = 0
arrList = Split(strList,vbNewLine)
Response.Write("Testing...<br></div>" )
strClass = Trim(Request.Form("classname" ))
If "" <> strClass Then
Output = Output & strClass & " is "
If Not IsObjInstalled(strClass) Then
Output = Output & "not installed!"
Else
Output = Output & "<strong>installed!</strong>"
End If
Output = Output & "<P>" & vbCrLf
Else
' Default: Check the whole list
AnzahlComponenten = Ubound(arrList)-1
Output = Output & "<table align=" "center" " border=" "0" ">"
For i=0 To (Ubound(arrList)-1)
If not (Left(arrList(i),12) = "KevinKempfer" ) Then
If Not IsObjInstalled(arrList(i)) Then
If Not Request.Form("nurpositiv" ) = "True" Then
Output = Output & "<tr><td>" & arrList(i) & "</td><td>is not installed!"
End If
Else
Output = Output & "<tr><td>" & arrList(i) & "</td><td>is <strong>installed!</strong>"
End If
Output = Output & "</td></tr>" & vbCrLf
Else
If CInt(Right(arrList(i),1)) > objcheckversion Then
UpdateAvailable = true
End If
End If
Next
Output = Output & "</table>"
End If
%>
<script language="JavaScript">
document.all.status.style.visibility="hidden";
</script>
<table width="100%" border="1" cellspacing="0" cellpadding="5" bgcolor="#FF9933" bordercolor="#000000">
<tr>
<td> <font color="#990000" size="5"><B>KOMPONENTENLISTE</B></font><br>
für den Server <font color="#990000"><%= Request.ServerVariables("LOCAL_ADDR" ) %><br>
<font color="#999999">Componentlist for IP <%= Request.ServerVariables("LOCAL_ADDR" ) %></font>
</font></td>
</tr>
</table>
<br>
<br>
<font face="Verdana,Arial,'Microsoft Sans Serif'"> Geben Sie die ProgID oder ClassId
einer Komponente ein um zu testen, ob sie am Server installiert ist. Wenn Sie
das Textfeld leer lassen, so werden einige Standard-Komponenten getestet.<br>
<font size="-1" color="#999999">Enter a component's ProgID or ClassID to check
if it's installed on this server (<%= Request.ServerVariables("LOCAL_ADDR" ) %>).
Leave the input field empty to check numerous standard components.</font><font size="-1"></font><font size="-1"><br>
<br>
<br>
</font>
<font face="Verdana,Arial,'Microsoft Sans Serif'">Wollen Sie Ihren eigenen Server testen? <a href="http://www.bier-voting.de/objcheck/query.zip">Skript downloaden</a>, auf dem eigenen Server aufrufen, fertig.</font><br>
<font size="-1" color="#999999">Want to check your own server? <a href="http://www.bier-voting.de/objcheck/query.zip">Download the script</a> and run it from your site.</font>
<br><br><br>
</font>
<% If UpdateAvailable Then %>
<table width="70%" border="1" cellspacing="0" cellpadding="5" align="center" bgcolor="#CCCCCC" bordercolor="#000000">
<tr>
<td>
<center>
<strong> Achtung Webmaster! Es ist ein Update für ObjCheck verfügbar! <a href="http://www.bier-voting.de/objcheck/">Klicken Sie hier</a>, um zur Downloadseite zu wechseln.<br>
Attention Webmaster! There's an update available! Please <a href="http://www.bier-voting.de/objcheck/">check the download-site</a>!
</strong></center>
</td>
</tr>
</table>
<%End If %>
<table width="70%" border="1" cellspacing="0" cellpadding="5" align="center" bgcolor="#CCCCCC" bordercolor="#000000">
<tr>
<td>
<form action=<%=Request.ServerVariables("SCRIPT_NAME" ) %> method=post>
<center>
<br>
<input type="text" value="" name="classname" size=40>
<br><input type="checkbox" name="nurpositiv" value="True">
Nur installierte Komponenten anzeigen<br>
<font color="#999999">Show only installed Components</font><br>
<br>
<input type=submit value=>> Test <<><br><br>
Note: Do not enter your website URL or IP, <a href="http://www.bier-voting.de/objcheck/query.zip">download the script</a> instead.
</center>
</form>
</td>
</tr>
</table>
<font face="Verdana,Arial,'Microsoft Sans Serif'">
<br>
<div align="center">Currently checking for <strong><%= AnzahlComponenten %></strong> components.</div>
<br>
<br>
</font> <%= Output %> <br>
<br>
<table width="100%" border="1" cellspacing="0" cellpadding="5" bgcolor="#FF9933" bordercolor="#000000">
<tr>
<td>
<font face="Verdana,Arial,'Microsoft Sans Serif'">Dieses ASP-Skript ist Freeware von <a href="mailto:objcheck@kevinkempfer.de">Kevin Kempfer</a>. Wenn Sie meinen, Ihre Komponente sollte auch in dieser Liste vertreten sein, <a href="mailto:objcheck@kevinkempfer.de">kontaktieren Sie mich</a>.<br>
<font size="-1" color="#999999">This asp-script is freeware by <a href="mailto:objcheck@kevinkempfer.de">Kevin Kempfer</a>. If you think your components should be listed here, <a href="mailto:objcheck@kevinkempfer.de">contact me</a>.
</font> </font>
<% Else %>
Error: This script only works with the "MSXML2.ServerXMLHTTP" Component
or "Microsoft.XMLHTTP" Component installed on the server. This should be
done by default at IIS installation. So check your IIS or contact your provider.
<% End If %>
</td>
</tr>
</table>
</body>
</html>