This script that I wrote allows you to look up file handles either by
name (any character string the filename may contain) or by user who has
the file open. Right now it works only on the domain you are logged on
to, but if you log on to another domain, it will work there as well.
Hope you find it useful,
Attached: NetFiles.txt (renamed from NetFiles.pl)
--Chuck
__________________________________________________
Do You Yahoo!?
Yahoo! Shopping - Thousands of Stores. Millions of Products.
http://shopping.yahoo.com/
#! perl -w
#�����������������#
# NetFiles.pl #
# Chuck Lawhorn #
# 05/24/2000 #
#_________________#
use Tk;
use Tk::DialogBox;
use Tk::TFrame;
use Tk::Optionmenu;
use Tk::ROText;
use Win32;
use Win32API::Net;
use Win32::Lanman;
#perl2exe_include Tk/Menu.pm
use strict;
#�������������#
# VARIABLES #
#_____________#
use vars qw(
$About
$B_Search
$B_Close
$B_Update
$Current_Search
$Domain
$Entry
$Entry_Frame
$File
$File_ID
$File_User
$MB_File_Entry
$MB_File_Search
$MB_Search
$MB_Search_File
$MB_Search_User
$Message
$MW
$Old_String
$Open
$Opt_Frame
$Opt
$PDC
$Pipe
$Previous_Search
$Program_Name
$Server
$Status
$Stop
$String
$Text_Box
$User_Name
$Version
@Files
@Illegal_Char
@Server
@Users
%Attrib
%Users
);
#����������������#
# PROGRAM BODY #
#________________#
$Version = 'RC0.32 - May 24, 2000';
&Pre_Flight;
&GUI;
#���������������#
# SUBROUTINES #
#_______________#
sub Pre_Flight {
my( $Name, $Type, @Server_List );
if( $^X =~ /perl.exe$/i ) {
$0 =~ s/^.*\\|.pl//gi;
$Program_Name = uc( $0 )
} else {
$^X =~ s/^.*\\|.exe$//gi;
$Program_Name = uc( $^X )
} # End if
$Domain = $ENV{'USERDOMAIN'};
$Domain ne uc( $ENV{'COMPUTERNAME'} ) || &Error_Box( 'You are not logged
onto a Windows NT Domain.' );
Win32::Lanman::NetGetDCName( '', $Domain, \$PDC ) || &Error_Box( "The PDC for domain
$Domain is not responding." );
Win32::Lanman::NetUserGetInfo( $PDC, Win32::LoginName, \%Attrib);
$Attrib{'priv'} == USER_PRIV_ADMIN || &Error_Box( 'ERROR 0005: Insufficient
Privilege' );
foreach $Type ( SV_TYPE_DOMAIN_CTRL, SV_TYPE_DOMAIN_BAKCTRL, SV_TYPE_SERVER_NT ) {
Win32::Lanman::NetServerEnum( $PDC, $Domain, $Type, \@Server_List);
foreach $Name ( @Server_List ) { push( @Server, ${$Name}{'name'})}
} # End foreach
@Server = sort @Server;
$Current_Search = $Message = $Old_String = $Previous_Search = $String = '';
@Illegal_Char = qw( question quotedbl slash greater less bar )
} # End sub Pre_Flight
#_____________________________________________________________
#�������������������������������������������������������������
sub Error_Box {
Win32::MsgBox( shift, 16, "$Program_Name - Error" );
my $Action = shift;
(( defined $Action ) && ( $Action == 1 )) ? return : exit
} # End sub Error_Box
#_____________________________________________________________
#�������������������������������������������������������������
sub GUI {
my( $B_Exit, $B_Frame, $L_Frame, $MB_File, $MB_Help, $Menu_Bar, $Outer_Frame );
$MW = MainWindow->new(
-borderwidth => 3,
-relief => 'groove',
-title => $Program_Name );
$MW->withdraw;
$MW->Label(
-anchor => 'w',
-relief => 'ridge',
-textvariable => \$Message
)->pack(
-fill => 'x',
-side => 'bottom' );
$MW->configure( -menu => $Menu_Bar = $MW->Menu );
$MB_File = $Menu_Bar->cascade(
-label => '~File',
-tearoff => 0 );
$MB_File_Entry = $MB_File->command(
-accelerator => 'Alt+E',
-command => sub{ $Entry->focus },
-label => '~Enter Search String',
-state => 'disabled' );
$MB_File->command(
-accelerator => 'F5',
-command => sub{ $B_Update->invoke },
-label => '~Update Open File List' );
$MB_File_Search = $MB_File->command(
-accelerator => 'Alt+S',
-command => sub{ $B_Search->invoke },
-label => '~Search Open Files',
-state => 'disabled' );
$MB_File->command(
-accelerator => 'Alt+L',
-command => sub{ $B_Close->invoke },
-label => 'C~lose an Open File' );
$MB_File->separator;
$MB_File->command(
-accelerator => 'Alt+F4',
-command => sub{ exit },
-label => 'E~xit' );
$MB_Search = $Menu_Bar->cascade(
-label => 'Se~arch',
-tearoff => 0 );
$MB_Search_File = $MB_Search->command(
-command => sub{ &By_File( 'File' );
$Entry->focus },
-label => 'Search by ~File Name' );
$MB_Search_User = $MB_Search->cascade(
-label => 'Search by User ~Name',
-state => 'disabled',
-tearoff => 0 );
foreach( 0 .. 1 ) {
$MB_Search_User->radiobutton(
-command => sub{ $#Users = -1;
&By_Name( $Current_Search )},
-label => ' Sort by ' . ( 'Open Files', 'User Name' )[$_],
-underline => 9,
-value => ( 'Open', 'Name' )[$_],
-variable => \$Current_Search );
} # End foreach
$Menu_Bar->separator;
$MB_Help = $Menu_Bar->cascade(
-label => '~Help',
-tearoff => 0 );
$MB_Help->command(
-accelerator => 'F1',
-command => sub{ &About },
-label => "About $Program_Name" );
$Outer_Frame = $MW->Frame->pack;
$Outer_Frame->Label(
-height => 1,
-text => "Domain: $Domain"
)->pack(
-pady => 10,
-side => 'top' );
$Opt_Frame = $Outer_Frame->TFrame(
-label => [ -text => sprintf( '%sServer', $#Server
? 'Select ' : '' ),
-underline => $#Server ? 10 : -1 ]
)->pack(
-padx => 2,
-pady => 2,
-side => 'left' );
( $Server ) = $PDC =~ m|\\*(.*)|;
$Opt = $Opt_Frame->Optionmenu(
-borderwidth => $#Server ? 2 : 1,
-command => sub{ $B_Update->invoke },
-disabledforeground => 'black',
-indicatoron => $#Server ? 1 : 0,
-options => \@Server,
-relief => $#Server ? 'raised' : 'solid',
-state => $#Server ? 'active' : 'disabled',
-takefocus => $#Server ? 1 : 0,
-variable => \$Server,
-width => $#Server ? 25 : 30
)->pack(
-padx => $#Server ? 5 : 4,
-pady => $#Server ? 13 : 14 );
$Entry_Frame = $Outer_Frame->TFrame(
-label => [ -text => 'Enter Search String',
-underline => 0 ]
)->pack(
-padx => 2,
-side => 'right' );
$L_Frame = $MW->TFrame(
-borderwidth => 1,
-label => 'Open File Status',
-relief => 'solid'
)->pack(
-fill => 'x',
-ipady => 3,
-padx => 25,
-pady => 2 );
$L_Frame->Label(
-textvariable => \$Status
)->pack;
$Text_Box = $MW->Scrolled(
'ROText',
-background => 'light green',
-cursor => 'arrow',
-font => [ 'MS Sans Serif', 8 ],
-height => 17,
-insertontime => 0,
-insertwidth => 0,
-scrollbars => '',
-selectbackground => 'light green',
-selectforeground => 'black',
-tabs => [ '.75c', '1.75c' ],
-takefocus => 0,
-width => 100,
-wrap => 'none'
)->pack(
-padx => 25,
-pady => 5 );
$Text_Box->Subwidget( 'yscrollbar' )->configure( -takefocus => 0 );
$B_Frame = $MW->Frame->pack( -pady => 10 );
$B_Update = $B_Frame->Button(
-command => sub{ $Text_Box->delete( '1.0', 'end' );
$Stop = 1;
$Message = '';
&Get_Files },
-text => 'Update',
-underline => 0,
-width => 8
)->pack(
-padx => 15,
-side => 'left' );
$B_Search = $B_Frame->Button(
-command => \&Search_Files,
-state => 'disabled',
-text => 'Search',
-underline => 0,
-width => 8
)->pack(
-padx => 15,
-side => 'left' );
$B_Close = $B_Frame->Button(
-command => \&Choose_File,
-state => 'disabled',
-text => 'Close File',
-underline => 1,
-width => 8
)->pack(
-padx => 15,
-side => 'left' );
$B_Exit = $B_Frame->Button(
-command => sub{ exit },
-text => 'Exit',
-underline => 1,
-width => 8
)->pack(
-padx => 15,
-side => 'left' );
foreach( '<Alt-l>', '<Alt-L>' ) { $MW->bind( $_, sub{ $B_Close ->invoke })}
foreach( '<Alt-s>', '<Alt-S>' ) { $MW->bind( $_, sub{ $B_Search->invoke })}
foreach( '<Alt-u>', '<Alt-U>' ) { $MW->bind( $_, sub{ $B_Update->invoke })}
foreach( '<Alt-v>', '<Alt-V>' ) { $MW->bind( $_, sub{ $Opt ->focus if $#Server
})}
foreach( '<Alt-x>', '<Alt-X>' ) { $MW->bind( $_, sub{ exit })}
$Opt->bind( '<Leave>', sub{ $Message = '' });
$Opt->bind( '<Enter>', sub{ $Message = $Opt->cget( -state ) eq 'active' ?
'Choose a server to search from the pull-down menu' :
'' });
$B_Search->bind( '<Enter>', sub{ $Message = $B_Search->cget( -state ) eq 'active' ?
sprintf( 'Search $Server for %s',
$String eq '*' ? 'all open filenames'
: "open filenames containing
\"$String\"" ) : '' });
$B_Close ->bind( '<Enter>', sub{ $Message = $B_Close->cget( -state ) eq 'active' ?
'Close an open file by entering the File ID' : ''
});
$B_Update->bind( '<Enter>', sub{ $Message = "Update open file list for server
$Server" });
$B_Exit ->bind( '<Enter>', sub{ $Message = "Exit $Program_Name" });
$MW ->bind( '<F1>', sub{ &About });
$MW ->bind( '<F5>', sub{ $B_Update->invoke });
$MW ->bind( 'Tk::Button', '<Return>', 'invoke' );
$MW ->bind( 'Tk::Button', '<Leave>', sub{ $Message = '' });
foreach( [ '<Home>', 0, '1.0' ],
[ '<End>', 1, 'end' ] ) { $Text_Box->bind( $$_[0], [ sub{
$Text_Box->yviewMoveto( $_[1] );
$Text_Box->markSet( 'insert', $_[2] )
}, $$_[1], $$_[2]
])}
foreach( [ '<Up>', -1 ],
[ '<Down>', 1 ],
[ '<Prior>', -1 ],
[ '<Next>', 1 ] ) {
$Text_Box->bind( $$_[0], [ sub{ $Text_Box->yviewScroll( $_[1], 'units' )},
$$_[1] ])
} # End foreach
foreach( [ '<Left>', 0 ],
[ '<Right>', .5 ] ) {
$Text_Box->bind( $$_[0], [ sub{ $Text_Box->xviewMoveto( $_[1] )}, $$_[1] ])
} # End foreach
$MW->bind( '<Visibility>', sub{ $MW->bind( '<Visibility>', undef );
&Get_Files });
&By_File( 'File' );
$MW ->OnDestroy( sub{ exit });
$Entry->focusForce;
&Center( $MW, 'r' )
} # End sub GUI
#_____________________________________________________________
#�������������������������������������������������������������
sub About{
my( $TL_About, $B_OK );
$TL_About = $MW->Toplevel(
-background => 'white',
-borderwidth => 2,
-relief => 'solid' );
$TL_About->withdraw;
$TL_About->Label(
-background => '#FFFF40',
-relief => 'raised',
-text => $Program_Name . ( $^X =~ /perl.exe/i ? ' (Script)' : '' )
)->pack(
-ipadx => 10,
-ipady => 3,
-pady => 15 );
$TL_About->Label(
-background => 'white',
-text => join( "\n",
'Program Version ' . $Version,
'Perl Version ' . $],
'Active Perl Version ' . Win32::BuildNumber,
'Perl/Tk Version ' . $Tk::VERSION,
'____________________________',
'����������������������������',
'Written by Chuck Lawhorn',
'(Sytel, Inc.)',
'for the US Office',
'of Personnel Management' )
)->pack( -padx => 15 );
$B_OK = $TL_About->Button(
-command => sub{ $TL_About->destroy },
-text => 'OK',
-width => 6
)->pack( -pady => 10 );
foreach( '<FocusOut>', '<Return>', '<Escape>' ) { $B_OK->bind( $_, 'invoke' )}
$TL_About->bind( '<Alt-F4>', sub{ exit });
$B_OK->focus;
&Center( $TL_About, 'org' )
} # End sub About
#_____________________________________________________________
#�������������������������������������������������������������
sub Center{
my( $XOffset, $YOffset, $Window, $Params ) = ( 0, 21, @_ );
$Window->update;
if( $Params =~ /o/ ) { $Window->overrideredirect( 1 ); ( $XOffset, $YOffset ) = ( 3,
0 )}
if( $Params =~ /r/ ) { $Window->resizable( 0, 0 )}
if( $Params =~ /g/ ) { $Window->grab }
if( $Params =~ /G/ ) { $Window->grabGlobal }
my $X_Pos = int(( $Window->screenwidth - $Window->width ) / 2 ) + $XOffset;
my $Y_Pos = int(( $Window->screenheight - $Window->height ) / 2 ) - $YOffset;
$Window->geometry( $Window->width .'x'. $Window->height .'+'. $X_Pos .'+'. $Y_Pos );
$Window->deiconify;
MainLoop
} # End sub Center
#_____________________________________________________________
#�������������������������������������������������������������
sub Get_Files {
my( $Err, $Last_User, $Num_Users, $Open_Status );
$#Files = $#Users = -1;
undef %Users;
$Text_Box->delete( '1.0', 'end' );
$Status = "Getting file status from $Server...";
$Message = '' if( $Message =~ /^Update/ );
$MW->update;
if( !Win32::Lanman::NetFileEnum( $Server, '', '', \@Files )) {
$Err = Win32::FormatMessage( Win32::Lanman::GetLastError );
&Error_Box( "The operation on the server $Server failed with the following
error:\n$Err", 1 );
foreach( 0 .. $#Server ) { if( $Server eq $Server[$_] ) { splice( @Server, $_, 1
); last }}
$Opt_Frame->configure(
-label => [ -text => sprintf( '%sServer', $#Server ? 'Select
' : '' ),
-underline => $#Server ? 10 : -1 ]);
$Opt->packForget;
$Opt = $Opt_Frame->Optionmenu(
-borderwidth => $#Server ? 2 : 1,
-command => sub{ $B_Update->invoke },
-disabledforeground => 'black',
-indicatoron => $#Server ? 1 : 0,
-options => \@Server,
-relief => $#Server ? 'raised' : 'solid',
-state => $#Server ? 'active' : 'disabled',
-takefocus => $#Server ? 1 : 0,
-variable => \$Server,
-width => $#Server ? 25 : 30
)->pack(
-padx => $#Server ? 5 : 4,
-pady => $#Server ? 13 : 14 );
( $Server ) = $PDC =~ m|\\*(.*)|;
} # End if
$Pipe = 0;
$Open = @Files;
foreach ( @Files ) {
if( ${$_}{'pathname'} =~ /^\\PIPE/ ) {
--$Open;
++$Pipe
} else {
$Users{uc( ${$_}{'username'})}++;
$Last_User = uc( ${$_}{'username'})
} # End if
} # End foreach
$Num_Users = keys( %Users );
&Commify( $Num_Users, $Open, $Pipe );
$Open_Status = $Open ? sprintf( ' (opened by %s)',
keys %Users > 1 ? "$Num_Users user" . ( $Num_Users eq '1' ?
'' : 's' ) : $Last_User )
: '';
$Status = sprintf 'There are %s file%s%s and %s pipe%s open on %s.',
$Open || 'no',
$Open eq '1' ? '' : 's',
$Open_Status,
$Pipe,
$Pipe eq '1' ? '' : 's',
$Server;
$MW->update;
if( !$Open ) {
$Previous_Search = '';
&By_File( 'File' )
} # End if
$B_Close->configure( -state => $Open ? 'normal' : 'disabled' );
if( $Current_Search eq 'File' ) {
foreach( $MB_File_Entry, $MB_Search, $Entry ) { $_->configure( -state => $Open ?
'normal' : 'disabled' )}
$Entry_Frame->configure( -foreground => $Open ? 'black' : '#808080' );
$Entry ->configure( -background => $Open ? 'white' : 'SystemButtonFace' )
} else {
$Previous_Search = '';
&By_Name( $Current_Search ) if keys %Users
} # End if
$MB_Search_User->configure( -state => keys %Users ? 'normal' : 'disabled' );
$Entry->focusForce
} # End sub Get_Files
#_____________________________________________________________
#�������������������������������������������������������������
sub By_File {
$Current_Search = shift;
return if( $Current_Search eq $Previous_Search );
$Entry->packForget if( Exists( $Entry ));
$String = '';
$Entry_Frame->configure(
-label => [ -text => 'Enter Search String',
-underline => 0 ]);
$Entry = $Entry_Frame->Entry(
-state => 'normal',
-textvariable => \$String,
-width => 30
)->pack(
-padx => 6,
-pady => 17 );
foreach( '<Alt-e>', '<Alt-E>' ) { $MW->bind( $_, sub{ $Entry->focus })}
$Entry->bind( '<Leave>', sub{ $Message = '' });
$Entry->bind( '<Enter>', sub{ $Message = $Entry->cget( -state ) eq 'normal' ?
'Enter a text string to search for, or * to
display all open files' : '' });
$Entry->bind( '<Return>', sub{ $B_Search->invoke });
$Entry->bind( '<KeyPress>', [ \&Update_Search_Widgets, Ev('K') ]);
$Entry->focus;
$B_Search->bind( '<Enter>', sub{ $Message = $B_Search->cget( -state ) eq 'active' ?
sprintf "Search $Server for %s",
( $String eq '*' ? 'all open filenames'
: "open filenames containing
\"$String\"" ) : '' });
$B_Search->configure( -command => \&Search_Files,
-state => 'disabled' );
$MB_File_Search->configure( -state => 'disabled' );
foreach( $MB_File_Entry, $Entry ) { $_->configure( -state => $Open ? 'normal' :
'disabled' )}
$User_Name = '';
$Entry->focus;
$Previous_Search = $Current_Search
} # End sub By_File
#_____________________________________________________________
#�������������������������������������������������������������
sub By_Name{
$Current_Search = shift;
return if( $Current_Search eq $Previous_Search );
$Entry->packForget if( $Previous_Search eq 'File' );
$Entry_Frame->configure(
-label => [ -text => sprintf( 'Choose User (%s)',
$Current_Search eq 'Name' ? 'Name' : 'Files' ),
-underline => 5 ]);
$MB_File_Entry->configure( -state => 'disabled' );
if( $Current_Search eq 'Name' ) {
foreach( sort keys %Users ) { push( @Users, "$_ ($Users{$_})")}
} else {
foreach( sort { $Users{$b} <=> $Users{$a} } keys %Users ) { push( @Users, "$_
($Users{$_})")}
} # End if
if( $Previous_Search eq 'File' ) {
$Entry = $Entry_Frame->Scrolled(
'Listbox',
-background => 'light green',
-height => 3,
-scrollbars => 'oe',
-selectmode => 'browse',
-width => 27
)->pack( -padx => 5 )
} # End if
$Entry->delete( 0, 'end' );
foreach ( @Users ) { $Entry->insert( 'end', $_ )}
$B_Search->configure( -command => sub{ $User_Name = $Users[$Entry->index('active')];
$User_Name =~ s| .*||;
&Search_Files },
-state => 'normal' );
$MB_File_Search->configure( -state => 'normal' );
foreach( '<Double-1>', '<Return>' ) { $Entry->bind( $_, sub{ $B_Search->invoke })}
$Entry->bind( '<Enter>', sub{ $Message = 'Choose a user name from the list' });
$Entry->bind( '<Leave>', sub{ $Message = '' });
$Entry->bind( '<1>', sub{ $Entry->focus });
$Entry->bind( '<KeyPress>', undef );
$B_Search->bind( '<Enter>', sub{ $Message = $B_Search->cget( -state ) eq 'active' ?
sprintf( "Search server $Server for files opened
by %s",
$Users[$Entry->index( 'active' )]) :
'' });
$Previous_Search = $Current_Search;
$String = '';
$Entry->selectionSet( 0 );
$Entry->focus
} # End sub By_Name
#_____________________________________________________________
#�������������������������������������������������������������
sub Search_Files {
my $Found = my $Display = $Stop = 0;
$B_Update->configure( -text => 'Cancel' );
$B_Update->bind( '<Enter>', sub{ $Message = "Cancel search and update open file list
for server $Server" });
foreach( '<Alt-u>', '<Alt-U>' ) { $MW->bind( $_, undef )}
foreach( '<Alt-c>', '<Alt-C>' ) { $MW->bind( $_, sub{ $B_Update->invoke })}
foreach( $MB_File_Search, $B_Search ) { $_ ->configure( -state => 'disabled' )}
$Text_Box->delete( '1.0', 'end' );
$MW ->update;
$Message = '' if( $Message =~ /^Search/ );
if( $String eq '*' ) {
$String = ':';
$Entry->configure( -show => '*' )
} # End if
$Status = $User_Name ne '' ? "Searching server $Server for files opened by
$User_Name..."
: sprintf( "Searching server $Server for %s...",
$String eq ':' ? 'all open filenames' : "open
filenames containing \"$String\"" );
foreach $File ( @Files ) {
next if( ${$File}{'pathname'} =~ /^\\/ );
$File_User = uc( ${$File}{'username'});
if( $User_Name eq '' ) {
if( ${$File}{'pathname'} =~ /\Q$String/i ) { &Update_Text_Box( ++$Found )}
} else {
if( $File_User eq $User_Name ) { &Update_Text_Box( ++$Found )}
} # End if
if( $Stop ) { $String = ''; last }
} # End foreach
$B_Update->configure( -text => 'Update' );
$B_Update->bind( '<Enter>', sub{ $Message = "Update open file list for server
$Server" });
foreach( '<Alt-c>', '<Alt-C>' ) { $MW->bind( $_, undef )}
foreach( '<Alt-u>', '<Alt-U>' ) { $MW->bind( $_, sub{ $B_Update->invoke })}
return if( $Stop );
$Text_Box->see( '1.0' );
$Text_Box->markSet( 'insert', '1.0' );
$Display = $Found;
&Commify( $Display );
$Status = sprintf '%s file%s %s -- %s file%s and %s pipe%s open on %s.',
$Display || 'No',
$Found == '1' ? '' : 's',
$String eq ':' ? 'found'
: $Current_Search eq 'File' ? "found containing
\"$String\""
: 'opened by ' .
$Attrib{'fullName'} || $User_Name,
$Open,
$Open eq '1' ? '' : 's',
$Pipe,
$Pipe eq '1' ? '' : 's',
$Server;
$String = $Old_String = '';
foreach( $MB_File_Search, $B_Search ) { $_->configure( -state => 'normal' ) if(
$Current_Search ne 'File' )}
if( defined $Entry->cget( -show ) && ( $Entry->cget( -show ) eq '*' )) {
$Previous_Search = '';
&By_File( 'File' );
$MW->update
} # End if
( $Found > 4 ) ? $Text_Box->focus : $Entry->focus
} # End sub Search_Files
#_____________________________________________________________
#�������������������������������������������������������������
sub Choose_File {
my( $DB, $E_FileID, $Frame, $Response );
$DB = $MW->DialogBox(
-title => 'Close File',
-buttons => [( 'OK', 'Cancel' )]);
$Frame = $DB->add( 'Frame' )->pack( -padx => 10 );
$Frame->Label(
-text => 'Enter the File ID Number to Close: '
)->pack(
-side => 'left',
-pady => 10 );
$File_ID = '';
$E_FileID = $Frame->Entry(
-background => 'white',
-relief => 'sunken',
-textvariable => \$File_ID,
-width => 15
)->pack( -side => 'right' );
$E_FileID->focus;
$Response = $DB->Show;
if( $Response eq 'ok' ) {
$File_ID =~ s/^0+|\s+//g;
return if !$File_ID;
&Confirm
} else {
$File_ID = ''
} # End if
} # End sub Choose_File
#_____________________________________________________________
#�������������������������������������������������������������
sub Confirm {
my( $Header, $M_Text, $Response, $Result, %Info );
$Result = 0;
if( $File_ID =~ /\D/ ) {
$Header = ' Error';
$M_Text = "\"$File_ID\" is an Invalid File ID\t"
} else {
$Result = Win32::Lanman::NetFileGetInfo( $Server, $File_ID, \%Info );
if( $Result ) {
Win32API::Net::UserGetInfo( $PDC, $Info{'username'}, 10, \%Attrib );
$Header = ' Are You Sure?';
$M_Text = join( "\n",
'You are about to close the following file:',
"\nFile ID:\t$Info{'id'}",
"Path:\t$Info{'pathname'}",
"User:\t$Info{'username'}" . ( $Attrib{'fullName'} ne '' ?
"\t($Attrib{'fullName'})" : '' ),
"\nWARNING! Closing files may result in loss of data!" )
} else {
$Header = ' No Such File';
$M_Text = "No file open with ID $File_ID\t"
} # End if( $Result )
} # End if( $File_ID =~ /\D/ )
$Response = $MW->messageBox(
-default => $Result ? 'cancel' : 'ok',
-icon => $Result ? 'warning' : 'error',
-message => $M_Text,
-title => $Header,
-type => $Result ? 'OKCancel' : 'OK' );
if( $Result ) {
&Close_File if( $Response eq 'ok' )
} else {
&Get_Files
} # End if
} # End sub Confirm
#_____________________________________________________________
#�������������������������������������������������������������
sub Close_File {
my( $Err, $M_Text, $Result );
$Result = Win32::Lanman::NetFileClose( $Server, $File_ID );
if( $Result ) {
$M_Text = "File $File_ID Closed Successfully"
} else {
$Err = Win32::Lanman::GetLastError;
$M_Text = join( "\n",
"Error Closing File $File_ID:",
"Error: $Err" )
} # End if
$MW->messageBox(
-icon => $Result ? 'info' : 'error',
-title => $Result ? 'File Closed' : 'Error',
-message => $M_Text,
-type => 'OK' );
&Get_Files
} # End sub Close_File
#_____________________________________________________________
#�������������������������������������������������������������
sub Update_Text_Box {
Win32API::Net::UserGetInfo( $PDC, $File_User, 10, \%Attrib );
$Text_Box->insert( 'end', sprintf "(%s)\tFile
ID:\t%s\n\tPath:\t%s\n\tUser:\t%s\t%s\n\n",
shift,
${$File}{'id'},
${$File}{'pathname'},
$File_User,
$Attrib{'fullName'} ne '' ? "\t($Attrib{'fullName'})" :
'' );
$Text_Box->see( 'end' );
$MW ->update
} # End sub Update_Text_Box
#_____________________________________________________________
#�������������������������������������������������������������
sub Update_Search_Widgets {
return if( $String eq $Old_String );
my $KeyPressed = $_[1];
foreach( @Illegal_Char ) { chop $String if( $KeyPressed eq $_ )}
chop $String if(( $Old_String eq '*' ) || (( length( $String ) > 1 ) && $KeyPressed
eq 'asterisk' ));
foreach( $MB_File_Search, $B_Search ) { $_->configure( -state => $String ne '' ?
'normal' : 'disabled' )}
if( $Message =~ /^Search/ ) {
$Message = $String eq '' ? '' : "Search $Server for open filenames containing
\"$String\""
} # End if
$Old_String = $String
} # End sub Update_Search_Widgets
#_____________________________________________________________
#�������������������������������������������������������������
sub Commify { foreach( @_ ) { 1 while s|(\d)(\d{3})(?!\d)|$1,$2| }}
#�������������������#
# End NetFiles.pl #
#___________________#
