Una funzione per testare se un componente è installato sul server.
<% @ Language="VBScript" %>
<% Option Explicit %>
<HTML>
<HEAD>
<TITLE>Test oggetti installati</TITLE>
</HEAD>
<BODY>
<FORM action=<%=Request.ServerVariables("SCRIPT_NAME")%> method=post>
<input type=text value="<%=Request.Form("classname")%>" name="classname" size=40>
<input type=submit value=Test>
</FORM>
<%
Dim strClassDefault
strClassDefault = "FdfApp.FdfApp, ASPSimpleUpload.Upload, Persits.Upload"
Dim strClass
strClass = Trim( Request.Form("classname") )
Dim theInstalledObjects
If ( strClass <> "" ) then
theInstalledObjects = Split( strClass, "," )
Else
theInstalledObjects = Split( strClassDefault, "," )
End If
'Stampo la tabella con gli oggetti
Response.Write("<TABLE border=1 cellpadding=8>")
Dim i
For i=0 to UBound(theInstalledObjects)
Dim currentInstalledObject
currentInstalledObject = Trim( theInstalledObjects(i) )
Response.Write "<TR><TD>" & currentInstalledObject & "</TD><TD>"
If Not IsObjInstalled( currentInstalledObject ) Then
Response.Write "<strong>non installato</strong>"
Else
Response.Write "installato!"
End If
Response.Write "</TD></TR>" & vbCrLf
Next
Response.Write("</TABLE>")
%>
</BODY>
</HTML>
<script language="vbscript" runat="server">
'*******************************************************************************
'** Descrizione : Verifica se un componente è installato sul server
'** Par. In : strClassString -> stringa (es. CDONTS.NewMail)
'** Par. Out : Boolean (true se l'oggetto è installato)
'** Autore : Morpheusweb.it
'** Data : 28/02/2005
'** Versione : V 1.0.0
'*******************************************************************************
Function IsObjInstalled( strClassString )
On Error Resume Next
' inizializzo i valori
IsObjInstalled = False
Err = 0
'(cerco di istanziare l'oggetto e se non ci riesco vuol dire che il componente non è installato)
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString) ' cerco di istanziare l'ogetto
If ( Err = 0 ) Then
IsObjInstalled = True ' se non da errore, restituisco true
End If
' pulisco gli oggetti
Set xTestObj = Nothing
Err = 0
End Function
</script>