Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Active Directory User Names
Message
From
07/08/2019 09:48:37
Cetin Basoz
Engineerica Inc.
Izmir, Turkey
 
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Miscellaneous
Thread ID:
01669941
Message ID:
01669948
Views:
54
>Hi,
>
>First, general AD question. Is each user name in the AD unique? That is, there is only one JOHN SMITH and next person with the same name would have to be somewhat different; e.g. JOHN SMITH2?
>
>Second question. Can you get ALL user names in the AD from a VFP 9 application? If yes, how?
>
>TIA

First question: No. You should check properties like userPrincipalName, adsPath, objectGUID, distinguishedName for unique info (well it has been over 10 years I last dealt with its code, maybe not remembering the property names right).

Second Question. Yes you can and there is more than one way, and unfortunately I don't remember pros/cons one over another (likely you would use both). Below codes are from my backyard written 10-15+ years ago, please don't ask me details. All I remember I also created some UI for them to pick up groups and fields and mark the uniqueId one etc (can't give that proprietary code, the ones below was the main parts of that):

Sample1:
Local con As Adodb.Connection, rs As Adodb.Recordset

con = Createobject('Adodb.Connection')
con.Provider = "ADsDSOObject"
*!*	con.Properties('User ID') = "admin"
*!*	con.Properties('Password') = "adminpwd"
*!*	con.Properties('Encrypt Password') = .F.
con.Open("Active Directory Provider")

*lcUrl = "server.myDomain.com"
* or x.x.x.x:389 where x.x.x.x represents IP address
* 389 is default LDAP port
*strFrom = 'LDAP://'+m.lcURL+'/OU=...,DC=...,DC=...,DC=...,DC=...'

strFrom = 'LDAP://localhost/OU=ADAM Users,o=Microsoft,c=US'
rs = con.Execute([SELECT displayName,givenName,sn,telephoneNumber,homePhone FROM ']+strFrom+[']+;
  [Where objectClass = 'user' And objectCategory='Person'])

lcTemp = Sys(2015)+'.xml'
rs.Save(m.lcTemp,1)
con.Close
RsXML2VFPCursor(m.lcTemp)
Erase (m.lcTemp)

Select myCursor
Browse

Function RsXML2VFPCursor
  Lparameters tcXML
  Local lcXML
  m.lcXML = Filetostr(m.tcXML)
  m.lcXML = ;
    [<?xml version = "1.0" encoding="Windows-1252" standalone="yes"?>]+Chr(13)+Chr(10)+;
    [<VFPData>]+Chr(13)+Chr(10)+;
    Strtran(Strextract(m.lcXML,'<rs:data>','</rs:data>',1,1),'<z:row','<row',1,-1,3)+Chr(13)+Chr(10)+;
    [</VFPData>]
  _cliptext = m.lcXML
  Xmltocursor(m.lcXML,'myCursor')
endfunc 

Sample2:
*** LDAPClass.prg

*** LDAP.h
#Define ADS_SCOPE_BASE 0
#Define ADS_SCOPE_ONELEVEL 1
#Define ADS_SCOPE_SUBTREE 2

#Define ADS_SECURE_AUTHENTICATION 0x1
#Define ADS_USE_ENCRYPTION 0x2
#Define ADS_USE_SSL 0x2
#Define ADS_READONLY_SERVER 0x4
#Define ADS_PROMPT_CREDENTIALS 0x8
#Define ADS_NO_AUTHENTICATION 0x10
#Define ADS_FAST_BIND 0x20
#Define ADS_USE_SIGNING 0x40
#Define ADS_USE_SEALING 0x80
#Define ADS_USE_DELEGATION 0x100
#Define ADS_SERVER_BIND 0x200
#Define ADS_AUTH_RESERVED 0x80000000

#Define  ADSTYPE_INVALID 0
#Define  ADSTYPE_DN_STRING 1
#Define  ADSTYPE_CASE_EXACT_STRING 2
#Define  ADSTYPE_CASE_IGNORE_STRING 3
#Define  ADSTYPE_PRINTABLE_STRING 4
#Define  ADSTYPE_NUMERIC_STRING 5
#Define  ADSTYPE_BOOLEAN 6
#Define  ADSTYPE_INTEGER 7
#Define  ADSTYPE_OCTET_STRING 8
#Define  ADSTYPE_UTC_TIME 9
#Define  ADSTYPE_LARGE_INTEGER 10
#Define  ADSTYPE_PROV_SPECIFIC 11
#Define  ADSTYPE_OBJECT_CLASS 12
#Define  ADSTYPE_CASEIGNORE_LIST 13
#Define  ADSTYPE_OCTET_LIST 14
#Define  ADSTYPE_PATH 15
#Define  ADSTYPE_POSTALADDRESS 16
#Define  ADSTYPE_TIMESTAMP 17
#Define  ADSTYPE_BACKLINK 18
#Define  ADSTYPE_TYPEDNAME 19
#Define  ADSTYPE_HOLD 20
#Define  ADSTYPE_NETADDRESS 21
#Define  ADSTYPE_REPLICAPOINTER 22
#Define  ADSTYPE_FAXNUMBER 23
#Define  ADSTYPE_EMAIL 24
#Define  ADSTYPE_NT_SECURITY_DESCRIPTOR 25
#Define  ADSTYPE_UNKNOWN 26
#Define  ADSTYPE_DN_WITH_BINARY 27
#Define  ADSTYPE_DN_WITH_STRING 28 
*** LDAP.h

o = Newobject('LDAPUI','LDAPClass.Prg')
o.cRoot = 'o=Microsoft,c=US'
o.NetworkAuthentication = .t.

*!*		oRS = o.LDAPQuery("adsPath,distinguishedName",;
*!*			" objectCategory='group' or"+;
*!*			" objectCategory='container' or"+;
*!*			" objectCategory='organizationalUnit'", 'base', o.cRoot)
oRS = o.LDAPQuery("adsPath,distinguishedName",'', 'base', o.cRoot)
ShowMe(oRS)

Function ShowMe
	Lparameters toRecordset
	Public oForm
	oForm = Createobject('myForm', toRecordset)
	oForm.Show
Endfunc

Define Class myform As Form
	Height = 450
	Width = 750
	Name = "Form1"

	Add Object hflex As OleControl With ;
		Top = 10, Left = 10, Height = 430, Width = 730, Name = "Hflex", ;
		OleClass = 'MSHierarchicalFlexGridLib.MSHFlexGrid'

	Procedure Init
		Lparameters toRecordset
		This.hflex.Datasource = toRecordset
		This.hflex.AllowUSerResizing = 3
	Endproc
EndDefine


Define Class LDAPUI As Custom
	cServer = "localhost"
	nPort = 389
	cRoot = ""
	cAdmin = ""
	cAdminPwd = ""
	cSchemacursor = "crsSchema"
	cGroupsCursor = "crsGroups"
	cMapCursor    = "crsLDAPMap"
	lConnectionValid = .F.
	NetworkAuthentication = .T.
	UseSSL = .F.
	Dimension aGroups[1]
	oCon = .Null.
	nGroups = 0
	cSuffix = ''
	cError = ''

	Procedure QueryRoot(tcServer As String)
		Local lcRootName
		With This
			.cServer = Iif(!Empty(m.tcServer), Trim(m.tcServer), .cServer)
			If !.GetRootName(.cServer)
				.cRoot = .FindRootName( .cServer )
				If Empty(.cRoot)
					.cRoot = Inputbox("Please provide LDAP domain root",;
						"rootDSE does not support defaultNamingContext",;
						"DC=node,DC=AD,DC=yourdomain,DC=com")
				Endif
			Endif
			Return !Empty(.cRoot)
		Endwith
	Endproc

	Procedure TryConnection(tcServer As String, ;
			tnPort As Integer,;
			tcRoot As String,;
			tcAdmin As String, ;
			tcAdminPwd As String,;
			tlUseSSL As Boolean)
		With This
			If .lConnectionValid And ;
					!.NewHost(tcServer, tnPort,	tcRoot,	tcAdmin, tcAdminPwd)
				Return
			Else
				.ResetDefaults()
			Endif
			.cServer   = Iif(!Empty(m.tcServer), Trim(m.tcServer), .cServer)
			.nPort     = Iif(!Empty(m.tnPort), m.tnPort, .nPort)
			.cAdmin    = Iif(!Empty(m.tcAdmin), Trim(m.tcAdmin), .cAdmin)
			.cAdminPwd = Iif(!Empty(m.tcAdminPwd), Trim(m.tcAdminPwd), .cAdminPwd)
			.cRoot     = Iif(!Empty(m.tcRoot), Trim(m.tcRoot), .cRoot)
			.NetworkAuthentication = Empty(.cAdmin) And Empty(.cAdminPwd)
			.UseSSL = m.tlUseSSL

			If Empty(.cRoot) And !.QueryRoot(.cServer)
				.cError =  'Cannot connect to server with given parameters - root unknown!'
				Return .F.
			Endif
			.lConnectionValid =  .TestRoot() && .GetGroups() And .GetSuffix()
			.cError = Iif( .lConnectionValid, ;
				'Connection succeeded', ;
				'Cannot connect to server with given parameters!' )
			Return .lConnectionValid
		Endwith
	Endproc

	Procedure ResetDefaults
		With This
			.cServer = "localhost"
			.nPort = 389
			.cRoot = ""
			.cAdmin = ""
			.cAdminPwd = ""
			.cSchemacursor = "crsSchema"
			.cGroupsCursor = "crsGroups"
			.lConnectionValid = .F.
			.NetworkAuthentication = .F.
			.cError = ''
			Dimension .aGroups[1]
			.aGroups = ""
			.oCon = .Null.
			.nGroups = 0
		Endwith
	Endproc

	Procedure NewHost(tcServer As String, ;
			tnPort As Integer,;
			tcRoot As String,;
			tcAdmin As String, ;
			tcAdminPwd As String)
		With This
			Return ;
				Iif(Empty(m.tcServer),.cServer,m.tcServer) # .cServer ;
				or ;
				Iif(Empty(m.tnPort),.nPort,m.tnPort) # .nPort ;
				or ;
				Iif(Empty(m.tcRoot),.cRoot,m.tcRoot) # .cRoot ;
				or ;
				Iif(Empty(m.tcAdmin),.cAdmin,m.tcAdmin) # .cAdmin ;
				or ;
				Iif(Empty(m.tcAdminPwd),.cAdminPwd,m.tcAdminPwd) # .cAdminPwd
		Endwith
	Endproc


	Procedure GetGroups
		Local oRS As Adodb.Recordset, ix As Integer, lHadError As Boolean
		With This
			Local oParser
			oParser = Createobject("Pathname")
			oRS = .LDAPQuery("adsPath,distinguishedName",;
				"objectCategory='group' or"+;
				" objectCategory='container' or"+;
				" objectCategory='organizationalUnit'", 'subtree', .cRoot)
			lHadError = Isnull(oRS)
			If ( !m.lHadError )
				Local lcGroupName,lcGroupDN,lnGroupRow
				Dimension .aGroups[32500,2] && assumption - there shouldn't be more
				.aGroups=''
				.nGroups = 0
				oRS.MoveFirst
				Do While !oRS.Eof
					lcGroup = oRS.Fields("adsPath").Value
					oParser.Set(lcGroup, 1)
					.nGroups = .nGroups + 1
					.aGroups[.nGroups,1] = oParser.Retrieve(3)
					.aGroups[.nGroups,2] = oRS.Fields("distinguishedName").Value
					oRS.MoveNext
				Enddo
				Dimension .aGroups[.nGroups,2]
			Endif
			.oCon.Close()
			If ( m.lHadError )
				Return .F.
			Endif
		Endwith
	Endproc

	Procedure GetSchema(tcCursorName As String)
		Local loSchema, sc, mp, op, pr, lcSchemaCursor, lHadError
		lcSchemaCursor = Sys(2015)
		With This
			.cSchemacursor = Iif(!Empty(m.tcCursorName), m.tcCursorName, .cSchemacursor )

			Create Cursor (m.lcSchemaCursor) ;
				(PropName c(100), PropType c(30), IsSingle L, Mandatory L)

			objLDAP = Getobject("LDAP:")
			On Error lHadError = .T.
			If .NetworkAuthentication
				loSchema = Getobject("LDAP://" + .cServer + "/schema/user")
			Else
				loSchema = objLDAP.OpenDSObject("LDAP://" + .cServer + ":" + Ltrim(Str(.nPort)) + "/schema/user", ;
					.cAdmin, .cAdminPwd, 0)
			Endif
			On Error
			If m.lHadError
				Return .F.
			Endif
			sc = Getobject(loSchema.Parent)

			*Mandatory Properties:
			For Each mp In loSchema.MandatoryProperties
				pr = sc.Getobject("Property",mp)
				Insert Into (m.lcSchemaCursor) ;
					(PropName, PropType, IsSingle, Mandatory) ;
					values ;
					(pr.Name,pr.Syntax,pr.IsSingleValued, .T.)
			Endfor

			*Optional Properties:
			For Each op In loSchema.OptionalProperties
				pr = sc.Getobject("Property",op)
				Insert Into (m.lcSchemaCursor) ;
					(PropName, PropType, IsSingle) ;
					values ;
					(pr.Name,pr.Syntax,pr.IsSingleValued)
			Endfor
			If LDAPVALENCIA
				Insert Into (m.lcSchemaCursor) ;
					(PropName, PropType, IsSingle, Mandatory) ;
					values ;
					('uid','DirectoryString',.T.,.F.)
			Endif

			Select * From (m.lcSchemaCursor) ;
				where PropType='DirectoryString' ;
				and IsSingle ;
				order By PropName ;
				into Cursor (.cSchemacursor)
			Use In (m.lcSchemaCursor)
		Endwith
	Endproc

	* GroupsToCursor - Get groups nto a cursor suitable for treeview
	Procedure GroupsToCursor(tcGroupsCursor As String)
		Local oParser,ix
		With This
			.cGroupsCursor = Iif( !Empty(m.tcGroupsCursor),m.tcGroupsCursor,.cGroupsCursor )
			Asort(.aGroups,1) && Sort on path
			Create Cursor (.cGroupsCursor) (ParentID c(6),NodeID c(6),DN m,myDN m)
			For ix=1 To Alen(.aGroups,1)
				lnParentRow = Ascan(.aGroups,Justpath(.aGroups[m.ix,1]),1,-1,1,15)
				Insert Into (.cGroupsCursor) ;
					(ParentID,NodeID, DN, myDN) Values (;
					Padl(m.lnParentRow,6,'_'),;
					Padl(m.ix,6,'_'), ;
					.aGroups[m.ix,2], ;
					Strtran(.aGroups[m.ix,2],;
					Iif(m.lnParentRow=0,'',','+.aGroups[m.lnParentRow,2]),'') )
			Endfor
		Endwith
	Endproc

	Procedure LDAPQueryFrom(tcFieldList As String, ;
			tcFilter As String, ;
			tcScope As String, ;
			tcFrom As String, ;
			tnSizeLimit As Integer)
		Local con As Adodb.Connection, ;
			rs As Adodb.Recordset, ;
			rs1 As Adodb.Recordset, ;
			com As Adodb.Command ;
			lnScope As Integer, ;
			lHadError As Boolean
		Local Array arrScope[3]

		arrScope[1]='base'
		arrScope[2]='onelevel'
		arrScope[3]='subtree'

		lnScope = Ascan(arrScope, Iif( Empty(m.tcScope),'subtree', m.tcScope ),1,-1,1,1)-1
		lHadError = .F.

		With This
			m.tcFrom = Iif(Empty(m.tcFrom), 'LDAP://'+.cServer+':'+Ltrim(Str(.nPort)), m.tcFrom)
			.oCon = Createobject('Adodb.Connection')
			With .oCon
				.Provider = "ADsDSOObject"
				If !This.NetworkAuthentication
					.Properties('User ID') = This.cAdmin
					.Properties('Password') = This.cAdminPwd
					.Properties('Encrypt Password') = This.UseSSL
				Endif
				.Open("Active Directory Provider")
			Endwith

			com = Createobject('Adodb.command')
			com.ActiveConnection = .oCon
			com.Properties("searchscope") = m.lnScope
			If !Empty(m.tnSizeLimit)
				com.Properties("Size Limit") = m.tnSizeLimit
			Endif

			com.CommandText = [SELECT ]+m.tcFieldList+[ FROM ']+m.tcFrom+[']+;
				Iif(Empty(m.tcFilter),[],[ Where ]+m.tcFilter)

			On Error lHadError=.T.
			rs = com.Execute()
			On Error
		Endwith
		Return Iif(m.lHadError Or rs.Eof(),.Null.,rs)
	Endproc

	Procedure LDAPQuery(tcFieldList As String, ;
			tcFilter As String, ;
			tcScope As String, ;
			tcContainer As String, ;
			tnSizeLimit As Integer)
		Local con As Adodb.Connection, ;
			rs As Adodb.Recordset, ;
			rs1 As Adodb.Recordset, ;
			com As Adodb.Command ;
			strFrom As String, ;
			lnScope As Integer, ;
			lHadError As Boolean
		Local Array arrScope[3]

		arrScope[1]='base'
		arrScope[2]='onelevel'
		arrScope[3]='subtree'

		lnScope = Ascan(arrScope, Iif( Empty(m.tcScope),'subtree', m.tcScope ),1,-1,1,1)-1
		lHadError = .F.

		With This
			m.tcContainer = Iif(Empty(m.tcContainer), .cRoot, m.tcContainer)
			.oCon = Createobject('Adodb.Connection')
			With .oCon
				.Provider = "ADsDSOObject"
				If !This.NetworkAuthentication
					.Properties('User ID') = This.cAdmin
					.Properties('Password') = This.cAdminPwd
					.Properties('Encrypt Password') = This.UseSSL
				Endif
				.Open("Active Directory Provider")
			Endwith

			com = Createobject('Adodb.command')
			com.ActiveConnection = .oCon
			com.Properties("searchscope") = m.lnScope
			If !Empty(m.tnSizeLimit)
				com.Properties("Size Limit") = m.tnSizeLimit
			Endif

			strFrom = 'LDAP://'+.cServer+':'+Ltrim(Str(.nPort))+'/'+m.tcContainer
			com.CommandText = [SELECT ]+m.tcFieldList+[ FROM ']+strFrom+[']+;
				Iif(Empty(m.tcFilter),[],[ Where ]+m.tcFilter)

			On Error lHadError=.T.
			rs = com.Execute()
			On Error
		Endwith
		Return Iif(m.lHadError Or rs.Eof(),.Null.,rs)
	Endproc

	Procedure GetRootName(tcServer As String)
		With This
			.cServer = Iif(!Empty(m.tcServer), Trim(m.tcServer), .cServer)
			Local oRoot, lNotSupported
			On Error lNotSupported = .T.
			oRoot = Getobject("LDAP://" + .cServer + "/rootDSE")
			.cRoot = oRoot.Get("defaultNamingContext")
			On Error
		Endwith
		Return !m.lNotSupported
	Endproc

	Procedure LDAPPath(tcContainer As String)
		Return "LDAP://" + ;
			This.cServer + ":" + ;
			Ltrim(Str(This.nPort)) + "/" + ;
			m.tcContainer + "," + This.cRoot
	Endproc

	Procedure FindRootName(tcServer As String)
		Local objMember,ix,lcRoot,lHadError
		Local Array arrNaming[1]
		arrNaming = ""
		On Error lHadError = .T.
		objMember = Getobject("LDAP://"+Trim(m.tcServer)+"/RootDSE")
		arrNaming = objMember.Get("namingContexts")
		On Error
		If m.lHadError
			Return ""
		Endif
		For ix = 1 To Alen(arrNaming)
			If Atc('schema',arrNaming[m.ix]) + ;
					Atc('configuration',arrNaming[m.ix]) = 0
				lcRoot = arrNaming[m.ix]
				If This.TestRoot(m.tcServer,lcRoot)
					Return m.lcRoot
				Endif
			Endif
		Endfor
		Return ""
	Endproc

	Procedure TestRoot(tcServer As String, tcRoot As String, tnPort As Integer)
		This.cServer = Iif(Empty(m.tcServer),This.cServer,Trim(m.tcServer))
		This.cRoot   = Iif(Empty(m.tcRoot),  This.cRoot,  Trim(m.tcRoot))
		This.nPort   = Iif(Empty(m.tnPort),  This.nPort,  m.tnPort)
		Local oRS
		oRS = This.LDAPQuery("distinguishedName",'','base')
		This.oCon.Close()
		If Isnull(oRS)
			This.cRoot = ""
		Endif
		Return !Isnull(oRS)
	Endproc

	Procedure ATranspose
		Lparameters taArray
		Local ix,jx
		Local Array aConversion[Alen(taArray,2),Alen(taArray,1)]
		For ix=1 To Alen(taArray,1)
			For jx=1 To Alen(taArray,2)
				aConversion[m.jx,m.ix] = taArray[m.ix,m.jx]
			Endfor
		Endfor
		Dimension taArray[Alen(taArray,2),Alen(taArray,1)]
		Acopy(aConversion,taArray)
	Endproc

	Procedure GetSuffix
		Local oRS As Adodb.Recordset
		With This
			oRS = .LDAPQuery('userPrincipalName',;
				"objectClass='user' and objectCategory='Person'","","subtree",10)
			If !Isnull(oRS)
				Do While !oRS.Eof
					If ( Type('oRS.Fields(0).Value')='C' And !Empty(oRS.Fields(0).Value) )
						.cSuffix = Substr(oRS.Fields(0).Value,At('@',oRS.Fields(0).Value))
						Exit
					Endif
				Enddo
			Endif
			.oCon.Close()
		Endwith
	Endproc

	Procedure CheckMemberShip(toRs,tcMemberOf)
		If Empty(m.tcMemberOf) && No membership check group set
			Return .T.
		Endif
		tcMemberOf = Alltrim(Upper(m.tcMemberOf))
		Local ix
		Local Array aMemberOf[1]
		aMemberOf = toRs.Fields('MemberOf').Value
		If !Isnull(aMemberOf)
			For ix=1 To Alen(aMemberOf)
				If Alltrim(Upper(aMemberOf[m.ix])) == m.tcMemberOf && Found
					Return .T.
				Endif
			Endfor
		Endif
		Return .F. && Not a member
	Endproc
Enddefine
PS: As I remember, you can download and use ADAM from Microsoft for local testing.
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform