Greetings fellow Monks

The following Tk based form will create three frames (well 4 frames but the one at the top is not significant), the frame on the left will display a directory tree structure and the frame on the right will display snap shot of permissions and the frame underneath this one will contain all global groups. So when a directory is selected, by pointing the mouse and clicking once on the target object, a display of the permissions on that selected directory will be displayed on the right frame….Simple eh?

However, I have the following issued:

1- How can bind the double click actions? So if I double click on an account icon on the right frame, this will invoke a certain procedure (like removing the permission recursively –I have no problem with the recursive permission removal, however I can’t get the double click action to work (return the selection i.e. the account name).


2- How can I get the frame on the right to display the data in a table form? At the moment the script will only get the account name that is permissioned to access the selected directory and it will stick an icon next to it depending if the account is a use or local/global groups. I would like to enumerate the access rights and some other information and have them displayed diagonally.

3- Because the permissions displayed on the right frame can contain users, local and global groups. How can I restrict the script to only pick the user type account and not be able to pick any other account apart from the users?

4- The extra frame will contain a listing of all global groups available. How can I restrict the drop and drag action so that it will only drag from the first frame on the right and only be able to drop in the extra frame on the right also.

Many Thanks for your help and “perls of wisdom” in advance.

Yours Blackadder

PS : if you cut and paste this script don’t forget to change the domain name 
require 5.006;

use strict;
use warnings 'all';

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

use File::Find;

use OLE;
use Win32;
use Win32::ODBC;
use Win32::Perms;
use Win32::NetAdmin;
use Win32::AdminMisc;
use Win32::FileSecurity;
use Win32::NetResource;
use Win32API::File;

# $tk{widget_refs}, $dr{data_refs}, $im{image_refs}
use vars qw/%tk %dr %im @global_groups @local_groups $counter $dnd_tok
+en1 $dnd_token2 $dnd_token3/;
$counter = 0;
$dr{domain} = 'MyDomain';

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

sub DragStart {
    my($token) = @_;
    my $w = $token->parent; # $w is the source listbox
    my $e = $w->XEvent;
    my $idx = $w->GetNearest($e->x, $e->y); # get the listbox entry un
+der cursor
    if (defined $idx)  {
            # Configure the dnd token to show the listbox entry
            $token->configure(-text => $w->entrycget($idx, '-text') );
            # Show the token
            my($X, $Y) = ($e->X, $e->Y);
            $token->MoveToplevelWindow($X, $Y);
            $token->raise;
            $token->deiconify;
            $token->FindSite($X, $Y, $e);  }}

sub DropUserOnGroup{
    my ($lb, $dnd_source) = @_;
    my $usr_item = $dnd_source->cget('-text');
    # figure out where in the group listbox the drop occurred
    my $y = $lb->pointery - $lb->rooty;
    my $x = $lb->pointerx - $lb->rootx;
    my $nearest = $lb->nearest($x,$y);
    if (defined $nearest) {
            my $ggrp_item = $lb->entrycget($nearest, '-text');
            my $rsp =Win32::MsgBox("Adding User to Global Group,\n\n\n
+User: '$usr_item'\n\nTo\n\nGlobal Group: '$ggrp_item'\n", 0x00000004|
+0x00000020|0x00001000,    "Group ACE permission");
            &AddUserToGroup($usr_item, $ggrp_item)  if (0x06==$rsp);
            $lb->see($nearest);}
        else{
            Win32::MsgBox("Try again",0x00000000|0x00000040|0x00000000
+,"Drop failure");}}

sub GetPerms{
    my $path = $tk{dir_tree}->selectionGet();    
    &ShowPathInfo($path);}

#sub GetUser{
    #my $usr = $tk{output_list}-> curselection();
    #print "\nSelected user '$usr'\n";}

# This method is bound to the 'enter' key so that we can update
# the path information from the entry widget.
sub OnNewPath
{
    $tk{dir_tree}-> delete('all');
    $tk{dir_tree}->chdir( $dr{path} );
    &ShowPathInfo( $dr{path} );
    GetServer($dr{path});
    $tk{localgroup_list}-> delete('0',"$counter");    
    @local_groups = ();
    Win32::AdminMisc::GetGroups("\\\\" . "$dr{server}", GROUP_TYPE_LOC
+AL, \ @local_groups) || die "\n$^E\n";
    $counter = $#local_groups;
    $tk{localgroup_list}-> delete('0.1',"$counter");    
    map {$tk{localgroup_list}->insert('end', -itemtype=>'imagetext', -
+text=>"$_", -image=>$im{lgrp}) } @local_groups;}

sub ShowPathInfo{
    my ($path) = @_;
    my %perms;   
    print "Path: $path \n";
    $dr{perms} = "Permisssions: $path";
    $tk{output_list}-> delete('0.1','end');
    $tk{output_list}-> insert('end', -itemtype=> 'text', -text=> "***Y
+OU CAN ONLY DRAG USER NOT GROUPS***\tPath [$path]");
    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\t\tEnum Rights: " . $rights
+;
        if (Win32::NetAdmin::UsersExist("\\\\" . $dr{pdc}, $ACL_owner)
+)    {
            $tk{output_list}->insert('end', -itemtype=>    'imagetext'
+, -text=> $ACL_owner, -image=> $im{usr});}
        else{
            if ($& =~ /RABOUK/i){
                $tk{output_list}->insert('end', -itemtype=>    'imaget
+ext', -text=> $ACL_owner, -image=> $im{ggrp});}
            else{
                $tk{output_list}->insert('end', -itemtype=>    'imaget
+ext', -text=> $ACL_owner, -image=> $im{lgrp});}}}}

sub AddUserToGroup {
    my ($usr, $grp) = @_;
    my $result = Win32::NetAdmin::GroupAddUsers("\\\\"."londcn0001", $
+grp, $usr);
    if ($result){
        my $msg = ("Account: '$usr' was added to: '$grp'");
        Win32::MsgBox($msg,0x00000000|0x00000040|0x00000000,"Operation
+ Successful");}
else{        
    my $error = ("Failed to add '$usr' to '$grp'\n\n***PLEASE CONTACT 
+THE ADMINISTRATOR***\n");
    Win32::MsgBox($error,0x00000000|0x00000040|0x00000000,"Operation F
+ailed");}    
    print "\n$usr, $grp\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\t$msg\n\t$lngth\n";}

$dr{path} = "C:\\";
$dr{server} = GetServer($dr{path});
$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{bottom_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{perm
+s});
$tk{output_list} = $tk{right_frame}->Scrolled('TList', -height=>'1', -
+width=>'1',  -scrollbars=>'osoe',);

$tk{globalgroup_label} = $tk{right_frame}-> Label(-text=> "Global Grou
+ps List [ Domain: " . $dr{domain} . ", PDC: " . $dr{pdc} . " ]");
$tk{globalgroup_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');

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

#I am having problem with the folowing line
#$tk{output_list}->bind('<Double-Button-1>',sub { my $tk{output_list}-
+>selectionSet(); 
#                                                                     
+   my $selected_object = $tk{output_list}->get($indx);});
$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{bottom_frame}-> pack(qw/-side bottom -fill x/);
$tk{adjuster}-> pack(qw/-side left -fill y/);
$tk{right_frame}-> pack(qw/-side right -fill both -expand 1/);

$tk{entry_box_label}-> pack(qw/-side left -fill both/);
$tk{entry_box}-> pack(qw/-side top -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/);

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

$dnd_token1 = $tk{output_list}->DragDrop
    (-event=> '<B1-Motion>', -sitetypes=> [qw/Local/], -startcommand=>
+ \&DragStart,);
$tk{globalgroup_list}->DropSite (-droptypes     => [qw/Local/],
     -dropcommand   => [\&DropUserOnGroup, $tk{globalgroup_list}, $dnd
+_token1 ], ); 
if (Win32::AdminMisc::GetGroups("\\\\" . "$dr{pdc}", GROUP_TYPE_GLOBAL
+, \ @global_groups)){
    map {$tk{globalgroup_list}->insert('end', -itemtype=>'imagetext', 
+-text=>"$_", -image=>$im{ggrp}) } @global_groups;}
else{
    die "\n$^E\n";}

MainLoop;
exit 0;

[download]

In reply to Tweaking Perl/Tk by blackadder

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.