====== package require twapi twapi::import_commands # # Ported by MHo from VBScript: Windows Script Referenz, T.Weltner, S. 306 # namespace eval adtools { proc attrFromEMail {mail attr} { catch {searchAD "(&(objectCategory=person)(objectClass=user)(mail=$mail))" $attr} ret return $ret } ### Parameter: # LDAP-Searchfilter # List of Attributes (separated by ,) to return (as a dictionary key value ...) # Attention: no error catching (it's up to the caller) # proc searchAD {filter return} { # ADODB-Connection set connection [comobj "ADODB.Connection"] $connection -set Provider "ADsDSOObject" $connection Open set command [comobj "ADODB.Command"] $command -set ActiveConnection $connection # ADsPath of the current domain (where this script is currently running) set rootDSE [comobj_object "LDAP://rootDSE"] set ADsPath [$rootDSE -call Get defaultNamingContext] # The query set query ";$filter;$return;subtree" # execute...oh my, why doing things simple.... $command -set CommandText $query set recordSet [$command Execute] set ret [list] if {[$recordSet RecordCount]} { while {![$recordSet EOF]} { set d [dict create] set o [$recordSet Fields] for {set i 0} {$i < [$o Count]} {incr i} { set item [$o item $i] dict set d [$item Name] [$item Value] } lappend ret $d $recordSet MoveNext } } return $ret } } ### A few tests if {[info exists argv0] && [file tail [info script]] eq [file tail $argv0]} { puts [::adtools::attrFromEMail "Test.User22@xyzk.de" "HomeDirectory"] puts [::adtools::attrFromEMail "Test.User22@xyz.de" "HomeDirectory,cn"] puts [::adtools::attrFromEMail "Test.*@xyz.de" "HomeDirectory,sAMAccountName"] puts [::adtools::attrFromEMail "*@xyz.de" "sAMAccountName"] } ====== <>Enter Category Here