Get Network Address using VBScript

Background

Like everyone else took a boat load of CISCO Networking classes.  Took night classes at the local community college.

Forgot about it.

But, then last week a Network Engineer asked me what is my network address and I just did not know.

Yes, I know how to issue ipconfig and get my IP Address and Subnet mask.

Or on Linux, issue ifconfig.

But, to think one step ahead and get the Network Address and CIDR, my mind just did not want to go down that step.

 

Code

Opportunity to code…

 

VBScript



REM *********************************************************************************************

'   1a) http://chris.wastedhalo.com/2014/05/more-binarybitwise-functions-for-vbscript/
    
'   2a) http://www.robvanderwoude.com/vbstech_network_ip.php

'   3a) http://powerasp.net/content/new/vbscript-constants.asp
    
REM *********************************************************************************************

option explicit

Dim strLog

Dim strIPAddress
Dim strIPSubnet
Dim strCIDR
Dim strNetworkAddress
    
Dim strAguments

Dim objAguments
Dim iNumberofArgs 


Const CHAR_PERIOD = "."
    
function getIPAddress

    REM *****************************************************************************
    REM Rob van der Woude's Scripting Page
    REM Win32_NetworkAdapterConfiguration
    REM http://www.robvanderwoude.com/vbstech_network_ip.php
    REM *****************************************************************************
    
    Const strQueryNAC = "select * from Win32_NetworkAdapterConfiguration where MACAddress > ''"
    Const WMISERVICE = "winmgmts://./root/CIMV2"

    Dim objWMISvc
    Dim  objRS
    
    set objWMISvc = GetObject(WMISERVICE)
    
    if objWMISvc is Nothing then
    
        strLog = "Unable to Get Object " & WMISERVICE

        WScript.Echo strLog

        WScript.Quit (-1)
    
    end if

    Set objRS  = objWMISvc.ExecQuery( strQueryNAC, "WQL", 48 )
    
    Dim objItem
    
    For Each objItem In objRS
    
        'IP Address
        If IsArray( objItem.IPAddress ) Then
        
            If UBound( objItem.IPAddress ) = 0 Then
            
                strIPAddress = objItem.IPAddress(0)
        
            Else
            
                strIPAddress = Join( objItem.IPAddress, "," )
            
            End If
        
        End If

    
        'IP Subnet
        If IsArray( objItem.IPSubnet ) Then
        
            If UBound( objItem.IPSubnet ) = 0 Then
            
                strIPSubnet = objItem.IPSubnet(0)
        
            Else
            
                strIPSubnet = Join( objItem.IPSubnet, "," )
            
            End If
        
        End If
        
    Next
    
    
    
end function

'*******************************************************************************
'*     bitMask(BitNumber)
'*         Returns a number with all bits set to 0 except for the specified bit
'*     http://chris.wastedhalo.com/2014/05/more-binarybitwise-functions-for-vbscript/
'*******************************************************************************
Function bitMask(pBit)

    If pBit < 32 Then 

        bitMask = 2 ^ (pBit - 1) 
    
    Else
    
        bitMask = "&H80000000"

    End If
    
End Function



Function Dec2Bin(pValue)

    '*************************************************************************************
    '*     Dec2Bin(AnyNumber)
    '*         Returns a string representing the number in binary.
    '*     http://chris.wastedhalo.com/2014/05/more-binarybitwise-functions-for-vbscript/
    '*************************************************************************************
    Dim TotalBits, i
    
    strLog = VarType(pValue)
    
    Select Case VarType(pValue)
        
        Case vbLong: 
            TotalBits = 32
 
        Case vbString: 
            TotalBits = 32
 
 
        Case vbInteger: 
            TotalBits = 16
        
        Case vbByte: 
            TotalBits = 8
        
        Case Else: 
        
            strLog = "In Function Dec2Bin:: Value passed is " & pValue & vbCrLf
            strLog = strLog + "VarType(pValue) :- " & CSTR(VarType(pValue)) & vbCrLf

            Wscript.Echo strLog
            
            Err.Raise 13 ' Not a supported type
    
            WScript.Quit
            
    End Select

    For i = TotalBits to 1 Step -1
    
        If pValue And bitMask(i) Then
        
            Dec2Bin = Dec2Bin + "1" 
        
        Else 
        
            Dec2Bin = Dec2Bin + "0"
        
        End if
        
    Next

End Function

Function countSpecficChar( strText, chChar)

    Dim iPos
    Dim iLen
    Dim iCharFound
    Dim iCount
    Dim chCharAtPos
    
    iPos = 1
    iCount = 0

    iLen = len(strText)
    
    for iPos = 1 to ILen

        'Get character at position
        chCharAtPos = mid(strText, iPos, 1)

        if (chCharAtPos = chChar) then
        
            iCount = iCount + 1
            
        end if
        
    Next
    
    countSpecficChar = iCount

End Function
    
function getCIDR(strIPSubnet)

    Dim objArr
    Dim strNumber
    Dim iNumber

    Dim strNumberBin
    

    Dim iNumberofOnes
    Dim iNumberofOnesTotal
    
    objArr = Split(strIPSubnet, ".")

    iNumberofOnesTotal = 0
    
    
    for each strNumber in objArr
    
        iNumber = CInt(strNumber)
        
        strNumberBin = Dec2Bin(iNumber)
        
        iNumberofOnes = countSpecficChar(strNumberBin, "1")
        
        iNumberofOnesTotal = iNumberofOnesTotal + iNumberofOnes
        
    next

    getCIDR = iNumberofOnesTotal
    
