view release on metacpan or  search on metacpan

ShellExt/CtxtMenu.pm  view on Meta::CPAN

	my $hkeys = {
	"Classes/CLSID/$CLSID" => $name,
	"Classes/CLSID/$CLSID/InProcServer32/ThreadingModel" => "Apartment",
	"Classes/CLSID/$CLSID/InProcServer32/PerlPackage" => "$package",
	"LMachine/SOFTWARE/Microsoft/Windows/CurrentVersion/Shell Extensions/Approved/$CLSID" => $name
	};

	die "cannot open registry!" unless(defined($Registry));

	$Registry->Delimiter("/");

	$Registry->{"Classes/CLSID"}->CreateKey("$CLSID")->CreateKey("InProcServer32");
	$Registry->{"Classes/*/shellex/ContextMenuHandlers"}->CreateKey("$alias");
	#$Registry->{"LMachine/SOFTWARE/Microsoft/Windows/CurrentVersion/Shell Extensions/Approved"}->CreateKey("$CLSID");

	# FIXME hard-coded location for the perlext DLL.
#	$Registry->{"Classes/CLSID/$CLSID/InProcServer32"}->{""} = "D:\\build\\perl-win32-shellext\\perlshellext.dll";
	$Registry->{"Classes/CLSID/$CLSID/InProcServer32"}->{""} = "$Config{installbin}\\perlshellext.dll";

	$Registry->{"Classes/*/shellex/ContextMenuHandlers/$alias"}->{""} = $CLSID;

	&Win32::ShellExt::create_hkeys($hkeys);
	exit 0;
}

sub uninstall() {
	my $klass = shift;
	my $h = $klass->hkeys();
	my ($CLSID,$package) = ( $h->{CLSID}, $h->{package} );
	my $alias = "$package menu";

	die "cannot open registry!" unless(defined($Registry));	

	my @hkeys = reverse ( # order is important, we must destroy subkeys first.
	"Classes/CLSID/$CLSID/InProcServer32/",
	"Classes/CLSID/$CLSID/",
	"Classes/*/shellex/ContextMenuHandlers/$alias/",
	"LMachine/SOFTWARE/Microsoft/Windows/CurrentVersion/Shell Extensions/Approved/$CLSID"
	);
	&Win32::ShellExt::remove_hkeys(@hkeys);
	exit 0;
}

1;
__END__

=head1 NAME

Win32::ShellExt - Perl module for implementing context menu extensions of the Windows Explorer

=head1 SYNOPSIS

  # Sample usage of that module:
  package Win32::ShellExt::CopyPath;

  use strict;
  use Win32::ShellExt;
  use Win32::Clipboard;

  $Win32::ShellExt::CopyPath::VERSION='0.1';
  $Win32::ShellExt::CopyPath::TEXT="Copy path to clipboard";
  @Win32::ShellExt::CopyPath::ISA=qw(Win32::ShellExt);

  sub query_context_menu() {
    "Win32::ShellExt::CopyPath";
  }

  sub action() {
	my $self = shift;
	my $CLIP = Win32::Clipboard();
	$CLIP->Set(join '\n',@_);
	1;
  }

  sub hkeys() {
	my $h = {
	"CLSID" => "{E06853EF-4421-409C-BCFE-B2A048536F67}",
	"name"  => "copy path shell Extension",
	"alias" => "copy_path_menu",
	"package" => "Win32::ShellExt::CopyPath"
	};
	$h;
  }

  1;

=head1 DESCRIPTION

This module is never used directly. You always subclass it into your own package,
then do a one-time invocation of the install() method on your package (to install
the needed registry keys). Then you should have a new entry in the contextual menu
of the Windows explorer (the files for which this menu entry appears depend on the
filtering you do in the query_context_menu method), and your action() method gets
called upon clicking the corresponding menu command in the Explorer.

Blah blah blah.

=head2 EXPORT

None by default. None needed.

=head1 AUTHOR

Jean-Baptiste Nivoit E<lt>jbnivoit@hotmail.comE<gt>

=head1 SEE ALSO

L<perl>.

=cut