Find users about to expire (Perl)

This code can be found in Chapter 6 of Active Directory Cookbook, 2nd edition

Purchase XP Cookbook or Networking Recipes for only $25 plus shipping! While supplies last.

Find out how to download all of the Perl code from this site.

# This Perl code finds the user accounts that are about to expire

# ---------------------------------------------------------------
# From the book "Active Directory Cookbook" by Robbie Allen
# ISBN: 0-596-00466-4
# ---------------------------------------------------------------

# ------ SCRIPT CONFIGURATION ------
# Domain and container/OU to check for accounts that are about to expire
my $domain   = '<DomainDNSName>';  # e.g. amer.rallencorp.com
my $cont     = ''; # set to empty string to query entire domain
                   # Or set to a relative path in the domain, e.g. cn=Users
# Number of weeks until a user will expire
my $weeks_ago = 4;
# ------ END CONFIGURATION ---------

use strict;
use Win32::OLE;
$Win32::OLE::Warn = 3;
   $Win32::OLE::Warn = 3;
use Math::BigInt;

# Need to convert the number of seconds until $weeks_ago
# to a large integer for comparison against accountExpires
my $future_secs = time + 60*60*24*7*$weeks_ago;
my $intObj = Math::BigInt->new($future_secs);
   $intObj = Math::BigInt->new( $intObj->bmul('10 000 000') );
my $future_largeint = Math::BigInt->new( $intObj->badd('116 444 736 000 000 000') );
   $future_largeint =~ s/^[+-]//;

# Now need to convert the current time into a large integer
   $intObj = Math::BigInt->new( time );
   $intObj = Math::BigInt->new($intObj->bmul('10 000 000'));
my $current_largeint = 
            Math::BigInt->new($intObj->badd('116 444 736 000 000 000'));
   $current_largeint =~ s/^[+-]//;

# Setup the ADO connections
my $connObj                         = Win32::OLE->new('ADODB.Connection');
$connObj->{Provider}                = "ADsDSOObject";
# Set these next two if you need to authenticate
# $connObj->Properties->{'User ID'}   = '<User>';     
# $connObj->Properties->{'Password'}  = '<Password>';
$connObj->Open;
my $commObj                         = Win32::OLE->new('ADODB.Command');
$commObj->{ActiveConnection}        = $connObj;
$commObj->Properties->{'Page Size'} = 1000;

# Grab the default domain name
my $rootDSE = Win32::OLE->GetObject("LDAP://$domain/RootDSE");
my $rootNC = $rootDSE->Get("defaultNamingContext");

# Run ADO query and print results
$cont .= "," if $cont and not $cont =~ /,$/;
my $query  = "<LDAP://$domain/$cont$rootNC>;";
$query .=  "(&(objectclass=user)";
$query .=    "(objectcategory=Person)";
$query .=    "(!useraccountcontrol:1.2.840.113556.1.4.803:=2)";
$query .=    "(accountExpires<=$future_largeint)";
$query .=    "(accountExpires>=$current_largeint)";
$query .=    "(!accountExpires=0));";
$query .=  "cn,distinguishedName;";
$query .= "subtree";
$commObj->{CommandText} = $query;
my $resObj = $commObj->Execute($query);
die "Could not query $domain: ",$Win32::OLE->LastError,"\n" unless ref $resObj;

print "\nUsers whose account will expire in $weeks_ago weeks or less:\n";
my $total = 0;
while (!($resObj->EOF)) {
   print "\t",$resObj->Fields("distinguishedName")->value,"\n";
   $total++;
   $resObj->MoveNext;
}
print "Total: $total\n";

This code has been viewed 3777 times.

New from the creators of TechTasks.com: StatSheet.com