end function


function getNetworkAddress(strIPAddress, strIPSubnet)

    Dim objArrIPAddress
    Dim objArrIPSubnet

    Dim iIPAddress
    Dim iIPSubnet
    
    Dim strNetworkAddress

    Dim id
    
    Dim idLowerBound
    
    Dim idUpperBound
    
    Dim strLogicalAND
    
    strNetworkAddress = ""

    'Split Numbers into Array   
    objArrIPAddress = Split(strIPAddress, CHAR_PERIOD)
    objArrIPSubnet = Split(strIPSubnet, CHAR_PERIOD)

    id = 0
    
    'Get Number of Octets
    idLowerBound = LBOUND(objArrIPAddress)
    idUpperBound = UBOUND(objArrIPAddress) 

    'Transverse Numbers
    for id = idLowerBound to idUpperBound
    
        iIPAddress = CInt(objArrIPAddress(id))
        
        iIPSubnet = CInt(objArrIPSubnet(id))
        
        strLogicalAND = ( iIPAddress AND iIPSubnet )
        
        'If this is not the first number then add delimeter
        if (strNetworkAddress <> "") Then
        
            strNetworkAddress = strNetworkAddress + CHAR_PERIOD
        
        end if
        
        strNetworkAddress = strNetworkAddress + CSTR(strLogicalAND)
    
    next

    getNetworkAddress = strNetworkAddress
    
end function


'Get List of Arguments 
set objAguments = WScript.Arguments

iNumberofArgs = objAguments.Count

if (iNumberofArgs >0) and (iNumberofArgs <> 2)  Then

    set objAguments = Nothing

    Wscript.Echo "Expected two arguments IP Address & Subnet Mask"
    Wscript.Quit

elseif (iNumberofArgs =2) Then

    strIPAddress = objAguments(0)
    
    strIPSubnet = objAguments(1)
    
else

    call getIPAddress
    
end if


set objAguments = Nothing


strNetworkAddress = getNetworkAddress(strIPAddress, strIPSubnet)

strCIDR = getCIDR(strIPSubnet)

WScript.Echo "IP Address :- " & strIPAddress

WScript.Echo "IP Subnet  :- " & strIPSubnet

WScript.Echo "Network Address :- " & CSTR(strNetworkAddress)

WScript.Echo "CIDR :- " & CSTR(strCIDR)

Invocation

There are two type of invocation.

The first one is to pass along the IP Address and Subnet mask.

And, the other is not pass in any arguments and have the script query the system for its IP Address and subnet mask.

Automatic


cscript networkAddress.vbs

Manual



set _IPAddress=10.0.4.101
set _IPSubnet=255.255.255.128

cscript networkAddress.vbs %_IPAddress% %_IPSubnet%

Output

 

Source Control

GitHub

Link

VBScript – Sample Microsoft Office Access ( MS Access ) App

Background

Here is a code snippet for using VBScript to develop a small application that connects to MS Access database.

BTW, the MS Access database was created using the Create Database Wizard in Access.

Code

Script



option explicit

on error resume next

Dim CONNECTION_STRING
Dim objConn
Dim objRS

Dim strRow
Dim strData

Dim strLog

Const FILE_FOLDER="database\"
Const FILE_NAME="AddressBookDatabase.mdb"
Const PROVIDER="Microsoft.ACE.OLEDB.12.0;"

strData = ""

CONNECTION_STRING = "Provider=" & PROVIDER & ";Data Source=" & FILE_FOLDER & "" & FILE_NAME

strLog = "Connection String :- " & CONNECTION_STRING & vbCrLf
wscript.echo strLog
	
'Define object type
Set objConn = CreateObject("ADODB.Connection")
 
'Open Connection
objConn.open CONNECTION_STRING

if (Err.Number <> 0)  Then

	strLog = ""
	strLog = strLog & "Error" & vbCrLf
	strLog = strLog & "====" & vbCrLf	
	strLog = strLog & vbTab & "Connection String :- " & CONNECTION_STRING & vbCrLf
	strLog = strLog & vbTab & "Error Number :-  " & CSTR(Err.Number) & vbCrLf
	strLog = strLog & vbTab & "Error Description :-   " & CSTR(Err.Description) & vbCrLf
	
	wscript.echo strLog
	
	WScript.Echo vbTab & "Press [ENTER] to continue..."

	' Read dummy input. This call will not return until [ENTER] is pressed.
	WScript.StdIn.ReadLine
	
	WScript.Quit 

end if
 
Dim objFields
Dim iFieldCount
Dim iFieldID

'Define recordset and SQL query
Set objRS = objConn.execute("SELECT * FROM Addresses")
 
Set objFields  = Nothing
 
'While loop, loops through all available results
DO WHILE NOT objRS.EOF

	if (objFields is Nothing) Then
	
		Set objFields = objRS.Fields  

		iFieldCount = objFields.Count
		
	End if	
	
	strRow = ""
	
	'add data delimited by Tabs
	strRow = objRS.Fields("AddressID") & "" _
				& vbTab & objRS.Fields("FirstName") & "" _
				& vbTab & objRS.Fields("LastName") & "" _				
				& vbCrLf

	strData = strData & strRow
	
	'move to next result before looping again
	'this is important
	
	objRS.MoveNext
	'continue loop
	
Loop
 
'Close connection and release objects
objConn.Close
Set objRS = Nothing
Set objConn = Nothing
 
'Return Results via MsgBox
MsgBox strData

Invoke


C:\Windows\SysWOW64\cscript.exe getDataMSAccess.vbs

Output

Output – Good

Output – Failure

Error Description :- Provider cannot be found. It may not be properly installed
Error Number :- 3706

 

Source Control

GitHub

Posted to GitHub here

 

Things to keep in Mind

OLE-DB Provider

As the OLE-DB Provider is 32-bit, on a 64-bit platform force script to run in 32-bit mode by explicitly referencing C:\Windows\SysWOW64\cscript.exe.

Syntax

C:\Windows\SysWOW64\cscript.exe [vbScriptFi<span data-mce-type="bookmark" style="display: inline-block; width: 0px; overflow: hidden; line-height: 0;" class="mce_SELRES_start"></span>le]

Sample Invocation

C:\Windows\SysWOW64\cscript.exe getDataMSAccess.vbs

Active Directory ( AD ) – Get User’s Password Expiration Date ( Using VBScript )

 

Background

Ever so often my Active Directory Account expiration date sneaks up on me.

And, I will like to proactively know ahead of time.

 

Code

Looked for code and here is one I found from here and there on Net.

VBScript


OPTION EXPLICIT


REM ***********************************************************

REM Referenced Work: 

'	REM Binding to Active Directory objects with the LDAP provider
'	REm http://www.rlmueller.net/LDAP_Binding.htm

'	REM Get the Distinguished Name for an Active Directory Object
'	REM https://gallery.technet.microsoft.com/scriptcenter/1a7111e3-3c15-4e29-ac3b-84d3ac46bd4c

'	REM How to find the Active Directory Path
'	REM https://leonelson.com/2010/09/08/how-to-find-the-active-directory-path/     

'	REM Power ASP VBscript Constants
'	REM http://powerasp.net/content/new/vbscript-constants.asp

'	REM VBScript Quit
'	REM https://ss64.com/vb/quit.html

REM ***********************************************************

REM on error resume next



Function distinguish(strObject, strType) 

    REM Get the Distinguished Name for an Active Directory Object
    REM https://gallery.technet.microsoft.com/scriptcenter/1a7111e3-3c15-4e29-ac3b-84d3ac46bd4c
    
    Dim objRootDSE
    Dim strDNSDomain
    Dim objConnection
    Dim objCommand
    Dim objRecordSet
    
    Select case strType 
        Case lcase("computer") 
            strobject = strobject & "$" 
        Case lcase("user") 
            'Good 
        Case lcase("group") 
            'Good 
        Case else 
            Wscript.Echo "Their is an error in the script" 
    End Select 
    
    ' Determine DNS domain name (this could be hard coded). 
    Set objRootDSE = getObject("LDAP://RootDSE") 
    strDNSDomain = objRootDSE.get("defaultNamingContext") 
     
    Const ADS_SCOPE_SUBTREE = 2 
     
    Set objConnection = createObject("ADODB.Connection") 
    Set objCommand = createObject("ADODB.Command") 
    objConnection.Provider = "ADsDSOObject" 
    objConnection.Open "Active Directory Provider" 
     
    Set objCOmmand.ActiveConnection = objConnection 
    objCommand.CommandText = _ 
    "Select distinguishedname, Name, Location from 'LDAP://" & strDNSDomain & _ 
    "' Where objectClass='" & strType & "' and samaccountname='" & strObject & "'" 
    objCommand.Properties("Page Size") = 1000 
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE  
    Set objRecordSet = objCommand.execute 
    objRecordSet.MoveFirst 
     
    Do Until objRecordSet.EOF 
       distinguish = objRecordSet.Fields("distinguishedname") 
       objRecordSet.MoveNext 
    Loop 
    
End Function    

Function Integer8Date(ByVal objDate, ByVal lngBias)

    ' Function to convert Integer8 (64-bit) value to a date, adjusted for
    ' local time zone bias.
    Dim lngAdjust, lngDate, lngHigh, lngLow
    lngAdjust = lngBias
    lngHigh = objDate.HighPart
    lngLow = objdate.LowPart
    ' Account for error in IADsLargeInteger property methods.
    If (lngLow < 0) Then
        lngHigh = lngHigh + 1
    End If
    If (lngHigh = 0) And (lngLow = 0) Then
        lngAdjust = 0
    End If
    lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
        + lngLow) / 600000000 - lngAdjust) / 1440
    ' Trap error if lngDate is ridiculously huge.
    On Error Resume Next
    Integer8Date = CDate(lngDate)
    If (Err.Number <> 0) Then
        On Error GoTo 0
        Integer8Date = #1/1/1601#
    End If
    On Error GoTo 0
    
End Function


