1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:

'Define variables
Dim conn
Dim command
Dim rs
Dim objArgs
Dim NoGroups
Dim objNetwork

'Get active User
Set objNetwork = CreateObject("Wscript.Network")
txtUserID = objNetwork.UserName
txtDomain = objNetwork.UserDomain

'**Start Encode**

'Query the Global Catalog to find the user or group,
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADsDSOObject"
conn.open "DS Query"

set command=CreateObject("ADODB.Command")
set command.ActiveConnection = conn
command.CommandText = "<GC://dc=domain,DC=tld>;(cn="& txtUserID & ");cn,AdsPath;subTree"

set rs=CreateObject("ADODB.Recordset")
set rs=command.execute

If rs.RecordCount <> 1 Then
WScript.Echo "User could not be found."
WScript.Quit
End If

sUser=replace(rs("AdsPath"),"GC://","")
Set objUser=GetObject("LDAP://SERVER/" & sUser)
If Err.Number <> 0 Then
MsgBox err.number
End If
'**Stop Encode**

txtOutput = "Username : " & txtUserID & vbCrLf
txtOutput = txtOutput & "Display Name: " & objUser.displayName & vbCrLf
txtOutput = txtOutput & "Description : " & objUser.Description & vbCrLf
txtOutput = txtoutput & "Department : " & objUser.department & vbCrLf
txtOutput = txtOutput & "Domain: " & txtDomain & vbCrLf
txtOutput = txtOutput & "mail : " & objUser.mail & vbCrLf
txtOutput = txtOutput & "Home Drive: " & objUser.homeDrive & vbCrLf
txtOutput = txtOutput & "Home Drive Path: " & objUser.homeDirectory & vbCrLf
txtOutput = txtOutput & "Telefon : " & objUser.telephoneNumber & vbCrLf
txtOutput = txtOutput & "Kostenstelle : " & objUser.rocheLocalCostCenter


MsgBox txtOutput

Set objNetwork=Nothing
Set conn=Nothing
Set command=Nothing
Set rs=Nothing					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:

procedure TForm1.Button1Click(Sender: TObject);
var
conn,com,rs: variant;
sUser,txtUser,txtDomain: string;
begin
  conn := CreateOleObject('ADODB.Connection');
  com := CreateOleObject('ADODB.Command');
  try
    conn.Provider := 'ADsDSOObject';
    conn.open;
    com.ActiveConnection := conn;
    txtUser := Edit1.Text;
    com.CommandText :='<LDAP://SERVER>;cn=' + txtUser + ';cn,AdsPath,subtree';

    com.Properties['Page Size'] := 100000;
    com.Properties['Searchscope'] := 2;
    com.Properties['Cache Results'] := False;
    rs := com.Execute;                                   // hier bleibt der debugger stehen
if Not rs.EOF then
    begin
    Edit2.Text := txtUser;
    Edit3.Text := rs.Fields['displayName'].Value;
    Edit4.Text := rs.Fields['description'].Value;
    Edit5.Text := rs.Fields['department'].Value;
    Edit6.Text := 'bla';
    Edit7.Text := rs.Fields['mail'].Value;
    Edit8.Text := rs.Fields['homeDrive'].Value;
    Edit9.Text := rs.Fields['homeDirectory'].Value;
    Edit10.Text := rs.Fields['telephoneNumber'].Value;
    Edit11.Text := rs.Fields['rocheLocalCostCenter'].Value;
    end
else
      MessageDlg('Kein Datensatz gefunden.',mtInformation,[mbOK],0);
    Rs := NULL;
  finally
    com := NULL;
    conn.Close;
    conn := NULL;
  end;
end;