CODEWITHSUNDEEP
sql-servervbscriptasp-classic
Paul McGee
Paul McGee

Reputation: 43

VBScript Runtime Error '800a000d'

In our business, we use a security wizard to control and administer active directory security and also to have an audit trail of changes made. This is a SQL database with an ASP front end, which also has communication to our Active Directory.

The person who wrote the wizard has since our site to work for another part of the company and I am attempting to get something working which is broken.

A simple overview of the system is:

  1. User submits a request to an authoriser, who then accepts or rejects the request for the user in question to be granted access to the folder/resource
  2. If the authoriser accepts the request, he then opens up the wizard and authorises it - an email is sent to IT for us to grant the access
  3. After we have granted the access we then tick a box in the wizard which emails both the user and the authoriser informing them of the granted access

Part of this system gives the authorisers of the folders/resources to do a check of which users have access to their authorising folders. This has been working well, until we have changed the naming standard of our folders:

Old naming standard - "BusinessFolderPurpose" e.g. "BakerHumanResources" New naming standard - "Business - Site - Server Location - Folder Purpose" e.g. "Baker - England - Server123 - Human Resources"

When the users are attempting to use the part of the wizard which shows them who has access they are now reciecing the following error message:

Microsoft VBScript runtime error '800a000d'

Type mismatch: 'ubound'

/Saw/list_grp_mem.asp, line 18

I suspect the issue is that the new folder naming convention has hypens in it which is causing a problem - but unforuntaltey I am not able to fix it depsite numerous attempts looking at it and much Googling around.

Line 18 is:

iRowNumber = ubound(GroupArray,2)

The full code for the list_grp_mem.asp page is:

<!--#include file = "database/database.asp"-->
<%

