Help on authenticating user thru windows domains

[hebert_j_vargas]

Hi everybody, I need some help to translate this VB code I found on MS-VB forum, i put the next function on Excel and Worked very well, but I'm unable to translate to (x)Harbour. Pleas any help/advice that lead me to the right direction?
thanks in advance,

Hebert Vargas

Code: Select all

Function Authenticated(strUserID As String, strPassword As String, Optional strDNSDomain As String = "") As Boolean
         If strDNSDomain = "" Then
            Set objRootDSE = GetObject("LDAP://RootDSE")
            strDNSDomain = objRootDSE.Get("defaultNamingContext")
         End If

         'Authenticate
         Set dso = GetObject("LDAP:")
         On Error Resume Next
         Err.Clear
         Set ou = dso.OpenDSObject("LDAP://" & strDNSDomain, strUserID, strPassword, 1)
         Authenticated = (Err.Number = 0)
End Function

[carlos vargas]

sin probar, pero la idea es esta.
no estoy muy claro si la funcion CreateObject puede crear estos tipos de objectos no solo los de excel.
indicanos los errores que aparecen

Code: Select all

#include "fivewin.ch"
procedure main()
   ?Authenticated("cvarga","HolaMundo2014", "TESTDOM" )
return
   
Function Authenticated(cUserID, cPassword, cDNSDomain)
   local oRootDSE, oDSO, oU
 
   default cDNSDomain := ""
   
   If empty( cDNSDomain )
     oRootDSE = CreateObject( "LDAP://RootDSE" )
     cDNSDomain = oRootDSE:Get( "defaultNamingContext" )
   EndIf
    
    TRY
       oDSO = CreateObject( "LDAP:" )
       oU = oDSO:OpenDSObject( "LDAP://" +  cDNSDomain, cUserID, cPassword, 1 )
       lError := .f.
    CATCH
        ?Ole2TxtError(), OleError()
        lError := .t.
    END
    
RETURN (!lError) 
 

[hebert_j_vargas]

Gracias por tan pronta respuesta Carlos, ya habia realizado pruebas de este tipo y nada, pero voy a revisar tu código para ver y te aviso.

[carlos vargas]

en foxpro este codigo funciona, pero aca la funcion getobject es capaz de crear el objeto com.
parece ser que [x]harbour no es capaz de crear este tipo de objetos.
esto en la prueba que he realizado

Code: Select all

&& Supprimer un usager

Procedure DeleteUser(tcUser)
lcUserId ='CN='+tcUserID
objRootLDAP = Getobject("LDAP://RootDSE")
strDNSDomain = objRootLDAP.Get("DefaultNamingContext") && Get the context
strOU = "OU=Test,OU=OEB,OU=SAAS-users,"  && Your correct specifications
*' Prepare the OU and the Group
lcPath="LDAP://"+ strOU + strDNSDomain
* Specify the User.
strUser = "CN="+tcUser
* Bind to the object.
objADAM = Getobject(lcPath)
*Delete the User.
objADAM.Delete("user", strUser)
Endproc

&& Vérifier l'existence d'un usager.

PROCEDURE verifyIfUserExists(tcUserID)
LOCAL lcUserId
lcUserId ='CN='+tcUserID
objRootLDAP = Getobject("LDAP://RootDSE")
strDNSDomain = objRootLDAP.Get("DefaultNamingContext") && Get the context
strGroup = "CN=oeb-test,"
strOU = "OU=Test,OU=OEB,OU=SAAS-users,"  && You correct specifications
*' Prepare the OU and the Group
objGroup = Getobject("LDAP://"+ strGroup + strOU + strDNSDomain)
objOU =Getobject("LDAP://" +strOU + strDNSDomain)

For Each objUser In objOU
  If objUser.Class = Lower("User")
    IF objUser.name = lcUserId
      RETURN .T.
    ENDIF
  ENDIF
Endfor
RETURN .F.

ENDPROC

&& Bloquer le compte d'usager

PROCEDURE DisableAUser(tcUserId)
#Define  ADS_UF_ACCOUNTDISABLE 0x2

