# From the book "Active Directory, Third Edition" 
# ISBN: 0-596-10173-2

use Win32::OLE qw(in);
use Win32::OLE::Variant;
use constant vbCrLf => "\r\n";
use constant vbTab => "\x09";

use strict;

# **********************************************************************
# Declare the hash (dictionary), constants and variables
# **********************************************************************
my $dicADsType;
$dicADsType = Win32::OLE->new('Scripting.Dictionary');
$dicADsType->Add(0, 'INVALID');
$dicADsType->Add(1, 'DN_STRING');
$dicADsType->Add(2, 'CASE_EXACT_STRING');
$dicADsType->Add(3, 'CASE_IGNORE_STRING');
$dicADsType->Add(4, 'PRINTABLE_STRING');
$dicADsType->Add(5, 'NUMERIC_STRING');
$dicADsType->Add(6, 'BOOLEAN');
$dicADsType->Add(7, 'INTEGER');
$dicADsType->Add(8, 'OCTET_STRING');
$dicADsType->Add(9, 'UTC_TIME');
$dicADsType->Add(10, 'LARGE_INTEGER');
$dicADsType->Add(11, 'PROV_SPECIFIC');
$dicADsType->Add(12, 'OBJECT_CLASS');
$dicADsType->Add(13, 'CASEIGNORE_LIST');
$dicADsType->Add(14, 'OCTET_LIST');
$dicADsType->Add(15, 'PATH');
$dicADsType->Add(16, 'POSTALADDRESS');
$dicADsType->Add(17, 'TIMESTAMP');
$dicADsType->Add(18, 'BACKLINK');
$dicADsType->Add(19, 'TYPEDNAME');
$dicADsType->Add(20, 'HOLD');
$dicADsType->Add(21, 'NETADDRESS');
$dicADsType->Add(22, 'REPLICAPOINTER');
$dicADsType->Add(23, 'FAXNUMBER');
$dicADsType->Add(24, 'EMAIL');
$dicADsType->Add(25, 'NT_SECURITY_DESCRIPTOR');
$dicADsType->Add(26, 'UNKNOWN');

use constant ADS_PROPERTY_CLEAR => 1;
use constant ADS_PROPERTY_UPDATE => 2;
use constant ADS_PROPERTY_APPEND => 3;
use constant ADS_PROPERTY_DELETE => 4;

my $objPropValue;
# An individual property value within a loop
my $objPropEntry;
# An ADSI PropertyEntry object
my $objObject;
# The object whose property list we wish to investigate
my $strText;
# A text string used to display results in one go
my $intPropCount;
# The number of properties in 
my $intIndex;
# The index used while looping through the property list
my $intCount;
# Used to display property values in a numbered sequence

# **********************************************************************
# Uncomment one of these lines and modify it to your own environment.
# The first uses the LDAP namespace; the second uses the WinNT namespace.
# **********************************************************************
# Set objObject = GetObject("LDAP://cn=administrator,cn=users,dc=mycorp,dc=com")
# Set objObject = GetObject("WinNT://WINDOWS/Managers,Group")
$objObject->GetInfo();
if (((0 + Win32::OLE::LastError()) > 0)) {
    print "Object not found, returning...\n";
    exit 0;
}

# **********************************************************************
# Write out the current property cache total to the string that is 
# storing output
# **********************************************************************
$intPropCount = $objObject->PropertyCount;
$strText = 'There are ' . $intPropCount . ' values in the property cache.' . vbCrLf;

# **********************************************************************
# The extra vbTabs used in the first loop are to space the results so 
# that they are nicely formatted with the list of values in the second loop
# **********************************************************************
for my $intIndex (0 .. ($intPropCount - 1)) {

    $objPropEntry = $objObject->Item($intIndex);
    $strText = $strText . $objPropEntry->Name . vbCrLf;

    $strText = $strText . vbTab . 'Type:' . vbTab . vbTab . $dicADsType->Item($objPropEntry->ADsType) . vbCrLf;

    # **********************************************************************
    # Go through each property value in the property entry and use the AdsType
    # to print out the appropriate value, prefixed by a count (intCount), i.e.:
    # 
    #  Value #1: Vicky Launders
    #  Value #2: Alistair Lowe-Norris
    #  Value #3: Robbie Allen
    # **********************************************************************
    $intCount = 1;

    foreach my $objPropValue (in $objPropEntry->Values) {

        if (($dicADsType->Item($objPropValue->ADsType) eq 'STRING')) {
            $strText = $strText . vbTab . 'Value #' . $intCount . ':' . vbTab . $objPropValue->DNString . vbCrLf;

        }
        elsif (($dicADsType->Item($objPropValue->ADsType) eq 'CASE_EXACT_STRING')) {
            $strText = $strText . vbTab . 'Value #' . $intCount . ':' . vbTab . $objPropValue->CaseExactString . vbCrLf;

        }
        elsif (($dicADsType->Item($objPropValue->ADsType) eq 'CASE_IGNORE_STRING')) {
            $strText = $strText . vbTab . 'Value #' . $intCount . ':' . vbTab . $objPropValue->CaseIgnoreString . vbCrLf;

        }
        elsif (($dicADsType->Item($objPropValue->ADsType) eq 'PRINTABLE_STRING')) {
            $strText = $strText . vbTab . 'Value #' . $intCount . ':' . vbTab . $objPropValue->PrintableString . vbCrLf;

        }
        elsif (($dicADsType->Item($objPropValue->ADsType) eq 'NUMERIC_STRING')) {
            $strText = $strText . vbTab . 'Value #' . $intCount . ':' . vbTab . $objPropValue->NumericString . vbCrLf;

        }
        elsif (($dicADsType->Item($objPropValue->ADsType) eq 'BOOLEAN')) {
            $strText = $strText . vbTab . 'Value #' . $intCount . ':' . vbTab . Variant(VT_BSTR, $objPropValue->Boolean) . vbCrLf;

        }
        elsif (($dicADsType->Item($objPropValue->ADsType) eq 'INTEGER')) {
            $strText = $strText . vbTab . 'Value #' . $intCount . ':' . vbTab . $objPropValue->Integer . vbCrLf;

        }

        $intCount = $intCount + 1;

    }
}

print "$strText\n";