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 GROUPS ******"); 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) || warn "\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=> 'imagetext', -text=> $desc, -image=> $im{ggrp}); } else { $tk{output_list}->insert('end', -itemtype=> 'imagetext', -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{domain}"; 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{server}); $tk{dir_tree} = $tk{left_frame}-> Scrolled('DirTree', -height=> '0', -width=> '0', -scrollbars=>'e',); $tk{output_label} = $tk{right_frame}-> Label(-textvariable => \$dr{perms}); $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=>"Wxtrracting drive information please wait.\nInformation is available when this box closes.\n", -cancelroutine=>sub { print "\nCancelling...\n"; $tk{mw}->unShow; die}); $tk{dir_tree}-> bind('',sub { GetPerms(); }); $tk{entry_box}-> bind('',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;