Code: Server Info

 
Post new topic   Reply to topic    Aprelium Forum Index -> Classic ASP
View previous topic :: View next topic  
Author Message
Dave
-


Joined: 11 Feb 2003
Posts: 184
Location: United Kingdom

PostPosted: Sun Mar 16, 2003 1:03 pm    Post subject: Code: Server Info Reply with quote

Ok, here's some code taken from my website that I wrote to help some people out, let me know if you'd like anything added to it.

Save the following as Test.asp
Code:

<%
' ## ServerTest v2
' ## By Dave hope, http://davehope.digitalrice.com
' ## Copyright (C) 2002-2003 David Hope
' ##
' ## This program is free software; you can 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
' ## any later version. You may NOT re-distribute this software.
' ##                                                                       
' ## 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

'### BEGIN TIMER CODE ###
Dim StopWatch(19)

Sub StartTimer(x)
   StopWatch(x) = timer
End Sub

Function StopTimer(x)
   EndTime = Timer


   If EndTime < StopWatch(x) Then
      EndTime = EndTime + (86400)
   End If

   StopTimer = EndTime - StopWatch(x)
End Function
'### END TIMER CODE ###
%>




<HTML>
<HEAD>
<TITLE>Daves ServerTest</TITLE>

<style type="text/css">
<!--
}
select, option, textarea, input, button{
   background-color: #cococo;
   font-family: verdana;
   font-size: 8pt;
   color: #000000;
   font-weight: plain;
   border-left: 1px solid #000000;
   border-right: 1px solid #000000;
   border-top: 1px solid #000000;
   border-bottom: 1px solid #000000;
}
-->
</style>
</HEAD>

<BODY bgColor="#C0C0C0">


<table border="0" width="750" cellspacing="0" cellpadding="0" align="Center">

<tr>
<td style="border-left-style: solid; border-left-width: 1; border-right-style: solid; border-right-width: 1; border-top-style: solid; border-top-width: 1; border-bottom-width: 1" bordercolor="#000000" bgcolor="#FFFFFF">
<center><b><font face="Verdana" size="2">Installed Components</font></b></center>
</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" style="border-left: 1 solid #000000; border-right: 1 solid #000000; border-bottom: 1 solid #000000">





<Font Face="Verdana" Size="2"><B>Server Processors:</B><%=Request.ServerVariables("Number_OF_Processors")%></Font>
<BR>
<Font Face="Verdana" Size="2"><B>Server Architecture:</B><%=Request.ServerVariables("PROCESSOR_ARCHITECTURE")%></Font>
<BR>
<Font Face="Verdana" Size="2"><B>Server Software:</B><%=Request.ServerVariables("SERVER_SOFTWARE")%></Font>
<BR>
<Font Face="Verdana" Size="2"><B>Server Port:</B><%=Request.ServerVariables("SERVER_PORT")%></Font>
<BR>
<Font Face="Verdana" Size="2"><B>Server Name:</B><%=Request.ServerVariables("SERVER_NAME")%></Font>
<BR>
<Font Face="Verdana" Size="2"><B>Protocall:</B><%=Request.ServerVariables("SERVER_PROTOCOL")%></Font>
<BR>
<Font Face="Verdana" Size="2"><B>VBScript Engine Version:</B><%=Trim("" & ScriptEngineMajorVersion() & "." & ScriptEngineMinorVersion())%></Font>
<BR>
<Font Face="Verdana" Size="2"><B>VBScript Engine Build:</B><%=ScriptEngineBuildVersion()%></Font>
<BR>


<BR>
<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("MSWC.AdRotator")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>MS AddRotator:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("ADODB.Connection")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>MS ADOB:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("CDONTS.Session")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>MS CDONTS:</B> <%=sInstalled%></Font>
<BR>

<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("MSWC.Counters")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>MS Counter:</B> <%=sInstalled%></Font>
<BR>

<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("Scripting.FileSystemObject")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>MS FSO:</B> <%=sInstalled%></Font>
<BR>

<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("MSXML2.ServerXMLHTTP")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>MS Server XMLHTTP:</B> <%=sInstalled%></Font>
<BR>

<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("Microsoft.XMLHTTP")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>MS XMLHTTP:</B> <%=sInstalled%></Font>
<BR>

<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("Persits.MailSender")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>Persists ASPEmail:</B> <%=sInstalled%></Font>
<BR>

<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("Persits.Jpeg")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>Persists ASPJpeg:</B> <%=sInstalled%></Font>
<BR>

<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("Persits.Upload.1")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>Persists ASPUpload:</B> <%=sInstalled%></Font>
<BR>

<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("InetCtls.Inet")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>Internet transfer Control:</B> <%=sInstalled%></Font>
<BR>




<Center><Font Face="Verdana" Size="2"><B>Mail Components</B></Font></Center>
<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("ABMailer.Mailman")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>AABMailer v2.2+:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("SMTPsvg.Mailer")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>ASPMail:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("CDO.Configuration")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>CDOSYS:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("dkQmail.Qmail")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>dkQMail:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("Dundas.Mailer")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>Dundas Mail:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("Geocel.Mailer")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>GeoCel:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("iismail.iismail.1")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>IISMail:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("Jmail.smtpmail")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>JMail:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("MDUserCom.MDUser")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>MDaemon:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("ASPMail.ASPMailCtrl.1")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>OCXMail:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("ocxQmail.ocxQmailCtrl.1")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>OCXQMail:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("SoftArtisans.SMTPMail")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>SA-Smtp Mail:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("SmtpMail.SmtpMail.1")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>SMTP:</B> <%=sInstalled%></Font>