Function ADPasswordAge

	'========================================
	' First, get the domain policy.
	'========================================

    REM http://www.rlmueller.net/Programs/PwdLastSet.txt

    Dim objRootDSE
    Dim strDNSDomain
    Dim objDomain
    Dim objMaxPwdAge
    
    Dim lngHighAge
    Dim lngLowAge
    Dim sngMaxPwdAge
    
    REM http://www.rlmueller.net/Programs/PwdExpires.txt
    ' Determine domain maximum password age policy in days.
    Set objRootDSE = GetObject("LDAP://RootDSE")
    
    strDNSDomain = objRootDSE.Get("DefaultNamingContext")
    
    Set objDomain = GetObject("LDAP://" & strDNSDomain)
    Set objMaxPwdAge = objDomain.MaxPwdAge
    
    ' Account for bug in IADslargeInteger property methods.
    lngHighAge = objMaxPwdAge.HighPart
    lngLowAge = objMaxPwdAge.LowPart
    If (lngLowAge < 0) Then
        lngHighAge = lngHighAge + 1
    End If
    
    ' Convert from 100-nanosecond intervals into days.
    sngMaxPwdAge = -((lngHighAge * 2^32) _
                    + lngLowAge)/(600000000 * 1440)

                    
    ADPasswordAge = sngMaxPwdAge
    
End Function


Function localTimeBiasFromRegistry()


	' Retrieve user password information.
	' The pwdLastSet attribute should always have a value assigned,
	' but other Integer8 attributes representing dates could be "Null".
	' http://www.rlmueller.net/Programs/PwdLastSet.txt

    dim lngBias
    
    ' Obtain local time zone bias from machine registry.
    ' This bias changes with Daylight Savings Time.
    Dim objShell
    Dim lngBiasKey
    Dim k
	
	Const REGISTRY_KEY_ActiveTimeBias = "HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias"
	
    Set objShell = CreateObject("Wscript.Shell")
    
	lngBiasKey = objShell.RegRead( REGISTRY_KEY_ActiveTimeBias)
	
    If (UCase(TypeName(lngBiasKey)) = "LONG") Then
        lngBias = lngBiasKey
    ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
        lngBias = 0
        For k = 0 To UBound(lngBiasKey)
            lngBias = lngBias + (lngBiasKey(k) * 256^k)
        Next
    End If  
    
    localTimeBiasFromRegistry = lngBias

end function


function getUsername()

	Dim strUserName

	set objNetwork = CreateObject("WScript.Network")

		strUserName = objNetwork.UserName
		
	set objNetwork = Nothing

	getUsername = strUserName

end function


Dim objUser
Dim maxPwdAge
Dim numDays

Dim strDomainDN
Dim strOrganizationUnit
Dim strRelativeDistinguishedNameofContainer
Dim strDistinguishedNameSuffix
Dim strDistinguishedName
Dim strUser
Dim objNetwork
Dim strUserName
Dim strUserDN

Dim strLog

dim objDatePwdLastSet
dim dtmPwdLastSet
dim lngBias

Dim sngMaxPwdAge

Dim dtPasswordExpiry  

Dim strLDAP

Const PROTOCOL_IDENTIFIER_LDAP  = "LDAP://"   

strUserName = getUsername()

strDistinguishedName = distinguish(strUserName, "user")                         

strUserDN = PROTOCOL_IDENTIFIER_LDAP & strDistinguishedName
              
strLog = "strUserDN :- " + strUserDN

WScript.Echo strLog


strLDAP = strUserDN

Set objUser = GetObject(strUserDN)

if (objUser is Nothing) Then

    strLog = "GetObject failed on " & strLDAP
                    
    WScript.Echo strLog 

    strLog = "Err.Number is " _
                    & CSTR(Err.Number) _
                    & " & " _
                    & "Error Description is " & Err.Description _
                    & vbCr                      
                    
                    
    WScript.Echo strLog

    WScript.Quit 

end if

lngBias = localTimeBiasFromRegistry

If (TypeName(objUser.pwdLastSet) = "Object") Then

    Set objDatePwdLastSet = objUser.pwdLastSet
    
    dtmPwdLastSet = Integer8Date(objDatePwdLastSet, lngBias)
    
Else

    dtmPwdLastSet = #1/1/1601#
    
End If

strLog = "dtPwdLastSet :- " & CSTR(dtmPwdLastSet)

WScript.Echo strLog

sngMaxPwdAge = ADPasswordAge()

strLog = "sngMaxPwdAge :- " & CSTR(sngMaxPwdAge)
    
WScript.Echo strLog

dtPasswordExpiry = DateAdd("d",sngMaxPwdAge,dtmPwdLastSet) 

strLog = "dtPasswordExpiry " & CSTR(dtPasswordExpiry)
    
WScript.Echo strLog

'========================================
' Clean up.
'========================================
Set objUser = Nothing

Set maxPwdAge = Nothing


Invoke


cscript passwordExpirationDate.vbs

Output

Output – Image #1

Output – Image #2

 

GitHub

DanielAdeniji/ActiveDirectoryGetAccountPasswordExpirationDate
Link

Dedicated

Dedicated To …

  1. Richard Mueller ( Microsoft MVP )
  2. Devin H.
    • Get the Distinguished Name for an Active Directory Object
      Link

Windows – Windows Script Host/VBScript – Getting Full Name of Network User

Background

Here I am with a Network Logon, but no corresponding Fullname.

 

Windows AD Tools

Depending on the version of Windows, we can quickly put together a script for getting the information.


      dsquery user -name joe | dsget user -display

 

If invalid username, you will get :


    dsget failed:'Target object for this command' is missing

 

