require 5.006;

use strict;
use warnings 'all';

use Tk 800.005;
use Tk::TList;
use Tk::Table;
use Tk::Frame;
use Tk::Dialog;
use Tk::DirTree;
use Tk::Adjuster;
use Tk::Toplevel;
use Tk::Scrollbar;
use Tk::DropSite;
use Tk::DragDrop;

use File::Find;
use Time::localtime;

use Win32;
use Win32::NetAdmin;
use Win32::AdminMisc;
use Win32::FileSecurity;
use Win32::NetResource;

use vars qw/%tk %dr %im $counter/;

$counter = 0;
$dr{domain} = 'RABOUK';

sub GetServer
{
    if (Win32::NetResource::GetUNCName(my $unc, $dr{path}))
    {
        $unc =~ m/^\\\\([^\\]+)\\/;
        $dr{server} = uc $1;
    }
    else
    {
        $dr{server} = Win32::NodeName();
    }
}

sub GetPerms
{
    my $path = $tk{dir_tree}->selectionGet(); 
    $dr{path} = $path;
    print "\nUser clicked to change the path to: $dr{path} \n";
    &ShowPathInfo($path);
}

sub ShowPathInfo
{
    my ($path) = @_;
    my %perms;   
    $dr{perms} = "Permisssions: $path"; 
    print "\nObtaining Path ACL $dr{perms}\n";
    $tk{output_list}-> delete('0.1','end');
    $tk{output_list}-> insert('end', -itemtype=> 'text', -text=> "****
+** PLEASE NOTE : THAT, IN THIS WINDOW, YOU CAN ONLY DRAG USERS NOT GR
+OUPS ******");
    Win32::FileSecurity::Get($path, \ %perms) || warn "\n$^E : $!\n";
    while (my ($ACL_owner, $mask)= each %perms)
    {
        print "\n$ACL_owner $dr{pdc}\n";
        $ACL_owner =~ s{.+\\}{};
        Win32::FileSecurity::EnumerateRights($mask, \ my @perms) || wa
+rn "\n$^E : $!\n";
        my $rights = $perms[$#perms];
        my $desc = "$&" . $ACL_owner ."\t\tEnum Rights: " . $rights;
        if (Win32::NetAdmin::UsersExist("\\\\" . $dr{pdc}, $ACL_owner)
+)
        {
            $tk{output_list}->insert('end', -itemtype=>    'imagetext'
+, -text=> $desc, -image=> $im{usr});
        }
        else
        {
            if ($& =~ /RABOUK/i)
            {
                $tk{output_list}->insert('end', -itemtype=>    'imaget
+ext', -text=> $desc, -image=> $im{ggrp});                    
            }
            else
            {
                $tk{output_list}->insert('end', -itemtype=>    'imaget
+ext', -text=> $desc, -image=> $im{lgrp});
            }
        }        
    }
}

sub OnNewPath
{
    $tk{dir_tree}-> delete('all');
    $tk{dir_tree}->chdir( $dr{path} );
    print "\nChanged Directory to $dr{path}\n";
    &ShowPathInfo( $dr{path} );
    GetServer($dr{path});
    print "\nServer changed to : $dr{server}\n"; 
}

if (Win32::NetAdmin::GetDomainController('', $dr{domain}, my $pdc))
{
    $pdc =~ m/^\\\\([^\\]+)/;
    $dr{pdc} = uc $1;
    my $msg = "Accessing domain controller $dr{pdc} for domain $dr{dom
+ain}";
    my $lngth =  "*" x length $msg;
    print "\n\n$msg\n$lngth\n";
}

$dr{path} = "C:\\";
$dr{server} = GetServer($dr{path});
print "\nScript hosting server name:  $dr{server}\n";
$dr{perms} = "Permissions " . $dr{path};

$tk{mw} = MainWindow->new(-background => 'white');
$tk{mw}->geometry('950x800');

$tk{top_frame} = $tk{mw}-> Frame;
$tk{left_frame} = $tk{mw}-> Frame;
$tk{adjuster} = $tk{mw}-> Adjuster(-widget=> $tk{left_frame}, -side=> 
+'left');
$tk{right_frame} = $tk{mw}-> Frame;

$tk{entry_box_label} = $tk{top_frame}-> Label(-text=> "Path: ");
$tk{entry_box} = $tk{top_frame}-> Entry(-textvariable=> \ $dr{path});

$tk{dir_tree_label} = $tk{left_frame}-> Label(-textvariable=> \ $dr{se
+rver});
$tk{dir_tree} = $tk{left_frame}-> Scrolled('DirTree', -height=> '0', -
+width=> '0', -scrollbars=>'e',);

$tk{output_label} = $tk{right_frame}-> Label(-textvariable => \$dr{per
+ms});
$tk{output_list} = $tk{right_frame}-> Scrolled('TList', -height=>'1', 
+-width=>'1',  -scrollbars=>'osoe',);

$im{usr} = $tk{mw}->Photo(-file => 'c:/perl/usr.gif');
$im{lgrp} = $tk{mw}->Photo(-file => 'c:/perl/lgrp.gif');
$im{ggrp} = $tk{mw}->Photo(-file => 'c:/perl/ggrp.gif');

my $waitbox = $tk{mw}->WaitBox(-title=>"Obtaining Drive information",
                                                    -txt1=>"Wxtrractin
+g drive information please wait.\nInformation is available when this 
+box closes.\n",
                                                    -cancelroutine=>su
+b {
                                                    print "\nCancellin
+g...\n";
                                                    $tk{mw}->unShow;
                                                    die});

$tk{dir_tree}-> bind('<ButtonRelease-1>',sub { GetPerms(); });
$tk{entry_box}-> bind('<Key-Return>',sub {OnNewPath();});

$tk{top_frame}-> pack(qw/-side top -fill x/);
$tk{left_frame}-> pack(qw/-side left -fill y/);

$tk{entry_box_label}-> pack(qw/-side left -fill both/);
$tk{entry_box}-> pack(qw/-side top -fill both -expand 1/);
$tk{adjuster}-> pack(qw/-side left -fill y/);
$tk{right_frame}-> pack(qw/-side right -fill both -expand 1/);

$tk{dir_tree_label}-> pack(qw/-side top -fill both/);
$tk{dir_tree}-> pack(qw/-side left -fill both -expand 1/);

$tk{output_label}->pack(qw/-side top -fill both/);
$tk{output_list} ->pack(qw/-side top -fill both -expand 1/);

MainLoop;
exit 0;
[download]