<BR>
<%
Err.Clear
On Error Resume Next
Set obj = Server.CreateObject("VSEmail.SMTPSendMail")
   If Err.Number <> 0 Then
      sInstalled = "<font color=red>Not Installed</font>"
   Else
           sInstalled = "<font color=Green>Installed</font>"
       End If
Set obj = Nothing
On Error Goto 0
%>
<Font Face="Verdana" Size="2"><B>VSEMAIL:</B> <%=sInstalled%></Font>










</td>
</tr>


</table>

<BR>
<BR>



<table border="0" width="750" cellspacing="0" cellpadding="0" align="Center">

<tr>
<td style="border-left-style: solid; border-left-width: 1; border-right-style: solid; border-right-width: 1; border-top-style: solid; border-top-width: 1; border-bottom-width: 1" bordercolor="#000000" bgcolor="#FFFFFF">
<center><b><font face="Verdana" size="2">Server Processing Time</font></b></center>
</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" style="border-left: 1 solid #000000; border-right: 1 solid #000000; border-bottom: 1 solid #000000">
<% StartTimer 1 %>
<Center>
<Textarea Rows="10" Cols="50">
<%
X = 0
Do Until X = 10000
X = X + 1
Response.Write X
Loop
%>
</Textarea>
<BR>
<BR>
<BR>
<Font Size=2 Face=verdana><B>Numbers 1 to 10,000 Processed In:</B> <%= round(StopTimer(1), 4) %> Seconds.</Font>
</Center>









</td>
</tr>
</table>
<BR>
<BR>
<Center>
<Font size="1" Face="Verdana" Color="GRAY">&copy; 2002-<%=Year(Now())%>  David Hope.</Font>
</Center>


</BODY>
</HTML>

_________________
Any information contained herein is provided in "as is" condition without any guarantee for its accuracy, contains no warrantees - express or implied - and confers no rights.
X1 1.1.4: http://www.aprelium.com/news/abwsx1u1.html
Back to top View user's profile Send private message Visit poster's website
DLashley
-


Joined: 18 Dec 2002
Posts: 207
Location: New York, NY

PostPosted: Mon Mar 17, 2003 12:46 am    Post subject: Reply with quote

Dave,

I think I'm going to try out this script you wrote. I'll let you know how it works out. :)

Did you install ASP using the tutorial here at http://www.aprelium.com/abyssws/asp.html ???
_________________
DLashley
Back to top View user's profile Send private message Visit poster's website
awen
-


Joined: 07 Mar 2003
Posts: 12
Location: Earth

PostPosted: Mon Mar 17, 2003 2:58 am    Post subject: Reply with quote

Great app! Kudos Dave!
_________________
Awen - /|\
Back to top View user's profile Send private message Visit poster's website MSN Messenger
vbgunz
-


Joined: 02 Feb 2003
Posts: 615
Location: Florida

PostPosted: Mon Mar 17, 2003 3:18 am    Post subject: Reply with quote

Hey Dave,

If you don't mind me asking what exactly does the script do? Please answer me too or I will fetch ICE' after you and tell the admin... hehe...
_________________
Victor B. Gonzalez
http://aeonserv.com
Back to top View user's profile Send private message Visit poster's website AIM Address Yahoo Messenger MSN Messenger ICQ Number
Dave
-


Joined: 11 Feb 2003
Posts: 184
Location: United Kingdom

PostPosted: Mon Mar 17, 2003 10:20 am    Post subject: Reply with quote

Example: www.philbool.co.uk/Test.asp

DLashley, yea, although I set my asp directory as my htdocs rather than the AHTML one...
_________________
Any information contained herein is provided in "as is" condition without any guarantee for its accuracy, contains no warrantees - express or implied - and confers no rights.
X1 1.1.4: http://www.aprelium.com/news/abwsx1u1.html
Back to top View user's profile Send private message Visit poster's website
Dave
-


Joined: 11 Feb 2003
Posts: 184
Location: United Kingdom

PostPosted: Mon Mar 17, 2003 11:33 am    Post subject: Reply with quote

If anyone is wanting any more scripts, pop by my website, there are a few there and about 2 major(ish) ones...
_________________
Any information contained herein is provided in "as is" condition without any guarantee for its accuracy, contains no warrantees - express or implied - and confers no rights.
X1 1.1.4: http://www.aprelium.com/news/abwsx1u1.html
Back to top View user's profile Send private message Visit poster's website
DLashley
-


Joined: 18 Dec 2002
Posts: 207
Location: New York, NY

PostPosted: Tue Mar 18, 2003 1:36 am    Post subject: Reply with quote

Thanks for the offer, but I think I'd better focus more on learning PHP before I try to tackle ASP.

I'll take a raincheck though... :wink:
_________________
DLashley
Back to top View user's profile Send private message Visit poster's website
Display posts from previous:   
Post new topic   Reply to topic    Aprelium Forum Index -> Classic ASP All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB phpBB Group