If valid user, you will get something such as :


  display
  Adeniji, Daniel

 

Code

VBScript

Here is a VBscript for doing same:

 

 

Option Explicit
Dim strADDomain
Dim strUserName
Dim strUserNameCurrent
Dim objWshShell
Dim strObjectData
Dim strNameNotFound
Dim iCommandLineArgCount
Dim objUser

Const CommandLineArgCountExpected = 1
Const ERR_InvalidProcedureCallORArgument = 5

Const OBJECT_REF_SYNTAX = "WinNT://{0}/{1}"
Const ERR_NAME_NOT_FOUND = "Not not found Domain {0} / User {1}"

rem SQL string formatting in VBScript
rem PEOPLE AREN'T LOOKING FOR WEBSITES, THEY'RE LOOKING FOR ANSWERS.
rem http://lutrov.com/blog/sql-string-formatting-in-vbscript
function fmt(str, args())
   dim res, i
   res = str
   for i = 0 to ubound(args)
      res = replace(res, chr(123) & cstr(i) & chr(125), cstr(args(i)))
   next
   fmt = res
end function

REM *******************************************************************
Rem MS Windows Shell Environment Variables
REM *******************************************************************
Set objWshShell = WScript.CreateObject( "WScript.Shell" )

	strADDomain = objWshShell.ExpandEnvironmentStrings( "%USERDOMAIN%" )

	strUserNameCurrent = objWshShell.ExpandEnvironmentStrings( "%USERNAME%" )

set objWSHShell = Nothing

REM *******************************************************************
Rem Get Command Line Arguments
REM *******************************************************************
iCommandLineArgCount = WScript.Arguments.Count

if (iCommandLineArgCount = CommandLineArgCountExpected) Then

	strUserName = WScript.Arguments.Item(0)

else

	Err.Raise ERR_InvalidProcedureCallORArgument ' Invalid procedure call or argument

end if

REM *******************************************************************
Rem If arguments not passed in, then assume for current user
REM *******************************************************************
if (strUserName = "") Then

	strUserName = strUserNameCurrent

end if

rem strObjectData = "WinNT://" & strADDomain & "/" & strUserName
strObjectData = fmt(OBJECT_REF_SYNTAX, array(strADDomain, strUserName))

rem (null): The network path was not found.
on error resume next

	Set objUser = GetObject(strObjectData)

on error goto 0

rem display full name
if IsObject(objUser) Then

	Wscript.Echo objUser.FullName

else

	strNameNotFound = fmt(ERR_NAME_NOT_FOUND, array(strADDomain, strUserName))

	Wscript.Echo strNameNotFound

end if	

rem free object
if IsObject(objUser) Then

	Set objUser = Nothing

end if

 

 

To try things out:

 


    cscript getUserFullName.vbs dadeniji

 

 

References

VBScript

 

 

 

Summary

How poetic justice is that?

I bemoaned “On error resume next”, Microsoft – Classic ASP – Error Suppressed, barely a week gone by.  And, now I need it to avoid a missing AD Entry warning.

But, nevertheless when used, quickly close it out with an “on error goto 0“.

 

Microsoft – Classic ASP – Error Suppressed

Background

The last few weeks I have been battling with a Vendor application that uses a mix of Classic ASP and ASP.Net.  Not to keep the beating to myself, I will like to share some of my bruised ego.

 

Code

Classic ASP

We will focus on the Classic ASP code.  There are many reasons for this singular focus; and inclusive:

  • Historical
    • Classic ASP was introduced in 1996
    • It was Microsoft’s first server side scripting engine for generating web pages
  • Tooling
    • It is based on VBScript and JScript
    • ASP 2.0 provided six built-in objects: Application, ASPError, Request, Response, Server, and Session
    • It has being in support for accessing COM and Dlls

 

As a tool developed in 1996,  almost 20 years ago, it is increasingly difficult to elegantly support it.

 

Sample Code

Let us create a sample app

 


<html>
<head>
<title>
Err Suppressed
</title>
</head
<@% Page Language=VBScript 	Explicit=True Debug=True %>
<% Response.Buffer = True %>
<!--#include file="errorHandler/errorHandler.inc"-->

<%

	Const ERR_HANDLER_CUSTOMIZED = "/errorHandler/errorHandler500Customized.asp"

	Const ERR_TYPE_DIVIDEBYZERO = 1
	Const ERR_TYPE_OBJECT_INVALIDMETHOD = 2
	Const ON_ERROR_RESUME_NEXT = false
	Const ON_ERROR_PROCEED_ERRORHANDLERPAGE = false

	dim strDate
	dim iNumberofEntries
	dim objDictModule
	dim allKeys
	dim allItems
	dim dictKey
	dim dictItem
	Dim i
	Dim iMax	

	dim objNullObject
	dim objErr

	dim numerator
	dim divisor
	dim result

	dim strItem
	dim iErrType

        dim strPagename

        strPagename = Request.ServerVariables("SCRIPT_NAME") 

        if (ON_ERROR_RESUME_NEXT) then

		On error resume next

	end if

	iErrType = ERR_TYPE_OBJECT_INVALIDMETHOD
	iErrType = ERR_TYPE_DIVIDEBYZERO

	if (iErrType = ERR_TYPE_DIVIDEBYZERO) then

		numerator = 1000
		divisor = 0
		result = a / b

	elseif (iErrType = ERR_TYPE_OBJECT_INVALIDMETHOD) then

		objNullObject.Sleep()

	end if

	set objErr = Err

	set objDictModule = getErrorObjectAsDictionary(objErr)

	set Session(ERR_OBJECT_CUSTOM) = objDictModule

	if ( (Err.Number <> 0) and (ON_ERROR_PROCEED_ERRORHANDLERPAGE = true) ) Then

           'store calling page name
           Session(ERR_OBJECT_CUSTOM).add "Err.Referrer", strPagename

           Response.Redirect ERR_HANDLER_CUSTOMIZED

	end if

