[DUG] Active Directory

Myles Penlington myles at ams.co.nz
Fri Mar 14 08:52:21 NZDT 2008


Here is a simple class we use. Should give you some idea. This works my
passing in a single user id, and then getting info for that user.

 

function ADsGetObject( const lpszPathName: WideString; const riid: TIID;
out ppObject ): HRESULT; stdcall; external adslib name 'ADsGetObject';

 

 

{ TGetADInfo }

 

function TGetADInfo.Connect: Boolean;

var

  HR: HRESULT;

 

begin

  //Bind to AD to increase performance ...

  CoInitialize(nil);

  HR     := ADsGetObject( 'LDAP://RootDSE', IUnknown, FRootDSE );

  Result := Succeeded( HR );

end;

 

procedure TGetADInfo.Disconnect;

begin

  //Release out hold on the AD credentials.

  FRootDSE := nil;

  CoUninitialize;

end;

 

function TGetADInfo.GetUserProperties( const UserObject: IPersonADInfo;
PropsToGet: TUserPropertiesSet ): Boolean;

const

  PropNames: array [TUserProperty] of String = ( 'email address',
'employee ID', 'phone number', 'mobile number', 'home phone number' );

 

var

  ADUser: IADsUser;

  HR: HRESULT;

  ADQuery: WideString;

  SSID: array [0..260] of AnsiChar;

  UserSID: TByteDynArray;

  DP: Integer;

  UserProperty: TUserProperty;

  Value: String;

begin

  //Take the given user name and get the users SID, then bind to the AD
user object using the SID.

  Result  := False;

  HR      := E_UNEXPECTED;

  UserSID := nil;

  if (UserObject.UserGUID <> '') then begin

    Value := UserObject.UserGUID;

    DP    := LastDelimiter( '[{}]', Value );        //Make sure the GUID
is in the right format

    while (DP <> 0) do begin

      Delete( Value, DP, 1 );

      DP := LastDelimiter( '[{}]', Value );

    end;

    ADQuery := WideFormat( 'LDAP://<GUID=%s>', [ Value ]);

    HR      := ADsGetObject( ADQuery, IADsUser, ADUser );

  end;

  if Failed( HR ) and Assigned( UserObject.UserSID ) then begin

    FillChar( SSID, SizeOf( SSID ), 0 );

    Classes.BinToHex( PChar(UserObject.UserSID), @SSID, Length(
UserObject.UserSID ));

 

    ADQuery := WideFormat( 'LDAP://<SID=%s>', [ String( SSID )]);

    HR      := ADsGetObject( ADQuery, IADsUser, ADUser );

  end;

  if Failed( HR ) and (UserObject.UserAccount <> '') then begin

    UserSID := TUserSecurityInfo.GetAccountSID( UserObject.UserAccount
);

    if Assigned( UserSID ) then begin

      FillChar( SSID, SizeOf( SSID ), 0 );

      Classes.BinToHex( PChar( UserSID), @SSID, Length( UserSID ));

 

      ADQuery := WideFormat( 'LDAP://<SID=%s>', [ String( SSID )]);

      HR      := ADsGetObject( ADQuery, IADsUser, ADUser );

    end;

  end;

 

  if Succeeded( HR ) then begin

    UserObject.UserSID  := UserSID;

    UserObject.UserGUID := ADUser.GUID;

    for UserProperty := Low( TUserProperty ) to High( TUserProperty ) do
begin

      if (UserProperty in PropsToGet) then begin

        try

          case UserProperty of

          upEmailAddress:     begin

                                Value := ADUser.EmailAddress;

                                if (Value > '') then begin

                                  UserObject.EmailAddress := Value;

                                end;

                              end;

          upEmployeeID:       UserObject.EmployeeID :=
ADUser.EmployeeID;

          upPhoneNumber:      begin

                                Value := VarToStr(
ADUser.TelephoneNumber );

                                if (Value > '') then begin

                                  UserObject.PhoneNumber := Value;

                                end;

                              end;

          upPhoneMobile:      begin

                                Value := VarToStr(
ADUser.TelephoneMobile );

                                if (Value > '') then begin

                                  UserObject.PhoneMobile := Value;

                                end;

                              end;

          upPhoneHome:        begin

                                Value := VarToStr( ADUser.TelephoneHome
);

                                if (Value > '') then begin

                                  UserObject.PhoneHome := Value;

                                end;

                              end;

          end;

          Result := True;

        except

          on E: EOleException do begin

            if E.ErrorCode = Integer($8000500D) then begin

              TMessageLogger.LogMsg( mcWarn, 'PropertyNotAvailable',
Format( 'Could not obtain %s for user %s - person %s',[ PropNames[
UserProperty], UserObject.UserAccount, UserObject.EmployeeID ]));

            end else begin

              TMessageLogger.LogMsg( mcError, 'ADGetProperty', Format(
'Person %s, User %s, Property %s. %s',[ UserObject.EmployeeID,
UserObject.UserAccount, PropNames[ UserProperty], E.Message ]));

            end;

          end;

          on E: Exception do begin

            TMessageLogger.HandleException( Self, E );

          end;

        end;

      end;

    end;

  end;

end;

 

From: delphi-bounces at listserver.123.net.nz
[mailto:delphi-bounces at listserver.123.net.nz] On Behalf Of Jeremy
Coulter
Sent: Friday, 14 March 2008 8:00 a.m.
To: 'NZ Borland Developers Group - Delphi List'
Subject: [DUG] Active Directory

 

Hi Al.

What method are people using to connect to Active Directory from Delphi?

I have done a bit of a google around, and seem to have got confused a
bit.

 

Some exampls use ADO, and htis for some reason didnt work for me, and
other used other methods, and there were a couple that worked, but didnt
quite do what aI wanted.

I have a Win2k3 small bussiness server that I am connecting too.

I want to extract the person name and their detals like DDI and extn
number.

 

Anyone else doing anything with Active Directoty that I can look at?

 

Thanks, Jeremy



Attention:
This communication is confidential and may be legally privileged.  If you are not the intended recipient, please do not use, disclose, copy or distribute it, other than to return it to us with your confirmation that it has been deleted from your system.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://listserver.123.net.nz/pipermail/delphi/attachments/20080314/c47a6a36/attachment-0001.html


More information about the Delphi mailing list