Web Listing 1: The FindEmail.pl script
use strict;
use Getopt::Long;
use Win32::OLE;

# Create default configuration hash
my %Config = (
   address_path   => "",
   find           => [],
   server         => "",
   help           => 0,
);

Configure( \%Config );
if( $Config{help} )
{
    Syntax();
    exit();
}

# Find the domain's AD server
my $ADServer = Win32::OLE->GetObject( "LDAP://$Config{server}RootDse" ) || die "Unable to 
locate domain controller.\n";
my $AccountList;
foreach my $Email ( @{$Config{find}} ) 
{
   # Search for a given email address
   print "Searching for $Email...";
   $AccountList = FindEmailAddressAccount( $ADServer, $Email );
   Display( $AccountList );
}
sub FindEmailAddressAccount 
{
   my( $ADServer, $EmailAddress ) = @_;
   my @AccountList;
   # Get the domain's default naming context
   my $DomainContext = $ADServer->Get( "DefaultNamingContext" ) || die "Unable to connect to 
domain controller.\n";
   # Construct the LDAP query
   my $Query = 
"<LDAP://$Config{address_path}$DomainContext>;(|(mail=*$EmailAddress*)(proxyAddresses=*:*
$EmailAddress*));ADsPath;subtree";
   # Create an ADODB connection to the ADSI provider
   my $AdoDB = Win32::OLE->new( "ADODB.Connection" ) || die "Can not create ADODB 
connection";
   $AdoDB->{Provider} = "ADSDSOObject";
   $AdoDB->Open( "ADs Provider" );
   # Submit the query
   if( my $Record = $AdoDB->Execute( $Query ) )
   {
      # Process each ADO record returned
      while( 0 == $Record->EOF ) 
      {
         my $Account = Win32::OLE->GetObject( $Record->Fields(0)->{Value} );
         push( @AccountList, $Account );
         $Record->MoveNext();
      }
   }
   return( \@AccountList );
}

sub Display 
{
   my( $AccountList ) = @_;
   if( scalar @$AccountList )
   {
      my $iCount;

      print "Found " . scalar @$AccountList . " account matches:\n";
      foreach my $Account ( @{$AccountList} ) 
      {
         my %ProxyAddressList;
         my @ProxyList;
         if( "ARRAY" eq ref $Account->{ProxyAddresses} )
         {
            push( @ProxyList, @{$Account->{ProxyAddresses}} );
         }
         else
         {
            push( @ProxyList, $Account->{ProxyAddresses} );
         }
         
         # Walk through each proxy address and create an hash entry for it
         foreach my $EmailAddress ( @ProxyList, "Main Email:" . $Account->{mail} )
         {
            $EmailAddress =~ /^(.+?):(.*)$/;
            push( @{$ProxyAddressList{lc $1}}, ( ( $1 eq uc $1 )? "* ":"  " ) . $2 );
         } 
         print "\n";
         printf( "\t%d) %s (%s)\n", ++$iCount, 
                                    $Account->{DisplayName}, 
                                    $Account->{userPrincipalName} || $Account->{sAMAccountName} || "n/a" 
);
         print "\t$Account->{Description}\n" if( defined $Account->{Description} );
         print "\t$Account->{AdsPath}\n";
         # Cycle through each protocol and display addresses
         foreach my $Protocol ( sort{ lc $a cmp lc $b} ( keys( %ProxyAddressList ) ) )
         {
            my $iCount = 0;
            print "\t\t\U$Protocol\E Addresses\n";
            foreach my $Email ( sort( {lc $a cmp lc $b } @{$ProxyAddressList{$Protocol}} ) )
            {
              printf( "\t\t  % 3d) %s\n", ++$iCount, $Email );
            }
            print "\n";
         }
         print "\t", "-" x 40, "\n";
      }
   }
   else
   {
      print "not found\n";
   }
}

sub Configure
{
    my( $Config, @Args ) = @_;
    my $Result;
    Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
    $Result = GetOptions( $Config, 
                          qw( 
                            server|s=s
                            address_path|a=s
                            help|?
                          ) );

    push( @{$Config->{find}}, @ARGV ) if( scalar @ARGV );
    $Config->{server} .= "/" if( "" ne $Config->{server} );
    $Config->{address_path} .= "," if( "" ne $Config{address_path} );
    $Config->{help} = 1 unless( $Result && scalar @{$Config->{find}} );
}

sub Syntax
{
    my( $Script ) = ( $0 =~ m#([^\\/]+)$# );
    my $Line = "-" x length( $Script );
    print STDERR << "EOT";

    $Script
    $Line
    Queries Active Directory for an email address.
    Syntax: $0 [-a PATH] [-s SERVER] EMAIL [EMAIL2 ...]
      -a PATH..........Address path to query for the specified email address.
                       Default is to search the entire tree.
      -s SERVER........Server to use for the query.
      EMAIL............Email address to find.

      $0 -a "CN=Users" admin\@mycompany.com
EOT
}