%>

 

In the code above, we have intentionally added the usual suspects; that is things we know will cause trouble:

  • Divide by 0
  • Reference a null object ( objNullObject.Sleep )

 

IIS Configuration – ASP

Let us make sure that IIS is sufficiently for debugging ASP.

  • Via “Control Panel” \ “Administrative Tools” \ Internet Information Services (IIS) Manager
    • In the left panel, Under Sites, Select the Web Site
    • In the right panel, make sure that the Features View is active
    • In the Features view, within the IIS panel, select ASP

 

Features View

FeaturesView

 

ASP Configuration

ASP

 

The important configurable items are:

  • Debugging Properties – Set to True
    • Calculate Line Numbers
    • Catch COM Component Exceptions
    • Enable Client-side debugging
    • Enable Log Error Requests
    • Enable Server-side Debugging
    • Log Errors to NT Log
    • Send Errors to Browser
  • Script Language
    • VBScript

 

Error Message

Upon launching a Web Browser, IE in this case, we run into a ditch.

Here is what we get:

HTTP500

 

Not a very intuitive error message as we had “Show Friendly HTTP error messages“.

Current Setting:

ShowFriendlyHTTPErrorMessages

 

More Intuitive Message

Via “Internet Options”, we turned off “Show friendly HTTP error messages”.

And, we now have a good error number,  error message, and source file name & offending line number.

Error-Overflow

 

 

 IIS Log

IIS Logs also contain helpful data.

IISLog-Overflow

 

Our IIS Log contains definite and helpful error; here they are:

  • We have .Net CLR2 and CLR3 installed
  • Our error line is 57
  • Our error code is 800a006
  • Our error description is Overflow

 

 

Sample Code – “On Error Resume Next”

Let us change the code a bit by setting “On error resume next

 


    'Const ON_ERROR_RESUME_NEXT = false
     Const ON_ERROR_RESUME_NEXT = true

Once we set “On error resume next”, our error is no longer visible …

Browser – IE

Error-OnErrorResumeNext

Browser - IISLog

Checked IISLog, and no errors registered

IISLog-ErrSurpressed 

Error Handling

It is obvious that silencing our errors is a bit problematic; as we still have them, but we are not aware of them. Furthermore, the work we greatly want to do, is yet undone. Let us handle our error, and send the user to an informative error page.

 


    'Const ON_ERROR_PROCEED_ERRORHANDLERPAGE = false
    Const ON_ERROR_PROCEED_ERRORHANDLERPAGE = true

 

As we have now indicated that we want to handle our error, though it is silent, we wrote additional modules:

ErrSuppressed.asp

Classic ASP supports a couple of ways to organize code, source code modules & Com components.  In this post, we will take the quick and simple path of having the code in an included file (errorhandler/errorHandler.inc).

Though not required, we placed in its own folder, as well.

 


  <!--#include file="errorHandler/errorHandler.inc"-->

 

errorHandler/errorHandler.inc

Here is our included file.


<%

Const ERR_OBJECT_CUSTOM = "customErrorCollection"

Function getErrorObjectAsDictionary (objErr)

     Dim objList
     Dim objASPError

     Set objList = CreateObject("Scripting.Dictionary")
     objList.add "Err.Number", objErr.Number
     objList.add "Err.Description", objErr.Description

     set objASPError = Server.GetLastError()

     objList.add "ASPError.ASPCode", objASPError.ASPCode
     objList.add "ASPError.ASPDescription", objASPError.ASPDescription
     objList.add "ASPError.Description", objASPError.Description
     objList.add "ASPError.Source", objASPError.Source
     objList.add "ASPError.Number", objASPError.Number
     objList.add "ASPError.File", objASPError.File
     objList.add "ASPError.Line", objASPError.Line

     rem we used set as objList is an object and not a simple datatype (int\string)
     Set getErrorObjectAsDictionary = objList

End Function

%>

 

The errorHandler.inc is an interesting code-line:

  • We are a generic collection object (Scripting.Dictionary)
  • We captured both the err.number and err.description properties into our collection
  • We also performed a Server.GetLastError call and captured the resultant object’s property, as well
  • Noticed that we used set at the end of the function to return a complex object

 

 

errorHandler/errorHandler500Customized.inc

 


<html>
<head>
<title>
Err Handler - 500 - Customized
</title>
</head>

<@% Page Language=VBScript 	Explicit=True Debug=True	EnableSessionState=True	%>
<!--#include file="errorHandler.inc"-->

<body>

<%

	 Dim objError
	 Dim objDictModule
	 Dim errNumber
	 Dim errDescription

	 Dim objErr
	 Dim objErrDict

	 Dim strBuffer
	 Response.Clear