objRootLDAP = Getobject("LDAP://RootDSE")
strDNSDomain = objRootLDAP.Get("DefaultNamingContext") && Get the context
strOU = "OU=Test,OU=OEB,OU=SAAS-users," && You correct specifications
objUser = Getobject("LDAP://CN=" + tcUserId +","+;
  strOU+strDNSDomain)
objUser.Put( "userAccountControl", ADS_UF_ACCOUNTDISABLE)
objUser.SetInfo
ENDPROC

&& Changer de mot de passe

Procedure changePassword(tcUserId,tcPassword)

    objRootLDAP = Getobject("LDAP://RootDSE")
    strDNSDomain = objRootLDAP.Get("DefaultNamingContext") && Get the context
    strOU = "OU=Test,OU=OEB,OU=SAAS-users," && Your correct specifications
    objUser = Getobject("LDAP://CN=" + tcUserId +","+;
      strOU+strDNSDomain) && Get back the object to add a few more properties
    objUser.setPassword(tcPassword) && Set the password that gets encrypted -- In order to enable the account you need to set the password first
    && and it has to follow the password policies (eg: minimum number of characters, complexity etc)
    objUser.Put( "userAccountControl",ADS_UF_NORMAL_ACCOUNT) && Enable the user - by default it is disable
    objUser.SetInfo && Update the user's file

&& Ajouter un usager

Procedure addUser(tcName,tcUserId,tcFirstName,tcLastName,tcComputerName,;
      tcPassword)
#Define  ADS_UF_NORMAL_ACCOUNT 0x200
    #Define wbemAuthenticationLevelDefault 0x0
    #Define wbemChangeFlagCreateOrUpdate 0x0
    cWMInamespace = "root/directory/LDAP"
    cWMIclass = "ds_user"
    strOU = "OU=Test,OU=OEB,OU=SAAS-users,"
    strGroup = "CN=oeb-test,"
    *' Bind to Active Directory and get LDAP name
    objRootLDAP = Getobject("LDAP://RootDSE")
    strDNSDomain = objRootLDAP.Get("DefaultNamingContext") && Get the context
    objWMILocator = Createobject("WbemScripting.SWbemLocator")
    objWMILocator.Security_.AuthenticationLevel = wbemAuthenticationLevelDefault && We need the proper security to do this
    objWMIServices = objWMILocator.ConnectServer(tcComputerName, cWMInamespace, "", "") && Connect to the server that has the Active directory
    objWMIClass = objWMIServices.Get(cWMIclass) && Determine what we want to do -- Add a user.
    objWMIInstance = objWMIClass.SpawnInstance_
    objWMIInstance.DS_sAMAccountName = tcName   && Name of the user
    objWMIInstance.DS_userPrincipalName=tcUserId && Login name
    objWMIInstance.DS_givenName=tcFirstName && First name
    objWMIInstance.DS_sn=tcLastName && Last name
    objWMIInstance.DS_displayName = tcUserId && Display Name
    objWMIInstance.DS_distinguishedname=tcName && Complete name
    objWMIInstance.ADSIPath = "LDAP://CN=" + tcUserId +","+;
      strOU+strDNSDomain && Create an object with the properties
    objWMIInstance.Put_(wbemChangeFlagCreateOrUpdate) && Save the user object in Active Directory
    objUser = Getobject("LDAP://CN=" + tcUserId +","+;
      strOU+strDNSDomain) && Get back the object to add a few more properties
    objUser.setPassword(tcPassword) && Set the password that gets encrypted -- In order to enable the account you need to set the password first
    && and it has to follow the password policies (eg: minimum number of characters, complexity etc)
    objUser.Put( "userAccountControl",ADS_UF_NORMAL_ACCOUNT) && Enable the user - by default it is disable
    objUser.SetInfo && Update the user's file
    *' Prepare the OU and the Group
    objGroup = Getobject("LDAP://"+ strGroup + strOU + strDNSDomain)
    objOU =Getobject("LDAP://" +strOU + strDNSDomain)

    For Each objUser In objOU && Add the user to the correct group
      If objUser.Class = Lower("User") And tcUserId $ objUser.ADsPath
        objGroup.Add(objUser.ADsPath)
      Endif
    Endfor

[carlos vargas]

http://forums.fivetechsupport.com/viewt ... 2F#p105866