Programalama > ASP


Ort. 0
Puan ver:
<%@ 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> 



Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2019 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.