VBScript 运行时错误“800a000d”

2024-04-13

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

编写该向导的人已经在我们的网站上为公司的另一个部门工作,而我正试图让一些已损坏的东西正常工作。

该系统的简单概述是:

  1. 用户向授权者提交请求,授权者随后接受或拒绝相关用户的请求,以授予其访问文件夹/资源的权限
  2. 如果授权者接受请求,他就会打开向导并授权 - 将向 IT 发送一封电子邮件以供我们授予访问权限
  3. 授予访问权限后,我们会在向导中勾选一个框,该框会向用户和授权者发送电子邮件,通知他们已授予访问权限

该系统的一部分允许文件夹/资源的授权者检查哪些用户有权访问其授权文件夹。这一直运行良好,直到我们更改了文件夹的命名标准:

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

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

Microsoft VBScript 运行时错误“800a000d”

类型不匹配:'ubound'

/Saw/list_grp_mem.asp,第 18 行

我怀疑问题是新的文件夹命名约定中有连字符,这导致了问题 - 但不幸的是,尽管我多次尝试查看它并进行大量谷歌搜索,但我无法修复它。

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

有人可以帮助/协助我尝试找出问题所在吗?

如果有任何指点,我将不胜感激!

进一步错误



No Group Found
  

提供商错误“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

有什么问题?

问题是使用IsEmpty()作为您返回时的验证检查GroupArray来自QueryADGroup()功能。

这是因为IsEmpty()旨在返回True如果满足两个条件之一;

  1. 变量尚未初始化(未赋值).
  2. 变量已明确设置为vbEmpty.

其他任何东西都会返回False甚至变量分配给Null.

片段来自MSDN - IsEmpty 函数 https://msdn.microsoft.com/en-us/library/5cs4befa(v=vs.84).aspx

IsEmpty回报True如果变量未初始化,或显式设置为空;否则,它返回False. False如果表达式包含多个变量,则始终返回。 以下示例使用IsEmpty判断变量是否已初始化的函数:

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

VBScript 运行时错误“800a000d” 的相关文章

随机推荐