%>
<table border="1">
<tbody>
<tr>
<td>
<table border="0" width="653">
<tbody>
<tr style="background-color: #ff9900;">
<td colspan=3 col align='center'><strong>Error Items</strong></td>
</tr>
<tr style="background-color: Gainsboro;">
<td>&nbsp;</td>
<td><strong>Item</strong></td>
<td><strong>Value</strong></td>
</tr>
<!--
	Access Err Object
-->
<tr style="background-color: beige;">
<td>&nbsp;</td>
<td><strong>Err.Number</strong></td>
<td><strong><%= CSTR(Err.Number) %></strong></td>
</tr>
<tr style="background-color: beige;">
<td>&nbsp;</td>
<td><strong>Err.Description</strong></td>
<td><strong><%= Err.Description %></strong></td>
</tr>
<%

	strBuffer = ""
	CONST COLOR_ROW = "beige"
	CONST COLOR_ROW_ALTERNATE = "blanchedalmond"

	Dim strRowColor
	Dim strItem

	If isObject(Session(ERR_OBJECT_CUSTOM)) = false then

	else

		set objDictModule = Session(ERR_OBJECT_CUSTOM)

		if (objDictModule is Nothing) Then

		else

			'retrieve all the keys and items from the Dictionary and print them out
			allKeys = objDictModule.Keys   'Get all the keys into an array
			allItems = objDictModule.Items 'Get all the items into an array 

			For i = 0 To objDictModule.Count - 1 'Iterate through the array

			  dictKey = allKeys(i)   'This is the key value
			  dictItem = allItems(i) 'This is the item value

			  if ( (i mod 2) = 0) then
				strRowColor = COLOR_ROW
			  else
			    strRowColor = COLOR_ROW_ALTERNATE
			  end if	

			  strItem = "
<tr style='background-color: " & strRowColor & "';>"
			  strBuffer = strBuffer & strItem

			  strItem = "
<td>" & cstr(i+1) & "</td>
"
			  strBuffer = strBuffer & strItem

			  strItem = "
<td>" & dictKey & "</td>
"
			  strBuffer = strBuffer & strItem

			  strItem = "
<td>" & dictItem & "</td>
"
			  strBuffer = strBuffer & strItem

			  strItem = "</tr>
"
			  strBuffer = strBuffer & strItem

			Next

		end if

	end if

	Response.Write strBuffer

%></tbody>
</table>
&nbsp;</td>
</tr>
</tbody>
</table>
&nbsp;

</body>
</html>

%>

 

 Explanation:

Here is a quick explanation

  • We checked Err.Number and Err.Description
  • We checked the Session Object that was “set” in the previous page
  • Notice the use of IsObject to ensure that our session variable is previously set

 

 

Browser Output:

 

errorHandlerCustomizedOutput

 

 

From the screen above, we will notice a few things:

  • We lost our original error; that is why when the new page calls err.number and err.description we have 0 and empty
  • Thankfully, our session data was preserved

 

Summary:

It appears that when we use “on error resume next” and post to another page, our err object ( Err.Number and Err.Description ) is automatically reset.

 

Application Level

Configuration

Web.config

From the example above, we can see that the “on error resume next” statement, prevents error trapping through code.

What about error trapping that is implicitly handled in web.config

 

GUI

Edit Custom Error Page:

Here is how to configure Error Page via “IIS Management Console”

customErrorPage

 

 

Error Message

In our case, we tweaked our website’s configuration quite a bit. We reviewed and played around with the Application Pool and the actual web site.

Error Text:

Error Message: This site is in an application pool that is running in Classic mode. When running in this mode, custom errors apply to all content except ASP.Net content.

Error Image:

customErrorsAndApplicationPool

 

The error message hints that we need to change our Application Pool’s managed pipeline from Classic to Integrated.

 

Application Pool

ApplicationPool - MangedPipelineMode - Integrated

 

Error Pages – Feature Settings

It is also important that we set/review the default “Error Pages” settings.

 

CustomErrorPage - Edit Features

 

We want to set “Error Page Settings” / “Custom Error Pages” to “Custom error pages”.

If set to :

  • Detailed errors (everyone sees the detailed errors)
  • Detailed errors for local requests and custom error pages for remote requests ( when viewed locally on the web server one sees the detailed error message; and when viewed away from the web server, one sees our custom error page)

 

Source Code

Here is what our web.config looks like:

 


<?xml version="1.0" encoding="UTF-8"?>
<configuration>

    <system.webServer>

		<defaultDocument>
            <files>
                <add value="ErrSupressed.asp" />
            </files>
        </defaultDocument>

		<tracing>
            <traceFailedRequests>
                <remove path="*" />
                <add path="*">
                    <traceAreas>
                        <add provider="ASP" verbosity="Verbose" />
                        <add provider="ASPNET" areas="Infrastructure,Module,Page,AppServices" verbosity="Verbose" />
                        <add provider="ISAPI Extension" verbosity="Verbose" />
                        <add provider="WWW Server" areas="Authentication,Security,Filter,StaticFile,CGI,Compression,Cache,RequestNotifications,Module,FastCGI" verbosity="Verbose" />
                    </traceAreas>
                    <failureDefinitions timeTaken="00:00:00" statusCodes="100-999" />
                </add>
            </traceFailedRequests>
        </tracing>

        <httpErrors errorMode="Custom">
            <remove statusCode="500" subStatusCode="-1" />
            <error
		statusCode="500"
		prefixLanguageFilePath=""
		path="/errorHandler/errorHandler500Customized.asp"
		responseMode="ExecuteURL"
		/>
        </httpErrors> 

    </system.webServer>

