Dear Monks.

I would like to know how to program the progress bar in Perl/Tk. I have been developing (or trying very hard – since I am new to Tk) this utility that will obtain permission information pertaining to a given drive. The DirTree call display does take some time to get the tree directory structure for very large drives (where as if I use any WinNt browser and select a drive the information is almost instant). So my questions are:

1- I am I doing something wrong that causing this delay in display the DirTree of the drive?

2- If no, then how and where can I incorporate a progress bar to indicate that the script is compiling a directory tree list so the script doesn’t look like it’s hung?

3- If a drive that is either doesn't exit or its removable (i.e if the floppy or cd-rom drive) was inputted. Where in the script I can capture it and issue a Win32 based MsgBox informing of the error?
I have tried the modifying the sub OnNewPath to 
if ($tk{dir_tree}-> chdir ($dr{path}))
{
    $tk{dir_tree}-> delete('all');
    ShowServer($dr{path});
}
else
{
    Win32::MsgBox(“$^E”);
}

[download]
But this did not work.

Many Thanks to all benevolent contributors. 
require 5.006;

use strict;
use warnings 'all';

use Tk 800.005;
use Tk::TList;
use Tk::Frame;
use Tk::DirTree;
use Tk::Adjuster;
use Tk::Scrollbar;

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

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

$dr{path} = "c:\\";
$dr{server} = ShowServer($dr{path});
$dr{perms} = "Permissions '" . $dr{path} . "'";
$dr{domain} = "Domain : " . Win32::DomainName();

printf "\n%s,\t%s,\t%s,\t%s", $dr{path}, $dr{server}, $dr{perms}, $dr{
+domain} . "\n";

$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{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{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{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/);

MainLoop;
exit(0);

sub ShowServer{
    my $drv = @_;
    my $srv;
    if (Win32::NetResource::GetUNCName( my $unc, $dr{path})){
    $unc =~ s/^\\\\(\w)+//;
    $srv = $&;
    return $dr{server} = "[ Remote Server Name : " . uc($srv) . " ]";}
    else{
    $srv = Win32::NodeName();
    return $dr{server} = "[ Local Server Name : " . uc($srv) . " ]";}}
sub OnNewPath{    
    $tk{dir_tree}-> delete('all');
    $tk{dir_tree}-> chdir ($dr{path});    
    ShowServer($dr{path});}

[download]
Blackadder

In reply to Programming the progress bar in Perl/Tk and Retrieving the last error msg 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.