Installed component checker in vb

A project to chech the status of components installed on a server. Can be run without installation. An important IT project for students.

<%@ LANGUAGE=”VBSCRIPT” %><% ‘Due to the high number of components, the script may run into Timeout – increase this value then. Server.ScriptTimeOut=240 Response.Expires = 0 Response.buffer=false On Error Resume Next ‘ObjCheck V0.27 by Kevin Kempfer ‘contact me at objcheck@kevinkempfer.de ‘ This program is free software; you can redistribute it and/or modify ‘ it under the terms of the GNU General Public License as published by ‘ the Free Software Foundation; either version 2 of the License, or ‘ (at your option) any later version. ‘ ‘ This program is distributed in the hope that it will be useful, ‘ but WITHOUT ANY WARRANTY; without even the implied warranty of ‘ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ‘ GNU General Public License for more details. ‘ ‘ You should have received a copy of the GNU General Public License ‘ along with this program; if not, write to the Free Software ‘ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ‘ ‘History: ‘v0.27 – Changed handling of different methods to get the list of components from my server. Now the script ‘ will test every method until one is successfull, because i.e. ServerXMLHTTP.4.0 seems to be buggy when ‘ behind a firewall or proxy. ‘v0.26 – if there’s no link yet available for a component, Google’s number one search result will be provided. ‘ Updated daily, thanks to Google for this great web service. ‘ – added support for more components for automatic update downloads and proxy support. ‘ As I don’t use proxies, I can’t test the proxy support. Please give me some feedback on this. ‘ If you need to use a proxy, enter the proxy information below (line 55,56,57). ‘v0.25 – added descriptions and links for components, now you’ll get a short description of the components ‘ as well as a link to both the authors of the component and google. ‘ – you can now edit descriptions and links if there’s none yet available. ‘ – enter your own new components! click on “Add new component” ‘ – all new descriptions/links/components will be reviewed before going online. ‘ – changed some colors ‘v0.24 – changed method for automatic updates to XML-Stream ‘v0.23 – added detection for misspelled or incomplete ProgIDs ‘v0.221 – this script is now under the GPL, see licence.txt ‘v0.22 – added link to Google when a component is installed, so you can get a little bit more ‘ information on how to work with it. ‘v0.21 – added check for URLs in the input box, because people always enter their URLs instead of ‘ downloading the script… ‘v0.2 – fixed some bugs, now first display information, then try to fetch the list. Sometimes ‘ the XMLHTTP-Object doesn’t work, maybe due to high traffic on my site. Should work on your site. ‘v0.1 – inital release January 2002 ‘Set proxy here ProxyAddress=”” proxyusername=”” proxypassword=”” ‘This is the current version. These values are used for update-checking and to tell the list-server ‘how to react, will be checked later. objcheckversion=4 version=”0.27″ Dim XMLHTTPError Dim ServerXMLHTTPError Dim classID Dim UpdateDescription if request.form(“descriptions”)=”True” then ShowDescriptionsWhenInstalled = true end if if trim(request(“classID”))<>”” then classID = cint(trim(request(“classID”))) AddDescription=true elseif trim(request(“AddNew”))<>”” then AddDescription=true else AddDescription=false end if sub SayError %> 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. Maybe this Error was made by me, so please also contact me, the author: <a href=”mailto:objcheck@kevinkempfer.de?subject=Error%20in%20ObjCheck&body=< %=replace(“Errormessage: ” & ServerXMLHTTPError&” / ” &XMLHTTPError,” “,”%20″)%>”>Kevin Kempfer</a>. (Errormessage: <%=ServerXMLHTTPError%>/<%=XMLHTTPError%>) <% end sub Function IsObjInstalled(strClassString) ‘ initialize default values IsObjInstalled = False Err = 0 ‘ testing code Dim TestObj Set TestObj = Server.CreateObject(strClassString) If 0 = Err Then IsObjInstalled = True end if ‘ cleanup Set TestObj = Nothing Err = 0 End Function function Alternatives(strList,arrList) ‘This function is used to find alternative Component-Prog-IDs, maybe the user input was incomplete for i=0 to ubound(arrList,2) item=trim(lcase(arrlist(1,i))) strList=trim(lcase(strList)) if instr(item,strList)>0 and not item=strList and not instr(arrlist(1,i),”KevinKempfer”)>0 then if not ThereAreAlternatives then Output = Output & “ Did you mean: ” end if Output = Output & “<a href=””” & request.servervariables(“script_name”) & “?classname=” & arrlist(1,i) & “””>” & “” & arrlist(1,i) & “</a> ” ThereAreAlternatives=true end if next if ThereAreAlternatives then Output = Output & “ Do you think ” & strList & “ should be listed in the components list? <a href=””mailto:objcheck@kevinkempfer.de?subject=” & Server.urlencode(“Please add ” & arrlist(1,i)) & “””>Contact me</a>!” end if end function %> <!DOCTYPE HTML PUBLIC “-//W3C//DTD HTML 4.0 Transitional//EN”> <html> <head> <meta http-equiv=”Content-Type” content=”text/html; charset=windows-1252″> <meta http-equiv=”Content-Language” content=”en”> <meta name=”description” content=”This ASP script will check your IIS for installed components. Currently supporting hundreds of known components. The list is still growing while you use the script – no update required.”> <meta name=”publisher” content=”Kevin Kempfer”> <meta name=”copyright” content=”Free software under GPL”> <meta name=”robots” content=”index”> <meta name=”author” content=”Kevin Kempfer”> <meta name=”keywords” content=”asp,component,components,object,objects,IIS,Microsoft IIS,installed,check,scanner,scan,jmail,cdonts,mswc,mailer”> <META NAME=”revisit-after” CONTENT=”7 days”> <META NAME=”page-topic” CONTENT=”ASP, Scripting, VB-Script, IIS, Components”> <META NAME=”audience” CONTENT=”All”> <style> td { font-family: Verdana,Arial; font-size: 10pt; } .status { font-family: Verdana,Arial; font-size: 10pt; } tr.even { background-color : #EFEFEF; } tr.odd { background-color : #FFFFFF; } tr.eveninstalled { background-color : #FF9933; } tr.oddinstalled { background-color : #FFAA50; } tr.oddnotinstalled { background-color : #FFFFFF; } tr.evennotinstalled { background-color : #EFEFEF; } </style> <script language=”JavaScript”> function u(strobject) { document.getElementById(“statuscheck”).value=strobject; } </script> <title>Installed Objects Scanner</title> </head> <body bgcolor=”#FFFFFF” leftmargin=”40″ marginwidth=”40″ marginheight=”40″> <!– ========================================== ObjCheck V<%=version%> (c) Kevin Kempfer (objcheck@kevinkempfer.de) http://www.bier-voting.de/objcheck <%’Please do not remove this comment. %>========================================== –> <TABLE width=”100%” border=”1″ cellspacing=”0″ cellpadding=”5″ bgcolor=”#FF9933″ bordercolor=”#000000″> <TR> <TD> Component Check<FONT color=”#990000″ size=”2″> v<%=version%> <%if not AddDescription then%>Components for IP <font color=”#990000″><%= Request.ServerVariables(“LOCAL_ADDR”) %><%else%>Add new description<%end if%> </TD> </TR> </TABLE> <%if AddDescription then%> Please enter a description, all fields but name are optional, so leave them empty if you don’t know everything. Thanks for your support! <%else%> 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 all listed components. <% End If %> <%if not AddDescription then%> If you want to check your own server, you’ll have to <a href=”http://www.bier-voting.de/objcheck/query.zip”>download the script</a> and run it from your site. <% End If %> <% response.write(“<div class=””status”” id=””status””>Please wait… ”) Dim strList Dim Output Dim strClass Dim myObjectReviewed Dim myObject Dim myObjectdesc Dim myObjectID Dim myObjectlink ‘the following function gets the components names from my webserver ‘Leave this URL as is! ListURL = “http://www.bier-voting.de/objcheck/objects.asp” Function GetURL(URL,method) set xmlhttp = server.CreateObject(method) if method=”MSXML2.ServerXMLHTTP.4.0″ and ProxyAddress<>”” then xmlhttp.setProxy 0,ProxyAddress,”” if proxyusername<>”” then xmlhttp.setProxyCredentials proxyusername, proxypassword end if end if xmlhttp.open “GET”, URL, false if method=”Microsoft.XMLHTTP” then xmlhttp.send else xmlhttp.send() end if strList = xmlhttp.responseStream if err.number <> 0 then GetURL=false XMLHTTPError=XMLHTTPError& “<hr>Using “&method&” ”&xmlhttp.parseError.URL & _ “ ” & xmlhttp.parseError.Reason response.end else GetURL=true end if set xmlhttp = nothing End Function dim even function trclass if even then trclass = “even” even = false else trclass = “odd” even = true end if end function sub showDescription(myObjectID) if myObjectReviewed=false and myObjectdesc<>”” then Output = Output & “ ” & myObjectdesc & ” (not yet reviewed)” elseif myObjectdesc<>”” then Output = Output & “ ” & myObjectdesc else Output = Output & “ <a href=””” & request.servervariables(“script_name”) & “?classID=” & myObjectID & “””> Write a description</a>” end if if myObjectlink<>”” then Output = Output & “ <a target=””_blank”” href=””” & myObjectlink & “””>details…</a>” if myObjectReviewed=false then Output = Output & ” (not yet reviewed)” end if else Output=Output &” <a href=””” & request.servervariables(“script_name”) & “?classID=” & myObjectID & “&addlink=true””>add link</a>” if myObjectGoogleLink<>”” then Output = Output & ” or <a target=””_blank”” href=””” & myObjectGoogleLink & “””>try Google’s #1</a>” end if end if end sub ‘for adding new classnames to the list and for statistical things and to deliver the right version, and for my pleasure ;-) ListURL = ListURL & “?site=” & Server.URLEncode(Request.ServerVariables(“SERVER_NAME”) & Request.ServerVariables(“URL”)) ‘Leave the version string as is! Otherwise, the server will return wrong data ListURL = ListURL & “&ver=” & version if request(“classname”) <> “” then ListURL = ListURL & “&classname=” & request(“classname”) end if randomize ‘Fake the browser, so it doesn’t display cached sites. ListURL = ListURL & “&nocache=” & Server.URLEncode(rnd*10000) Dim methods(3) methods(0)=”MSXML2.ServerXMLHTTP.4.0″ methods(1)=”MSXML2.ServerXMLHTTP.3.0″ methods(2)=”MSXML2.ServerXMLHTTP” methods(3)=”Microsoft.XMLHTTP” success=false Err = 0 for each method in methods response.write(“Getting list…(using ” & method & “) ”) if GetURL(ListURL,method) then If Not 0 = Err Then response.write “Error while using “&method&”:”& Err.description&” ” else Response.write “Success using “&method&”… ” success=true exit for end if end if Err=0 next if not success then sayerror response.end end if if 0 = Err then Set objRS = Server.CreateObject(“ADODB.Recordset”) objRS.Open strList AnzahlComponenten = objRS.RecordCount – 1 strClass = Trim(Request(“classname”)) If “” <> strClass then arrlist=objRS.getrows response.write(“Testing for ” & strClass & ” … </div>”) If left(strClass, 7) = “http://” or (left(strClass,4)=”www.” and (right(strClass,4)=”.com” or right(strClass,4)=”.net” or right(strClass,4)=”.org” or right(strClass,4)=”.edu” or right(strClass,3)=”.de”) or right(strClass,4)=”.com” or right(strClass,4)=”.net” or right(strClass,4)=”.org” or right(strClass,4)=”.edu” or right(strClass,3)=”.br” or right(strClass,3)=”.de”) then Output = Output&”<div class=””status””>” & strClass & ” looks like an URL! Remember, this script can only check the server it was started from. If you want to test your own server, <a href=””http://www.bier-voting.de/objcheck/query.zip””>download the script</a>, run it from your server and enter a ProgID (no URL!).</div> ” end if Output = Output & “ <div class=””status”” align=””center””>” & strClass & ” is ” If Not IsObjInstalled(strClass) then Output = Output & “not installed!” if “” <> strClass then Output = Output & Alternatives(strClass,arrList) end if Output = output & “ If you want to add ”” & strClass & “” to the database, please <a href=””” & request.servervariables(“script_name”) & “?AddNew=true&Adddescription=true&newClassname=” & strClass & “””>click here</a>.” Else GoogleLink = ” (<a target=””_blank”” href=””http://www.google.com/search?q=”&strClass&”””>try Google</a>)” objRS.MoveFirst Do while not ObjRS.EOF if (lcase(objRS(“Object”))=lcase(strClass)) and objRS(“GoogleLink”)<>”” then GoogleLink = ” (<a target=””_blank”” href=”””&objRS(“GoogleLink”)&”””>try Google</a>)” Exit Do end if objRS.MoveNext loop Output = Output & “installed!” & GoogleLink End If Output = Output & “</div>” & vbCrLf Else if not AddDescription then response.write(“Testing for ” & AnzahlComponenten & ” components… (this may take a minute) ”) response.write(“<input type=””text”” id=””statuscheck”” size=””40″”>”) ‘ Default: Check the whole list icount = 0 Output = Output & “<table align=””center”” border=””0″” width=””95%””>” Do while not objRS.EOF myObject = objRS(“Object”) myObjectdesc = objRS(“Beschreibung”) myObjectlink = objRS(“link”) myObjectID = objRS(“ID”) myObjectGoogleLink = objRS(“GoogleLink”) myObjectReviewed = objRS(“Online”) response.write(“<s”&”cript>u(‘”&myObject&”‘);</s”&”cript>”) If not (left(myObject,12) = “KevinKempfer”) then if myObjectdesc<>”” then trid=”desc” else trid=”nodesc” end if Installed = IsObjInstalled(myObject) If Not Installed Then If Not Request.Form(“nurpositiv”) = “True” Then Output = Output & “<TR class=””” & trclass & “notinstalled”” name=””” & trid & “notinstalled””><TD width=””200″”>” & myObject & “</TD><TD>is not installed!” if not ShowDescriptionsWhenInstalled then showDescription myObjectID end if End If Else Output = Output & “<TR class=””” & trclass & “installed”” name=””” & trid & “installed””><TD width=””200″”>” & myObject & “</TD><TD>is installed!” showDescription myObjectID icount = icount + 1 End If Output = Output & “</TD></TR>” & vbCrLf else ‘check version if cint(right(myObject,1)) > objcheckversion then UpdateAvailable = true UpdateDescription = myObjectdesc end if end if Installed=false objRS.MoveNext loop response.write(“</div>”) else response.write(“</div>”) bingo=false Do while not (objRS.EOF or bingo or request(“AddNew”)=”true”) myObject = objRS(“Object”) myObjectdesc = objRS(“Beschreibung”) myObjectlink = objRS(“link”) myObjectID = objRS(“ID”) if myObjectID = classID then bingo=true else objRS.MoveNext bingo=false end if loop end if Set objRS=Nothing End If %> <script language=”JavaScript”> document.getElementById(“status”).style.display = “none”; </script> <%if not AddDescription then%> <% if UpdateAvailable or trim(request(“Thank”))=”you” then %> <TABLE width=”70%” border=”1″ cellspacing=”0″ cellpadding=”5″ align=”center” bgcolor=”#CCCCCC” bordercolor=”#000000″> <TR> <TD> <CENTER> <% If not trim(request(“Thank”))=”you” then %>Webmaster! There’s an <blink>update</blink> available! Please <a href=”http://www.bier-voting.de/objcheck/”>check the download-site</a>!<%=UpdateDescription%><% Else %>Thank you! Your submission will be reviewed as soon as possible.<% End If %></CENTER> </TD> </TR> </TABLE> <%end if%> <table border=”0″ width=”100%”> <tr><td width=”15%”> </td> <td width=”70%”> <TABLE width=”100%” border=”1″ cellspacing=”0″ cellpadding=”5″ align=”right” bgcolor=”#CCCCCC” bordercolor=”#000000″> <TR> <TD> <FORM action=<%=Request.ServerVariables(“SCRIPT_NAME”)%> method=”post” name=”formular” id=”formular”> <CENTER>Enter a ProgID (like JMail.SMTPMail). If you want to check your own server, <a href=”http://www.bier-voting.de/objcheck/query.zip”>download the script</a>! <table border=”0″><tr><td align=”left”><input type=”text” value=”<%=Request(“Classname”)%>” name=”classname” size=40> <INPUT type=”checkbox” id=”nurpositiv” name=”nurpositiv” value=”True”>Show installed components only <INPUT type=”checkbox” id=”descriptions” name=”descriptions” value=”True”<%if ShowDescriptionsWhenInstalled then response.write(” checked”)%>>Show only components with descriptions available </td></tr></table> <INPUT type=submit value=”>> Test <%=Request.ServerVariables(“SERVER_NAME”)%> <<“> 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> </td> <td width=”15%”> <table align=right border=0 cellpadding=1 cellspacing=0 bgcolor=000000> <tr><td align=center> <table border=0 cellpadding=3 cellspacing=0 bgcolor=eeeedd> <tr><td align=center nowrap> Rated: <a href=”http://www.Aspin.com/func/review?id=4813010″><img src=”http://ratings.Aspin.com/getstars?id=4813010″ border=0></a> by <a href=”http://www.Aspin.com”>Aspin.com</a> users </td></tr><tr nowrap><td align=center><form action=”http://www.Aspin.com/func/review/write?id=4222310″ method=post> What do you think? <select name=”VoteStars”><option>5 Stars<option>4 Stars<option>3 Stars<option>2 Stars<option>1 Star</select><input type=submit value=”Vote”> </td></form></tr></table> </td></tr></table> </td> </TR> </TABLE> <div align=”center”> Serif'”>Currently checking for <%= AnzahlComponenten %> components. <% If icount > 0 then %><%= icount %> components installed. <a href=”<%=request.servervariables(“script_name”)%>?AddNew=true&Adddescripti on=true”>Click here to add a new component to this list.</a><% End If %></div> <%= Output %> <%else%><form action=”<%=ListURL%>&adddescription=true” method=”post”><input type=”hidden” name=”classID” value=”<%=MyObjectID%>”> <div align=”center”> <table> <tr> <td>ClassID:<%if trim(request(“AddNew”))<>”” then%><input type=”hidden” name=”AddNew” value=”true”> (like “JMail.SMTP”)<% End If %></td> <td><%if trim(request(“AddNew”))<>”” then%><input type=”text” name=”newClassname” value=”<%=request(“newClassname”)%>” size=”20″><% Else %><%=MyObject%><% End If %></td> </tr> <tr> <td valign=”top”>Description: Explain what the component does!</td> <td><%if isempty(trim(cstr(myObjectdesc))) or myObjectdesc=”” then%><textarea cols=”20″ rows=”5″ name=”description”></textarea><% Else %><%=myObjectdesc%><% End If %></td> </tr> <tr> <td>URL: Where can the User find more information on the new component? </td> <td><%if isempty(trim(cstr(myObjectlink))) or myObjectlink=”” then%><input type=”text” name=”url” value=”http://” size=”20″><% Else %><%=myObjectlink%><% End If %></td> </tr> <tr> <td></td> <td><input type=”submit” name=”submit” value=”submit”></td> </tr> </table></div> </form> <%end if%> <TABLE width=”100%” border=”1″ cellspacing=”0″ cellpadding=”5″ bgcolor=”#FF9933″ bordercolor=”#000000″> <TR> <TD align=”center”> This 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> or <a href=”<%=request.servervariables(“script_name”)%>?AddNew=true&Adddescripti on=true”>click here</a>. <% Else sayerror End If %> </TD> </TR> </TABLE> </body> </html>

Code To Check Components Installed On Server

Leave a Comment Cancel Reply

Related Posts

Leave a Comment Cancel Reply