</configuration>

 

Explanation:

There are a few things going on in the web.config file indicated above; and those are:

  • We are using our great friend – traceFailedRequests; whenever an error occurs an XML file is generated
  • We are using trapping on HTTPErrors
    • We are using ErrorMode is Custom :- This is we have our our own custom code
    • HTTP Error = 500
      • We call /errorHandler/errorHandler500Customized.asp
      • responseMode = ExecuteURL

 

 

Once we add a web.config page, we will have instituted an Application wide error handling pathway.

The Application wide pathway will work for all cases, except when “on error resume next” is in-effect.

 

How do we test?

How do we investigate whether we can handle errors implicitly?

We will remove “on error resume next”.

Const ON_ERROR_RESUME_NEXT = false
rem Const ON_ERROR_RESUME_NEXT = true

 

Just-In-Time Debugger:

JustInDebugger

 

We will not trod down the Debugging trek; and so we will skip initiating the debugger by choosing “No, cancel debugging“.

 

Here is what we see when a code error and IIS itself triggers our error page

errorHandlerCustomizedOutput-Generic

 

Explanation

We can see that we have lost useful error data.  Earlier we preserved them by saving them to session variables and then transferring processing to the Error Page.

Spent all weekend trying to get to them when IIS auto-invokes the error page, but not smart enough.

 

On error goto 0

“On error goto 0” return us back to sanity.  I will suggest that for each “on error resume next”, a corresponding  “on error goto 0” be added as a complement.

 

Exception Handling

Modern languages idiom rely on try/catch/finally exception paradigm.

 

Source Control

Github

To make it easier to share and review our simple App, we have place it on Github.

https://github.com/DanielAdeniji/ClassicASPOnErrorResumeNext

 

Where did Classic ASP come from?

Accordingly to Wikipedia, Classic ASP was introduced as part of NT Option Pack in 1996.  And, discontinued 4 years later in 2000.

NT Option Pack is one of the most important product release from Microsoft.  Keeping in mind that it was a midterm release between Windows NT 4.0 and Windows 2000, and Microsoft was trying to stem the tide of competing products; and so everything along with the Kitchen Sink and the proverbial workman’s hamburger was included.

According to Windows NT Option Pack, here is what was bundled within it:

  • Certificate Server – Microsoft Certificate Server provides customization services for issuing and managing certificates used in software security systems employing public-key cryptography.
  • FrontPage Server Extensions
  • Index Server – It allows you to easily perform full-text searches and retrieve all types of information from any Web browser.
  • Internet Connection Services for RAS – Remote Access Service
  • Internet Information Server (IIS) version 4.0
  • Mail and News Services – Microsoft SMTP Service uses the standard Internet protocol Simple Mail Transfer Protocol (SMTP) to transport and deliver messages
  • The Microsoft NNTP Service – Newsgroup
  • The Microsoft Data Access Components (MDAC) – ActiveX Data Objects and the Microsoft Access driver
  • Microsoft Management Console (MMC) – Uniform interface for managing server application
  • Microsoft Message Queue Server (MSMQ) – communicate with other application programs quickly, reliably, and asynchronously by sending and receiving messages
  • Microsoft Transaction Server (MTS) – component-based transaction processing system for developing, deploying, and managing high-performance, scalable, and robust applications
  • Site Server – Comprehensive Web site environment for enhancing, deploying, and managing rich intranet and Internet Web sites
  • Microsoft SNA Server – comprehensive gateway and application integration platform that enables communications with midrange ( AS/40)0 and mainframe systems
  • Windows Script Host – a language-independent scripting host for ActiveX™ scripting engines

 

Dedicated

Once again, I will dedicate this post to a public commit-er, former Microsoft engineer, Eric Lippert. I referenced an important blog post by him in the Reference section below.

Eric blogs @ http://ericlippert.com/ and he has an interesting post @ “Eric Lippert Dissects CVE-2014-6332, a 19 year-old Microsoft bug” ( http://security.coverity.com/blog/2014/Nov/eric-lippert-dissects-cve-2014-6332-a-19-year-old-microsoft-bug.html )

 

Summary

For a product released in 1996 and deprecated in 2000; ASP has obvious staying power.

For the sake of the numerous companies and products that continue to rely on it, I wish keen attention, knowledge and courage.

For sustenance engineers, keep an eye out for “On error resume next“.

References

Configuration

Reference – httpErrors and customErrors

 

customErrors

Microsoft

Blog and Q/A

 

IIS – Custom Errors – Sample Code

Microsoft

ASP.Net

 

3rd Party Vendor

Q/A

 

Storing & Transfering Data

 

Collection Object

Dictionary Object

 

Session Variables

 

Context

 

ASP

Best Practices

ASP Error Handling – Reference

 

ASP Error Handling – Sample

 

Including File

 

Test Object

 

 

ASP.Net

Error Handling

 

Page Transition

Move to new page

Response.Redirect

Server.Transfer

 

 

“On Error Resume Next ” Stories