Solved

List members from a ADS group in classic ASP

Posted on 2014-11-12
13
863 Views
Last Modified: 2014-11-22
Hi Experts,

I've successfully extracted all group memeber ships from a user using this code:

<html>
<body>
<%
FuncADuser = "mydomain\serviceaccount"
FuncADpassword = "my password" 
 
sLogonUser = Request.ServerVariables("Logon_User")
sDomain = ucase(Mid(sLogonUser, 1, Instr(1, sLogonUser, "\") - 1))
sLogonName = lcase(trim(Mid(sLogonUser, Instr(1, sLogonUser, "\") + 1)))
Set Conn = Server.CreateObject("ADODB.Connection") 
Set RS = Server.CreateObject("ADODB.Recordset") 
Conn.Provider = "ADsDSOObject" 
Conn.Properties("User ID") = FuncADuser
Conn.Properties("Password") = FuncADpassword
Conn.Properties("Encrypt Password") = True
strConn = "Active Directory Provider" 
Conn.Open strConn , FuncADuser, FuncADpassword
strRS = "SELECT memberOf FROM 'LDAP://" & SDomain &"' WHERE sAMAccountName = '"&sLogonName&"' ORDER by name " 
RS.Open strRS, Conn,1,1
membership=rs("memberof")
rs.Close
Set rs = Nothing
For each group in membership
 newgroup=split(group,"=")
 response.write left(newgroup(1), len(newgroup(1))-3)&"<br>" & vbCrLf
Next
%>
</body>
</html>

Open in new window


But now I would be able to get all users from a given global Active Directory group.

In VBS I successfully used this script:
'\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\
'\\    Filter AD groups, select a AD group and make a list of its users
'\\    Frans Erich  16-02-06
'\\
'\\		 Sub :  CheckForUser and GetUserAccount taken from "ADuser" script from Ralph E Montgomery 
'\\		 Function :  SelectBox taken from script from T. Lavedas
'\\    
'\\    Script only works in a domain environment
'\\
'\\\\\\\\\\\\\\\\\\\\\\\
'On Error Resume Next
Dim objGroup, objUser, WshShell, strMessage, strDomain, strUserMail, strRootDSE, strGetUserName, Ouser, fso
Dim objNet, major, minor, ver, strMail, strLogonName, strValue, strDisplayDescription, strDisplayDepartment, strDN
Dim strSearch, strMostRecentIP, aOpt(), intOpt, oGroup, sGroup, txtFile, objComputer
Dim objRootDSE, strTemp, strADsConfPath, strFormat, strFile, i, objConnection, objCommand, objRecordSet, objectRecordSet
Dim strKey, strKeyValue, rval, strBCC, oMailApp, olMailItm, olMailItem, intSize, strDelegateCount, personeelsnummer

Set WshShell = WScript.CreateObject("WScript.Shell")
Set objNet = CreateObject("WScript.Network")
Set objRootDSE = GetObject("LDAP://rootDSE")

strADsConfPath = "LDAP://" & objRootDSE.Get("configurationNamingContext")
strRootDSE = objRootDSE.Get("defaultNamingContext")


strDomain = UCase(objNet.UserDomain)

strSearch = LCase(InputBox("Geef een optionele waarde op waarop u groepen wilt filteren."))
ListGroups( strDomain )
intOpt = 1
'input validation
sGroup = SelectBox("Selecteer een groep", aOpt)
If sGroup = "Selecteer een groep" Then
	strMessage ="U heeft geen keuze gemaakt uit één van de aangeboden groepen."
	Cancelled()
End If
	
' Change the value of variable "strFormat"  beneath to "Outlook" to generate a new mail containing all email addresses of the mebers in the BCC box.
strFormat = "Excel"

Set oGroup = GetObject("WinNT://" & strDomain & "/" & sGroup & ",group")
if sgroup <> "Aborted" then
     if sgroup <> "Selecteer een groep" then
            if strFormat = "Excel" then
                 strTemp = WshShell.ExpandEnvironmentStrings("%temp%")
                 strFile = strTemp & "\Ledenlijst " & sgroup & ".csv"
                Set fso = CreateObject("Scripting.FileSystemObject")
              If fso.FileExists(strFile) Then
               fso.DeleteFile(strFile)
              End If 
               Set txtFile = fso.CreateTextFile(strFile)
               i = 0
               For Each oUser In oGroup.Members
               i = i + 1
               strGetUserName=""
               strDN=""
               strMail=""
               strGetUserName= UCase(oUser.Name)
               if mid(strGetUserName,3,1)<>"-" then
        	   CheckForUser()
               	   GetUserAccount(strDN)
               else
               	   strMail = "computer account"
               	   strDisplayDepartment = "computer account"
        	   end if
               txtFile.write (strGivenName & " ; " & strsurname & " ; " & oUser.Name & " ;  " & personeelsnummer & " ;" & strDisplayDepartment & " ; " & strMail & vbCrLf)
               Next
               txtfile.close
               Set txtfile = nothing
               Set fso = nothing
               strKey = "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\Excel.exe\path"
               If KeyExists(strKey) = True Then
                    strKeyValue = WshShell.RegRead(strKey)
                    rval = WshShell.Run(chr(34) & strKeyValue & "excel.exe" & chr(34) & " " & chr(34) & strFile & chr(34) ,1,TRUE) 
               else
                    rval = WshShell.Run("notepad.exe" & " " & strFile,1,TRUE)               
               end if
          else
               For Each oUser In oGroup.Members
               i = i + 1
               strGetUserName=""
               strDN=""
               strMail=""
               strGetUserName= UCase(oUser.Name)
               if mid(strGetUserName,3,1)<>"-" then
        	   CheckForUser()        	   
               	   GetUserAccount(strDN)
               end if
               strBCC = strBCC & strMail &"; " 
               Next
               Set oMailApp = CreateObject("Outlook.Application")
               Set olMailItm = oMailApp.CreateItem(olMailItem)
               olMailItm.BCC = strBCC
               olMailItm.Display
          end if
     end if 
end if

Sub CheckForUser()
     Set objConnection = CreateObject("ADODB.Connection")
     objConnection.Provider = ("ADsDSOObject")
     objConnection.Open
     Set objCommand = CreateObject("ADODB.Command")
     objCommand.ActiveConnection = objConnection
     objCommand.CommandText = _
     "<LDAP://" & strRootDSE & ">;(&(objectCategory=user)" & _
     "(samAccountName=" & strGetUserName & "));distinguishedName,sAMAccountName,name;subtree"
     Set objRecordSet = objCommand.Execute
     strDN = objRecordset.Fields("distinguishedName") 
     Set objectRecordSet = Nothing
     objConnection.close
     Set objConnection = Nothing
End Sub

Sub GetUserAccount(strDN)
    On Error Resume Next
    If InStr(1,strDN,"/") Then strDN=Replace(strDN,"/","\/")
    Set objUser = GetObject("LDAP://" & strDN & "")
    Set objAdS = GetObject("LDAP://" & strRootDSE & "")
     strsurname =""
    strGivenName = ""
	personeelsnummer=""	
    With objUser
        '.GetInfo
        strMail =        .Get("mail")
        personeelsnummer= .Get("employeeID")
        strLogonName =   .Get("sAMAccountName")
        strUserMail =    .Get("mail")
		strGivenName =    .Get("givenName")
		strsurname =    .Get("sn")
        strDescription = .GetEx("description")
        strDepartment =  .GetEx("department")

        strDisplayDepartment=""
        For Each strValue in strDepartment
         strDisplayDepartment = strDisplayDepartment & strValue
        Next
    
        For Each strValue in strDescription
         strDisplayDescription = strDisplayDescription & strValue
        Next
  
    End With
    
End Sub

Sub ListGroups( strDomain )
    Set objComputer = GetObject("WinNT://" & strDomain )
    objComputer.Filter = Array( "Group" )
    For Each objGroup In objComputer
    gt = objGroup.groupType
    if (InStr(LCase(objGroup.Name),strSearch) and (gt = &h02)) or (InStr(LCase(objGroup.Name),strSearch) and (gt = &h01)) or (InStr(LCase(objGroup.Name),strSearch) and (gt = &h08))  then
         ReDim Preserve aOpt(intOpt+ 1)
          aOpt(intOpt) = objGroup.Name
          intOpt = intOpt + 1
     end if
    Next
    If intOpt = 0 then
    strMessage ="Uw zoekopdracht heeft geen resultaat opgeleverd."
	Cancelled()
	end if
End Sub

Function SelectBox(sTitle, aOptions)
  Dim oIE, s, item
  set oIE = CreateObject("InternetExplorer.Application")
  With oIE
    .FullScreen = True
    .ToolBar   = False : .RegisterAsDropTarget = False
    .StatusBar = False : .Navigate("about:blank")
    Do Until .ReadyState = 4 : WScript.Sleep 100 : Loop
    .width= 400 : .height=200
    With .document
      with .parentWindow.screen
        oIE.left = (.availWidth  - oIE.width ) \ 2
        oIE.top  = (.availheight - oIE.height) \ 2
      End With
      s = "<html><head><title>" & sTitle _
        & "</title></head><script language=vbs>bWait=true<" & "/script>" _
        & "<body bgColor=Silver><center>" _
	& "<b>" & sTitle & "<b><p>" _
        & "<select id=entries size=1 style='width:325px'>" _
        & "  <option selected>" & sTitle & "</option>"
      For each item in aOptions
        s = s & "  <option>" & item & "</option>"
      Next
      s = s & "  </select><p>" _
        & "<button id=but0 onclick='bWait=false'>OK</button>" _
        & "<br><br><span style=" & chr(34)& "font-size: 8pt" & chr(34)& "><A HREF=" & chr(34)& "mailto:scripting@erich.nu" & chr(34)& ">build by Frans Erich</A></span>" _
        & "</center></body></html>"
      .open
      .Write(s)
      .close
      Do until .ReadyState ="complete" : Wscript.Sleep 50 : Loop
      With .body
        .scroll="no"
        .style.borderStyle = "outset"
        .style.borderWidth = "3px"
      End With
      .all.entries.focus
      oIE.Visible = True
      CreateObject("Wscript.Shell").AppActivate sTitle
      On Error Resume Next
      Do While .ParentWindow.bWait
        WScript.Sleep 100
        if oIE.Visible Then SelectBox = "Aborted"
        if Err.Number <> 0 Then Exit Function
      Loop
      On Error Goto 0
      With .ParentWindow.entries
        SelectBox = .options(.selectedIndex).text
      End With
    End With
    .Visible = False
  End With
End Function


Function KeyExists(sKeyPath)
     keyExists= false: if (sKeyPath="") then exit function
     on error resume next
     createobject("wscript.shell").regRead sKeyPath
     select case err
     case 0: keyExists= true
     case &h80070002: dim sErrMsg
     sErrMsg= replace(err.description, sKeyPath, "")
     err.clear
     createobject("wscript.shell").regRead "HKEY_ERROR\"
     keyExists= not (sErrMsg=replace(err.description, "HKEY_ERROR\", ""))
     case else: keyExists= false
     end select
     on error goto 0
End function
Sub Cancelled()
    strTitle = "Einde script"
    MsgBox strMessage,vbOkOnly,strTitle
    WScript.quit
End Sub 'Cancelled

Open in new window


But I can't get it working in classic ASP.

Can someone help me out making a simple example like the first ASP code?

Thanks,
0
Comment
Question by:Steynsk
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 5
13 Comments
 
LVL 33

Expert Comment

by:Big Monty
ID: 40438720
But I can't get it working in classic ASP

can you elaborate? are you getting an error and the wrong results?
0
 
LVL 33

Expert Comment

by:Big Monty
ID: 40438744
looking at your code a bit more, you'll need to add a where condition based off of the "memberOf" field:

memberOf=groupName
0
 
LVL 1

Author Comment

by:Steynsk
ID: 40438855
Hi Big Monty,

Thanks for responding so quickly.

I will first answer your first question. My best effort until so far:

FuncADuser = "mydomain\serviceaccount" 
FuncADpassword = "mypassword" 
 
sLogonUser = Request.ServerVariables("Logon_User")
sDomain = ucase(Mid(sLogonUser, 1, Instr(1, sLogonUser, "\") - 1))
sLogonName = lcase(trim(Mid(sLogonUser, Instr(1, sLogonUser, "\") + 1)))
Set Conn = Server.CreateObject("ADODB.Connection") 
Set RS = Server.CreateObject("ADODB.Recordset") 
Conn.Provider = "ADsDSOObject" 
Conn.Properties("User ID") = FuncADuser
Conn.Properties("Password") = FuncADpassword
Conn.Properties("Encrypt Password") = True
strConn = "Active Directory Provider" 
Conn.Open strConn , FuncADuser, FuncADpassword
' the following line just strips off the domain from the strNetworkID
' sUser=Replace(LCase(strNetworkID),domain & "\","")
' Set oUser = GetObject("WinNT://" & domain & "/" & sUser & ",user")
sGroup = "myapp"
Set oGroup=GetObject("WinNT://" & sDomain & "/" &sGroup & ",group")
For each member in oGroup
 response.write member&"<br>" & vbCrLf
Next

Open in new window


And in your second comment I don't understand what to do with the line you wrote.

My knowledge does not go that deep.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 33

Expert Comment

by:Big Monty
ID: 40438875
did you get an error with the above code or did it not display anything?
0
 
LVL 53

Expert Comment

by:Scott Fell, EE MVE
ID: 40438909
The problem is your code is not in vbscript and that is why it will not work.  If you used .net it may work. I have seen that code being used in  many places.  Just for kicks, try naming your page .aspx instead of .asp?

Otherwise, if you are looking to copy and paste code from someplace give this a try http://blogs.msdn.com/b/alejacma/archive/2010/04/15/how-to-get-the-ad-groups-a-user-is-member-of-asp.aspx

http://www.experts-exchange.com/Web_Development/Web_Languages-Standards/HTML/Q_22436042.html  or http://www.experts-exchange.com/Web_Development/Web_Languages-Standards/HTML/Q_22436042.html or http://www.experts-exchange.com/Programming/Languages/Scripting/ASP/Q_27286972.html
0
 
LVL 33

Expert Comment

by:Big Monty
ID: 40438931
try changing your for each loop to:

For each member in oGroup
 response.write member.MemberOf &"<br>" & vbCrLf
Next

Open in new window


if that doesn't work, try changing your ldap query to:

Set oGroup=GetObject("WinNT://" & sDomain & "/cn=" & sGroup )
0
 
LVL 1

Author Comment

by:Steynsk
ID: 40439453
Hi Big Monty,

The error i'm getting is :

Microsoft VBScript runtime error '800a0046'

Permission denied: 'GetObject'

test.asp, line 19

I'll try to make some changes with the suggested solutions

Thanks
0
 
LVL 33

Expert Comment

by:Big Monty
ID: 40439882
make sure the user you're logging into AD is an admin, otherwise you won't have permissions to the global groups
0
 
LVL 1

Accepted Solution

by:
Steynsk earned 0 total points
ID: 40447929
Because I was in a hurry I've paid for the solution on guru.com

This is the code that does the job:

Kind regards,

<html>
<!--
Script authored for Frans 2 via Guru.com
Project #1085752?
Author: Rhys Edwards
Date:   11/14/2014
-->
<body>
<form name="sending" method="POST" action="Group_Members.asp" target="_self">
<%
' These variables control 3 step workflow and pass data between steps
Phrase = Request.Form("Phrase") ' Search phrase for finding groups
Group = Request.QueryString("Group") ' Friendly name of group
GroupName = Request.QueryString("GroupName") ' DistinguishedName of group

FuncADuser = "domain\user"
FuncADpassword = "password"

' This approach to finding the domain does not have a dpenendency on authenticated user
Set objRootDSE = GetObject("LDAP://RootDSE")
sDomain = objRootDSE.Get("defaultNamingContext")
 

'sLogonUser = Request.ServerVariables("Logon_User")
'sDomain = ucase(Mid(sLogonUser, 1, Instr(1, sLogonUser, "\") - 1))


Set oCmd = Server.CreateObject("ADODB.Command")

' First step, collecting search term
if Phrase = "" and Group = "" Then
 oStatus = "Search"
 oButtonVal = "Search"
 response.write "<p>Please enter all or part of a group name to search:<br><input name=""Phrase"" size=""22"">"

' Second step, displaying groups to choose from
ElseIf Phrase <> "" and Group = "" Then
 oStatus = "Select"
 response.write "<p>Click on a group below to see its members:</p>"
 oCmd.CommandText = "SELECT Name,DistinguishedName FROM 'LDAP://" & SDomain &"' WHERE objectCategory = 'group' AND name ='*" & Phrase & "*'" 

' Final step, displaying group members
ElseIf Phrase = "" and Group <> "" Then
 oStatus = "Finish"
 oButtonVal = "Again?"
 response.write "<p>Beneath are presented all ADS objects that are members of <strong>"& GroupName &"</strong>:</p>"
 oCmd.CommandText = "SELECT Name,memberOf FROM 'LDAP://" & SDomain &"' WHERE memberof = '" & Group & "' ORDER by name " 

' Just in case something weird happens
Else
 response.write "<p>Invalid Page Access</p>"
 oButtonVal = "Again?"
 oStatus = "Search"
End If

' If this isn't the first step, process
If oStatus <> "Search" Then
 Set Conn = Server.CreateObject("ADODB.Connection") 
 Set RS = Server.CreateObject("ADODB.Recordset") 
 Conn.Provider = "ADsDSOObject" 
 Conn.Properties("User ID") = FuncADuser
 Conn.Properties("Password") = FuncADpassword
 Conn.Properties("Encrypt Password") = True
 strConn = "Active Directory Provider" 
 Conn.Open strConn , FuncADuser, FuncADpassword
 Set oCmd.ActiveConnection = Conn
 Set oRS = oCmd.Execute
 if not oRS.EOF Then
  oRS.MoveFirst
  Do Until oRS.EOF
   If oStatus = "Select" Then
    response.write "<a href=""Group_Members.asp?Group=" & oRS.Fields("DistinguishedName") & "&GroupName=" & oRS.Fields("Name") &""">" & oRS.Fields("Name") & "<br>"
   Else 
    response.write oRS.Fields("Name") & "<br>"
   End If
   oRS.MoveNext
  Loop
 Else
  oButtonVal = "Again?"
  oStatus = "Retry"
 End If
 Set rs = Nothing
 Conn.Close
End If

' Only display the button when it is relevant
If oStatus <> "Select" Then
  response.write "<input type=""submit"" value=""" & oButtonVal & """ name=""Send"">"
End If
set oCmd = Nothing
%>

</form>
</body>
</html>

Open in new window

0
 
LVL 1

Author Comment

by:Steynsk
ID: 40449438
I've requested that this question be closed as follows:

Accepted answer: 0 points for Steynsk's comment #a40439453
Assisted answer: 250 points for Scott Fell (padas)'s comment #a40438909
Assisted answer: 250 points for Big Monty's comment #a40438931
Assisted answer: 0 points for Steynsk's comment #a40447929

for the following reason:

I've paid for this answer at guru.com and all the credits go to Rhys Edwards whom helped me out at guru.com
0
 
LVL 1

Author Comment

by:Steynsk
ID: 40449665
Yes eenookami I did but the two experts I gave points to helped out and are rewarded for the help in this way.
0

Featured Post

Has Powershell sent you back into the Stone Age?

If managing Active Directory using Windows Powershell® is making you feel like you stepped back in time, you are not alone.  For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

This article describes my battle tested process for setting up delegation. I use this process anywhere that I need to setup delegation. In the article I will show how it applies to Active Directory
Auditing domain password hashes is a commonly overlooked but critical requirement to ensuring secure passwords practices are followed. Methods exist to extract hashes directly for a live domain however this article describes a process to extract u…
Video by: Mark
This lesson goes over how to construct ordered and unordered lists and how to create hyperlinks.
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.

738 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question