WriteHTMLHeader("Security Access Wizard")
VarUser = Request.ServerVariables("AUTH_USER")
VarUser =(Right(VarUser,(len(VarUser)-instr(VarUser,"\")))) 
StrGroupName = Request.Form("SecurityGroup")

'-----------------------------------------------------------------------------
'Generate Group Membership Listing From Group Passed via StrGroupName
'-----------------------------------------------------------------------------
If Not IsEmpty(StrGroupName) Then
    
    GroupArray = QueryADGroup("distinguishedName",strGroupName)
    If IsEmpty(GroupArray) Then
        Response.Write "No Group Found"
        Else
            iRowNumber = ubound(GroupArray,2)
            if iRowNumber = 0 Then
            GroupDN =  GroupArray(0,0)
            
            Set RsGroupName = Server.CreateObject("ADODB.RecordSet")
            StrSql = "SELECT Company.Description AS Comp_Desc, SecurityGroups.Description AS Sec_Desc, SecurityGroups.SecurityGroup " & _
                     "FROM Company INNER JOIN SecurityGroups ON Company.Company = SecurityGroups.Company " & _
                     "WHERE SecurityGroups.SecurityGroup = '" & StrGroupName & "'"
            RsGroupName.open StrSql,objConn
            Do While NOT RsGroupName.EOF
                Response.Write "<h2>Group Membership For: " & RsGroupName("Comp_Desc") & " - " & RsGroupName("Sec_Desc") & "</h2>" & vbcrlf
                RsGroupName.MoveNext
            Loop
            RsGroupName.Close
            Else
                Response.Write "No Group Found"
            End If
    End If

    arrGrpMem = QueryADUsers("GroupsMembers",GroupDN)
    If IsEmpty(arrGrpMem) Then
        Response.Write "Error Group Not Found"
    Else
        iRowNumber = ubound(arrGrpMem,2)
        If iRowNumber = 0 Then
            Response.Write "Group Currently Has No Members"
        Else
            Response.Write "<table class=" & chr(34) & "Req" & Chr(34) & ">" & vbcrlf
            Response.Write "    <tr>"  & vbcrlf
            Response.Write "        <td class=" & chr(34) & "ReqHead" & Chr(34) & "> Name  </td>" & vbcrlf
            Response.Write "        <td class=" & chr(34) & "ReqHead" & Chr(34) & "> E-Mail </td>" & vbcrlf
            Response.Write "    </tr>"  & vbcrlf
            For iCounter = 0 To iRowNumber
                If Not IsNull(arrGrpMem(3,iCounter)) Then
                    If Instr(arrGrpMem(3,iCounter),"ZZ") = 0  Then
                        Response.Write "    <tr>"  & vbcrlf
                        Response.Write "        <td class=" & chr(34) & "ReqLeft" & Chr(34) & "> " & arrGrpMem(3,iCounter) & " " & arrGrpMem(4,iCounter) & " </td>" & vbcrlf
                        Response.Write "        <td class=" & chr(34) & "ReqLeft" & Chr(34) & ">(" & arrGrpMem(6,iCounter) & ") </td>" & vbcrlf
                        Response.Write "    </tr>"  & vbcrlf
                    End If
                End If
            Next
                Response.Write "</table>" & vbcrlf
        End If
    End If
End IF

'-----------------------------------------------------------------------------
'Generate Option Box For Groups For Which User Is A Designated Authoriser
'-----------------------------------------------------------------------------
If IsEmpty(StrGroupName) Then   
    Response.Write "<h2> Group Membership Report</h2>" & vbcrlf
    Response.Write "<p><b> Please select the area you require a membership report for</b>" & vbcrlf
    Response.Write "<form action=" & chr(34) & "list_grp_mem.asp" & chr(34) & " method=" & chr(34) & "post" & chr(34) & ">" & vbcrlf
    Response.Write "<select name=" & chr(34) & "SecurityGroup" & Chr(34) & ">"
    Set RsAuthGroups = Server.CreateObject("ADODB.RecordSet")
        StrSql = "SELECT DISTINCT SecurityGroups.SecurityGroup, SecurityGroups.Description AS Sec_Desc ,Authorisation.NTAccount, Company.Type, Company.Description AS Comp_Desc " & _
        "FROM  Company INNER JOIN SecurityGroups ON Company.Company = SecurityGroups.Company INNER JOIN " & _
        "Authorisation ON SecurityGroups.SecurityGroup = dbo.Authorisation.SecurityGroup " & _
        "WHERE     (Company.Type ='1' AND Authorisation.NTAccount = '" & VarUser & "') AND SecurityGroups.Active = 1"
    RsAuthGroups.open StrSql,objConn
    Do While NOT RsAuthGroups.EOF 'Loop through groups and generate form options.
        Response.Write "        <option value=" & chr(34) &  Replace(RsAuthGroups("SecurityGroup")," ","") & chr(34) & "> " & RsAuthGroups("Comp_Desc") & " - " & RsAuthGroups("Sec_Desc") & " </option>"& vbcrlf
        RsAuthGroups.MoveNext
    Loop
    RsAuthGroups.Close
    Response.Write "</select>" & vbcrlf
    Response.Write "<br/><br/>Once you have selected an area please press <b>" & chr(34) & "Next" & chr(34) & "</b></p>" & vbcrlf
    Response.Write "<input type =" & chr(34) & "submit" & chr(34) & "value =" & chr(34) & " Next " & chr(34) & "/>" & vbcrlf
    Response.Write "</p>" & vbcrlf
    Response.Write "</form>" & vbcrlf
End If

'-----------------------------------------------------------------------------
' Display Link Back To Homepage
'-----------------------------------------------------------------------------
Response.Write "<hr class=" & Chr(34) & "grey" & chr(34) & "/>" & vbcrlf
Response.Write "<p>" & vbcrlf
Response.Write "    <a href=" & chr(34) & "default.asp" & chr(34) & "> Back To Security Access Wizard</a></br>" & vbcrlf
Response.Write "</p>" & vbcrlf

%>

<%WriteHTMLFooter()%>

EDIT: Here is a copy & paste of the QueryADGroup from Database.asp:

'-----------------------------------------------------------------------------
' QueryADGroup Returns An Array 
'-----------------------------------------------------------------------------

Function QueryADGroup(StrQryType,StrQryValue)
    Set oRootDSE        = GetObject("LDAP://RootDSE")
    sDomainADsPath      = "LDAP://" & oRootDSE.Get("defaultNamingContext")
    Set oRootDSE        = Nothing
    Set oCon            = Server.CreateObject("ADODB.Connection")
    sUser               = "removed"
    sPassword           = "removed"
    oCon.Provider       = "ADsDSOObject"
    oCon.Open "ADProvider", sUser, sPassword
    Set oCmd            = Server.CreateObject("ADODB.Command")
    Set oCmd.ActiveConnection = oCon
    sProperties     = "distinguishedName"
    select case StrQryType
      case "distinguishedName,cn"
        oCmd.CommandText    = "<" & sDomainADsPath & ">;(&(objectCategory=group)(SAMAccountName=" & StrQryValue & "));" & sProperties '& ";subtree"
      case else
        oCmd.CommandText    = "<" & sDomainADsPath & ">;(&(objectCategory=group)(SAMAccountName=" & StrQryValue & "));" & sProperties '& ";subtree"
    end select
    oCmd.Properties("Page Size") = 100
    Set oRecordSet = oCmd.Execute
    If oRecordSet.BOF = True Then
    QueryADGroup = Null
    Else
    QueryADGroup = oRecordSet.GetRows() 
    End If
    oRecordSet.Close
    oCon.Close
End Function

Is anyone able to help/assist me try and figure out what the issue is please?

I'd be most grateful for any pointers!

Further error

No Group Found

Provider error '8007203e'

The search filter cannot be recognized.

/Saw/database/database.asp, line 173

After implementing @Lankymart's suggestion

Line 173 is:

If oRecordSet.BOF = True Then

This is the section of database.asp where it is trying to get the users from AD:

 '-----------------------------------------------------------------------------
' Get Users From Query
'
' Returns 2D Array with user infomation in following format
'       0,x - User Principle Name
'       1,x - SAMAccount Name(NTAccount)
'       2,x - Display Name
'       3,x - Given Name
'       4,x - Surname
'       5,x - Description (For Some Reason Its returned as an array)
'       6,x - Email
'       7,x - SID (Binary)
'       9,x - Distinguised Name
'       10,x - Job Title
'       11,x - Company
'-----------------------------------------------------------------------------'
Function QueryADUsers(StrQryType,StrQryValue)
    
    Set oRootDSE        = GetObject("LDAP://RootDSE")
    sDomainADsPath      = "LDAP://" & oRootDSE.Get("defaultNamingContext")
    Set oRootDSE        = Nothing
    Set oCon        = Server.CreateObject("ADODB.Connection")
    sUser               = "removed"
    sPassword           = "removed"
    oCon.Provider       = "ADsDSOObject"
    oCon.Open "ADProvider", sUser, sPassword
    Set oCmd        = Server.CreateObject("ADODB.Command")
    Set oCmd.ActiveConnection = oCon
    sProperties     = "userPrincipalName,SAMAccountname,name,givenName,sn,description,mail,objectsid,memberof,distinguishedName,title,company"
    select case StrQryType
      case "Surname"
        oCmd.CommandText    = "<" & sDomainADsPath & ">;(&(objectCategory=user)(sn=" & StrQryValue & "*));" & sProperties '& ";subtree"
      case "SAMAccountName"
        oCmd.CommandText    = "<" & sDomainADsPath & ">;(&(objectCategory=user)(SAMAccountName=" & StrQryValue & "));" & sProperties '& ";subtree"
      case "GroupsMembers"
        oCmd.CommandText    = "<" & sDomainADsPath & ">;(&(objectCategory=user)(MemberOf= " & StrQryValue & " ));" & sProperties '& ";subtree"
      case else
        oCmd.CommandText    = "<" & sDomainADsPath & ">;(&(objectCategory=user)(userPrincipalName=" & StrQryValue & "*));" & sProperties '& ";subtree"
    end select
    
    oCmd.Properties("Page Size") = 100
    Set oRecordSet = oCmd.Execute
    If oRecordSet.BOF = True Then
    QueryADUser = Null
    Else
    'oRecordset.Sort "sn,givenName"
    QueryADUsers = oRecordSet.GetRows() 
    End If
    oRecordSet.Close
    oCon.Close
End Function

Upvotes: 3

Views: 1655

Answers (1)

user692942
user692942

Reputation: 16680

What's the Problem?

The problem is the use of IsEmpty() as the validation check when you return GroupArray from the QueryADGroup() function.

This is because IsEmpty() is designed to return True if either of two conditions are met;

  1. Variable has not been initialised (no value assigned).
  2. Variable has been explicitly set to vbEmpty.

anything else will return False even variables assigned to Null.

Snippet from MSDN - IsEmpty Function

IsEmpty returns True if the variable is uninitialized, or is explicitly set to Empty; otherwise, it returns False. False is always returned if expression contains more than one variable. The following example uses the IsEmpty function to determine whether a variable has been initialized:

Dim MyVar, MyCheck
MyCheck = IsEmpty(MyVar)   ' Returns True.
MyVar = Null               ' Assign Null.
MyCheck = IsEmpty(MyVar)   ' Returns False.
MyVar = Empty              ' Assign Empty.
MyCheck = IsEmpty(MyVar)   ' Returns True.

What Causes the Type mismatch Error?

By setting QueryADGroup = Null in the QueryADGroup() function you are bypassing the IsEmpty() check because it will always be False. That means when the line

iRowNumber = ubound(GroupArray,2)

attempts to check the upper bounds of Null it fails with the error

Microsoft VBScript runtime error '800a000d'

Type mismatch: 'ubound'

/Saw/list_grp_mem.asp, line 18

because it expects an Array not a Null.

Suggested Solutions

Instead you can do two things.

  1. Change QueryADGroup = Null to QueryADGroup = Empty that way IsEmpty() will return True now that Empty has been explicitly set.

    QueryADGroup = Empty

  2. Use IsArray() instead of IsEmpty() to check for a valid return value. As the result is always expected to be an Array this seems the better option, as it will catch any return values that are not valid Arrays.

    If Not IsArray(GroupArray) Then

Useful Links

Upvotes: 1

Related Questions