One the right frame I have a Directory tree structure and one the left is where local groups are displayed.

The idea is that permissions can be granted to local groups by dragging the local group Icon and dropping it on a required area on the directory tree.

This script’s display works fine, however the problems I am having are:

1- When I drag a group icon and drop it on a folder in the directory tree frame, I have to be very precise in my aiming, and in most cases the drop will land on a folder either above or below the desired one. My question here is, basically what can I do about this?, is there a way were the directory tree display can get bigger so the dropping process doesn’t have to be that precise? Or any other way where the drops can be accurate?

2- The mechanism which I permission groups to access a directory (sub AddGroupToDir ) when combined wit this Tk based form doesn’t work, however, when I run this sub on its own (i.e. in another script that only has this sub and manually feed the sub with the target dir and the group name) it works fine. Am I doing (or not doing) something correctly.

3- How can I have a list of all available drives appearing in the Directory tree structure rather than a single drive at a time. I have read the example in node Re: Re: Tk::DirTree & Win by vkonovalov and Re: Tk::DirTree & Win by svad but I think that I need much simpler example than this to get started.

I have (honestly) been doing my homework and have been read lots of stuff on Tk, however being a simple (and at most time a slow “Scribe”) plus this job I am doing is my very first Perl programming job and the time factor is not going in my favour, is the reason why I depend on the help I get from PM.

Thanking you

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 Win32::Perms;
use Win32::NetAdmin;
use Win32::AdminMisc;
use Win32::NetResource;

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

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

sub OnNewPath
{    
    $tk{dir_tree}-> delete('all');    
    $tk{dir_tree}-> chdir ($dr{path});
    GetServer($dr{path});
    $tk{localgroup_list}-> delete('0.1',"$counter");    
    Win32::AdminMisc::GetGroups("\\\\" . "$dr{server}", GROUP_TYPE_LOC
+AL, \ my @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 DragStart
{
    my ($token) = @_;
    my $w = $token->parent;
    my $e = $w->XEvent;
    my $idx = $w->GetNearest($e->x, $e->y);
    if (defined $idx)
    {
        $token->configure(-text=>$w->entrycget($idx,'-text'));
        my ($X, $Y) = ($e->X, $e->Y);
        $token->MoveToplevelWindow($X, $Y);
            $token->raise;
            $token->deiconify;
            $token->FindSite($X, $Y, $e);
    }
}

sub DropGroup
{
    my ($lb, $dnd_source, $c_dest, $sel, $dest_x, $dest_y) = @_;
    my $group_item = $dnd_source->cget('-text');
    my $nearest = $lb->GetNearest($dest_x, $dest_y);
    if (defined $nearest)
    {
        my $dir_item = $lb->entrycget($nearest, '-text');
        print "\n****** $group_item : $dir_item ******\n";    ### DEBU
+G: Show target value
        &AddGroupToDir($group_item, $dir_item);
        $lb->see($nearest);
    }
}

sub AddGroupToDir
{
    my ($group, $dir)=@_;
    my $perms = new Win32::Perms($dir) || die "\n$^E\n";
    my $counter = $perms->Get(\ my @list);
    print "\nAccount '$group'\t Path " . $perms->Path() . "\n";
    if ($perms->Add("$group", FULL|FULL, ACCESS_ALLOWED_ACE_TYPE, OBJE
+CT_INHERIT_ACE | CONTAINER_INHERIT_ACE))
    {
        $perms->SetRecurse($dir);
        $perms->Set();
        $perms->Dump();
        print "\nSuccessfully permissioned $group to $dir\n";
    }
    $perms->Close();
}

$counter = 0;

$dr{domain} = 'RABOUK';

if (Win32::NetAdmin::GetDomainController('', $dr{domain}, my $pdc))
{
    $pdc =~ m/^\\\\([^\\]+)/;
    $dr{pdc} = uc $1;
    print "\nAccessing Domain Controller '$dr{pdc}' for domain '$dr{do
+main}'\n";
}

$dr{path} = "C:\\";
$dr{server} = GetServer($dr{path});
$dr{perms} = "Permissions " . $dr{path};

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

$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{localgroup_label} = $tk{right_frame}-> Label(-text=> "Local Groups
+ List");
$tk{localgroup_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{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{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{localgroup_label}-> pack(qw/-side top -fill both/);
$tk{localgroup_list}-> pack(qw/-side top -fill both -expand 1/);

#define a source for group-to-dir drags        
$dnd_token2 = $tk{localgroup_list}->DragDrop(-event=> '<B1-Motion>', 
                                                                      
+  -sitetypes=> [qw/Local/], 
                                                                      
+  -startcommand=> \ &DragStart,);

# Define the target for group-to-dir drops.     
$tk{dir_tree}->DropSite(-droptypes=> [qw/Local/], 
                                    -dropcommand=> [\ &DropGroup, $tk{
+dir_tree}, $dnd_token2],);


if (Win32::AdminMisc::GetGroups("\\\\" . "$dr{server}", GROUP_TYPE_LOC
+AL, \ my @local_groups))
{
    map {$tk{localgroup_list}->insert('end', -itemtype=>'imagetext', -
+text=>"$_", -image=>$im{lgrp}) } @local_groups;
    $counter = $#local_groups;
}
else
{
    die "\n$^E\n";
}

MainLoop;
exit (0);
[download]

Blackadder

Edited: ~Fri Aug 9 17:10:00 2002 (GMT) by footpad: Added <readmore> tag, per Consideration.