Updated 2017-11-06 20:03:06 by MHo
package require twapi
# 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 "<LDAP://${ADsPath}>;$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

if {[info exists argv0] && [file tail [info script]] eq [file tail $argv0]} {
   puts [::adtools::attrFromEMail "[email protected]" "HomeDirectory"]
   puts [::adtools::attrFromEMail "[email protected]" "HomeDirectory,cn"]
   puts [::adtools::attrFromEMail "Test.*@xyz.de" "HomeDirectory,sAMAccountName"]
   puts [::adtools::attrFromEMail "*@xyz.de" "sAMAccountName"]