Here comes a standalone sample of the windows 2000 native browser. You will need the Tk module.
You will notice the chdir in their and it doesn't produce any error but it also does not change the directory. It always goes back to the last directory browsed too.
says Simply use your question
#!/perl/bin/perl -w # always with warnings on..
use Tk 800.000;
use strict;
use vars qw/$edaType/;
use FileHandle;
my $edaType = "Visula";
use Cwd;
cadFileSelect();
sub cadFileSelect
{
my $edaType = shift;
my $cadFile = shift;
my $TOP = MainWindow->new;
$TOP->title("Select a file");
$TOP->geometry("+50+100");
$TOP->configure(-background => lc("aquamarine2"));
my $tFrame = $TOP->Frame;
my $bFrame = $TOP->Frame;
$tFrame->configure(-background => lc("PaleTurquoise"));
$bFrame->configure(-background => lc("PaleTurquoise"));
my $lab = $tFrame->Label(-text => "Select a file to open: ",
-background => "PaleTurquoise",
-anchor => 'e');
my $ent = $tFrame->Entry(-width => 50,
-textvariable => \$$cadFile,
-background => "PaleTurquoise",);
my $but = $tFrame->Button(-text => "Browse ...",
-background => "PaleTurquoise",
-activebackground => "PaleTurquoise",
-command => sub {
$$cadFile = fileDialog($edaType,$TOP);
});
my $quitButton = $bFrame->Button(-text => "Quit",
-width => 12,
-background => "PaleTurquoise",
-activebackground => "PaleTurquoise",
-command => sub {
$TOP->destroy; # strictly not necessary
Tk::exit;
});
my $continueButton = $bFrame->Button(-text => "Continue",
-width => 12,
-background => "PaleTurquoise",
-activebackground => "PaleTurquoise",
-command => sub {
if($$cadFile)
{
$TOP->destroy;
}
else
{
my $ch = $TOP->messageBox('-icon' => 'info',
-type => 'OK',
-title => 'Information',
-message => "Please select $edaTyp
+e input file");
}
});
Tk::grid($tFrame,
-row => 0,
-column => 0,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
Tk::grid($bFrame,
-row => 1,
-column => 0,
-sticky => 's',
-padx => 10,
-pady => 10,
);
Tk::grid($quitButton,
-row => 0,
-column => 0,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
Tk::grid($continueButton,
-row => 0,
-column => 1,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
Tk::grid($lab,
-row => 1,
-column => 0,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
Tk::grid($ent,
-row => 1,
-column => 1,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
Tk::grid($but,
-row => 1,
-column => 2,
-sticky => 'w',
-padx => 10,
-pady => 10,
);
MainLoop;
}
sub fileDialog
{
#
# note now receiving more args...
#
my ($textWidget, $w, $mainWin) = @_;
my @types = setFileTypes($edaType);
my $file = undef;
# Loop until valid selection is made, or user hits "Cancel"
while(not defined($file))
{
my $_pwd = getcwd();
chdir("c:\\tmp") or print STDERR "\n\tERROR in chdir: $!\n";
$file = $w->getOpenFile(-filetypes => \@types);
if(defined($file) && $file ne '')
{
return $file;
chdir($_pwd); #back to orig dir
}
else
{
my $ch = $w->messageBox('-icon' => 'error',
-type => 'OKCancel',
-title => 'Message',
-message => "Please select a $edaType input file")
+;
if($ch eq "cancel")
{
$w->destroy;
chdir($_pwd); #back to orig dir
return $ch;
}
}
}
return $file;
}
sub setFileTypes
{
my $edaType = shift;
return (["Visula Cadif file", '*'],
["Visula Cadif file", 'cadif.file']
) if($edaType eq "Visula");
# ..........etc.
# ...and in case something is very wrong, and edatype doesn't match...
return undef;
}
