VBScript 运行时错误“800a000d”

Question

在我们的业务中，我们使用安全向导来控制和管理 Active Directory 安全性，并对所做的更改进行审计跟踪。这是一个带有 ASP 前端的 SQL 数据库，它还与我们的 Active Directory 进行通信。

编写向导的人从我们的网站开始为公司的另一部分工作，而我正在尝试使某些已损坏的东西正常工作。

系统的简单概述是：

1. 用户向授权人提交请求，授权人随后接受或拒绝有关用户被授予文件夹/资源访问权限的请求
2. 如果授权人接受请求，他会打开向导并对其进行授权 - 会向 IT 部门发送一封电子邮件，让我们授予访问权限
3. 在我们授予访问权限后，我们会在向导中勾选一个框，该框会通过电子邮件向用户和授权者发送通知他们授予的访问权限

该系统的一部分让文件夹/资源的授权者检查哪些用户可以访问他们的授权文件夹。这一直运作良好，直到我们更改了文件夹的命名标准：

旧命名标准 - “BusinessFolderPurpose”，例如《贝克人力资源》 新命名标准 - “业务 - 站点 - 服务器位置 - 文件夹用途”，例如“贝克 - 英格兰 - Server123 - 人力资源”

当用户尝试使用向他们显示谁有权访问的向导部分时，他们现在收到以下错误消息：

Microsoft VBScript 运行时错误“800a000d”

类型不匹配：'ubound'

/Saw/list_grp_mem.asp，第 18 行

我怀疑问题在于新的文件夹命名约定中包含 hypens，这导致了一个问题 - 但不幸的是，尽管我多次尝试查看它并在谷歌上搜索了很多，但我无法修复它。

第 18 行是：

iRowNumber = ubound(GroupArray,2)
    
    

list_grp_mem.asp页面的完整代码为：

<!--#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()%>

编辑：这是来自 Database.asp 的 QueryADGroup 的复制和粘贴：

'-----------------------------------------------------------------------------
' 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

是否有人能够帮助/帮助我尝试找出问题所在？

如果有任何指点，我将不胜感激！

进一步的错误

未找到组

提供程序错误“8007203e”

无法识别搜索过滤器。

/Saw/database/database.asp，第 173 行

在执行@Lankymart 的建议后

第 173 行是：

If oRecordSet.BOF = True Then

这是 database.asp 中试图从 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

Answer 1

有什么问题？

问题是当您从QueryADGroup() 函数返回GroupArray 时，使用IsEmpty() 作为验证检查。

这是因为IsEmpty() 被设计为在满足两个条件之一时返回True；

1. 变量尚未初始化（未分配值）。
2. 变量已明确设置为vbEmpty。

其他任何东西都会返回False，即使是分配给Null的变量。

来自MSDN - IsEmpty Function的片段

IsEmpty 如果变量未初始化或显式设置为 Empty，则返回 True；否则，它返回 False。如果表达式包含多个变量，则始终返回 False。 以下示例使用 IsEmpty 函数来确定变量是否已初始化：

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.

Type mismatch 错误的原因是什么？

通过在QueryADGroup() 函数中设置QueryADGroup = Null，您将绕过IsEmpty() 检查，因为它始终是False。这意味着当行

iRowNumber = ubound(GroupArray,2)

尝试检查Null 的上限失败并出现错误

Microsoft VBScript 运行时错误“800a000d”

类型不匹配：'ubound'

/Saw/list_grp_mem.asp，第 18 行

因为它需要 Array 而不是 Null。

建议的解决方案

相反，您可以做两件事。

1. 将QueryADGroup = Null 更改为QueryADGroup = Empty 这样IsEmpty() 将返回True，因为Empty 已明确设置。

   QueryADGroup = Empty
   

2. 使用IsArray() 而不是IsEmpty() 来检查有效的返回值。由于结果总是预期为Array，这似乎是更好的选择，因为它会捕获任何无效数组的返回值。

   If Not IsArray(GroupArray) Then
   

---

有用的链接

• MSDN - IsArray Function