You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
545 lines
12 KiB
545 lines
12 KiB
package Win32::Registry;
|
|
|
|
=head1 NAME
|
|
|
|
Win32::Registry - accessing the Windows registry [obsolete, use Win32::TieRegistry]
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Win32::Registry;
|
|
my $tips;
|
|
$::HKEY_LOCAL_MACHINE->Open("SOFTWARE\\Microsoft\\Windows"
|
|
."\\CurrentVersion\\Explorer\\Tips", $tips)
|
|
or die "Can't open tips: $^E";
|
|
my ($type, $value);
|
|
$tips->QueryValueEx("18", $type, $value) or die "No tip #18: $^E";
|
|
print "Here's a tip: $value\n";
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
NOTE: This module provides a very klunky interface to access the
|
|
Windows registry, and is not currently being developed actively. It
|
|
only exists for backward compatibility with old code that uses it.
|
|
For more powerful and flexible ways to access the registry, use
|
|
Win32::TieRegistry.
|
|
|
|
Win32::Registry provides an object oriented interface to the Windows
|
|
Registry.
|
|
|
|
The following "root" registry objects are exported to the main:: name
|
|
space. Additional keys must be opened by calling the provided methods
|
|
on one of these.
|
|
|
|
$HKEY_CLASSES_ROOT
|
|
$HKEY_CURRENT_USER
|
|
$HKEY_LOCAL_MACHINE
|
|
$HKEY_USERS
|
|
$HKEY_PERFORMANCE_DATA
|
|
$HKEY_CURRENT_CONFIG
|
|
$HKEY_DYN_DATA
|
|
|
|
=cut
|
|
|
|
use strict;
|
|
require Exporter;
|
|
require DynaLoader;
|
|
use Win32::WinError;
|
|
|
|
use vars qw($VERSION $AUTOLOAD @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
|
|
|
|
$VERSION = '0.07';
|
|
|
|
@ISA = qw( Exporter DynaLoader );
|
|
@EXPORT = qw(
|
|
HKEY_CLASSES_ROOT
|
|
HKEY_CURRENT_USER
|
|
HKEY_LOCAL_MACHINE
|
|
HKEY_PERFORMANCE_DATA
|
|
HKEY_CURRENT_CONFIG
|
|
HKEY_DYN_DATA
|
|
HKEY_USERS
|
|
KEY_ALL_ACCESS
|
|
KEY_CREATE_LINK
|
|
KEY_CREATE_SUB_KEY
|
|
KEY_ENUMERATE_SUB_KEYS
|
|
KEY_EXECUTE
|
|
KEY_NOTIFY
|
|
KEY_QUERY_VALUE
|
|
KEY_READ
|
|
KEY_SET_VALUE
|
|
KEY_WRITE
|
|
REG_BINARY
|
|
REG_CREATED_NEW_KEY
|
|
REG_DWORD
|
|
REG_DWORD_BIG_ENDIAN
|
|
REG_DWORD_LITTLE_ENDIAN
|
|
REG_EXPAND_SZ
|
|
REG_FULL_RESOURCE_DESCRIPTOR
|
|
REG_LEGAL_CHANGE_FILTER
|
|
REG_LEGAL_OPTION
|
|
REG_LINK
|
|
REG_MULTI_SZ
|
|
REG_NONE
|
|
REG_NOTIFY_CHANGE_ATTRIBUTES
|
|
REG_NOTIFY_CHANGE_LAST_SET
|
|
REG_NOTIFY_CHANGE_NAME
|
|
REG_NOTIFY_CHANGE_SECURITY
|
|
REG_OPENED_EXISTING_KEY
|
|
REG_OPTION_BACKUP_RESTORE
|
|
REG_OPTION_CREATE_LINK
|
|
REG_OPTION_NON_VOLATILE
|
|
REG_OPTION_RESERVED
|
|
REG_OPTION_VOLATILE
|
|
REG_REFRESH_HIVE
|
|
REG_RESOURCE_LIST
|
|
REG_RESOURCE_REQUIREMENTS_LIST
|
|
REG_SZ
|
|
REG_WHOLE_HIVE_VOLATILE
|
|
);
|
|
|
|
@EXPORT_OK = qw(
|
|
RegCloseKey
|
|
RegConnectRegistry
|
|
RegCreateKey
|
|
RegCreateKeyEx
|
|
RegDeleteKey
|
|
RegDeleteValue
|
|
RegEnumKey
|
|
RegEnumValue
|
|
RegFlushKey
|
|
RegGetKeySecurity
|
|
RegLoadKey
|
|
RegNotifyChangeKeyValue
|
|
RegOpenKey
|
|
RegOpenKeyEx
|
|
RegQueryInfoKey
|
|
RegQueryValue
|
|
RegQueryValueEx
|
|
RegReplaceKey
|
|
RegRestoreKey
|
|
RegSaveKey
|
|
RegSetKeySecurity
|
|
RegSetValue
|
|
RegSetValueEx
|
|
RegUnLoadKey
|
|
);
|
|
$EXPORT_TAGS{ALL}= \@EXPORT_OK;
|
|
|
|
bootstrap Win32::Registry;
|
|
|
|
sub import {
|
|
my $pkg = shift;
|
|
if ($_[0] && "Win32" eq $_[0]) {
|
|
Exporter::export($pkg, "Win32", @EXPORT_OK);
|
|
shift;
|
|
}
|
|
Win32::Registry->export_to_level(1+$Exporter::ExportLevel, $pkg, @_);
|
|
}
|
|
|
|
#######################################################################
|
|
# This AUTOLOAD is used to 'autoload' constants from the constant()
|
|
# XS function. If a constant is not found then control is passed
|
|
# to the AUTOLOAD in AutoLoader.
|
|
|
|
sub AUTOLOAD {
|
|
my($constname);
|
|
($constname = $AUTOLOAD) =~ s/.*:://;
|
|
#reset $! to zero to reset any current errors.
|
|
$!=0;
|
|
my $val = constant($constname, 0);
|
|
if ($! != 0) {
|
|
if ($! =~ /Invalid/) {
|
|
$AutoLoader::AUTOLOAD = $AUTOLOAD;
|
|
goto &AutoLoader::AUTOLOAD;
|
|
}
|
|
else {
|
|
my ($pack,$file,$line) = caller;
|
|
die "Unknown constant $constname in Win32::Registry "
|
|
. "at $file line $line.\n";
|
|
}
|
|
}
|
|
eval "sub $AUTOLOAD { $val }";
|
|
goto &$AUTOLOAD;
|
|
}
|
|
|
|
#######################################################################
|
|
# _new is a private constructor, not intended for public use.
|
|
#
|
|
|
|
sub _new {
|
|
my $self;
|
|
if ($_[0]) {
|
|
$self->{'handle'} = $_[0];
|
|
bless $self;
|
|
}
|
|
$self;
|
|
}
|
|
|
|
#define the basic registry objects to be exported.
|
|
#these had to be hardwired unfortunately.
|
|
# XXX Yuck!
|
|
|
|
{
|
|
package main;
|
|
use vars qw(
|
|
$HKEY_CLASSES_ROOT
|
|
$HKEY_CURRENT_USER
|
|
$HKEY_LOCAL_MACHINE
|
|
$HKEY_USERS
|
|
$HKEY_PERFORMANCE_DATA
|
|
$HKEY_CURRENT_CONFIG
|
|
$HKEY_DYN_DATA
|
|
);
|
|
}
|
|
|
|
$::HKEY_CLASSES_ROOT = _new(&HKEY_CLASSES_ROOT);
|
|
$::HKEY_CURRENT_USER = _new(&HKEY_CURRENT_USER);
|
|
$::HKEY_LOCAL_MACHINE = _new(&HKEY_LOCAL_MACHINE);
|
|
$::HKEY_USERS = _new(&HKEY_USERS);
|
|
$::HKEY_PERFORMANCE_DATA = _new(&HKEY_PERFORMANCE_DATA);
|
|
$::HKEY_CURRENT_CONFIG = _new(&HKEY_CURRENT_CONFIG);
|
|
$::HKEY_DYN_DATA = _new(&HKEY_DYN_DATA);
|
|
|
|
=head2 Methods
|
|
|
|
The following methods are supported. Note that subkeys can be
|
|
specified as a path name, separated by backslashes (which may
|
|
need to be doubled if you put them in double quotes).
|
|
|
|
=over 8
|
|
|
|
=item Open
|
|
|
|
$reg_obj->Open($sub_key_name, $sub_reg_obj);
|
|
|
|
Opens a subkey of a registry object, returning the new registry object
|
|
in $sub_reg_obj.
|
|
|
|
=cut
|
|
|
|
sub Open {
|
|
my $self = shift;
|
|
die 'usage: $obj->Open($sub_key_name, $sub_reg_obj)' if @_ != 2;
|
|
|
|
my ($subkey) = @_;
|
|
my ($result,$subhandle);
|
|
|
|
$result = RegOpenKey($self->{'handle'},$subkey,$subhandle);
|
|
$_[1] = _new($subhandle);
|
|
|
|
return 0 unless $_[1];
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item Close
|
|
|
|
$reg_obj->Close();
|
|
|
|
Closes an open registry key.
|
|
|
|
=cut
|
|
|
|
sub Close {
|
|
my $self = shift;
|
|
die 'usage: $obj->Close()' if @_ != 0;
|
|
|
|
return unless exists $self->{'handle'};
|
|
my $result = RegCloseKey($self->{'handle'});
|
|
if ($result) {
|
|
delete $self->{'handle'};
|
|
}
|
|
else {
|
|
$! = Win32::GetLastError();
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
sub DESTROY {
|
|
my $self = shift;
|
|
return unless exists $self->{'handle'};
|
|
RegCloseKey($self->{'handle'});
|
|
delete $self->{'handle'};
|
|
}
|
|
|
|
|
|
=item Connect
|
|
|
|
$reg_obj->Connect($node_name, $new_reg_obj);
|
|
|
|
Connects to a remote Registry on the node specified by $node_name,
|
|
returning it in $new_reg_obj. Returns false if it fails.
|
|
|
|
=cut
|
|
|
|
sub Connect {
|
|
my $self = shift;
|
|
die 'usage: $obj->Connect($node_name, $new_reg_obj)' if @_ != 2;
|
|
|
|
my ($node) = @_;
|
|
my ($result,$subhandle);
|
|
|
|
$result = RegConnectRegistry ($node, $self->{'handle'}, $subhandle);
|
|
$_[1] = _new($subhandle);
|
|
|
|
return 0 unless $_[1];
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item Create
|
|
|
|
$reg_obj->Create($sub_key_name, $new_reg_obj);
|
|
|
|
Opens the subkey specified by $sub_key_name, returning the new registry
|
|
object in $new_reg_obj. If the specified subkey doesn't exist, it is
|
|
created.
|
|
|
|
=cut
|
|
|
|
sub Create {
|
|
my $self = shift;
|
|
die 'usage: $obj->Create($sub_key_name, $new_reg_obj)' if @_ != 2;
|
|
|
|
my ($subkey) = @_;
|
|
my ($result,$subhandle);
|
|
|
|
$result = RegCreateKey($self->{'handle'},$subkey,$subhandle);
|
|
$_[1] = _new ($subhandle);
|
|
|
|
return 0 unless $_[1];
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item SetValue
|
|
|
|
$reg_obj->SetValue($sub_key_name, $type, $value);
|
|
|
|
Sets the default value for a subkey specified by $sub_key_name.
|
|
|
|
=cut
|
|
|
|
sub SetValue {
|
|
my $self = shift;
|
|
die 'usage: $obj->SetValue($subkey, $type, $value)' if @_ != 3;
|
|
my $result = RegSetValue($self->{'handle'}, @_);
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item SetValueEx
|
|
|
|
$reg_obj->SetValueEx($value_name, $reserved, $type, $value);
|
|
|
|
Sets the value for the value name identified by $value_name
|
|
in the key specified by $reg_obj.
|
|
|
|
=cut
|
|
|
|
sub SetValueEx {
|
|
my $self = shift;
|
|
die 'usage: $obj->SetValueEx($value_name, $reserved, $type, $value)' if @_ != 4;
|
|
my $result = RegSetValueEx($self->{'handle'}, @_);
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item QueryValue
|
|
|
|
$reg_obj->QueryValue($sub_key_name, $value);
|
|
|
|
Gets the default value of the subkey specified by $sub_key_name.
|
|
|
|
=cut
|
|
|
|
sub QueryValue {
|
|
my $self = shift;
|
|
die 'usage: $obj->QueryValue($sub_key_name, $value)' if @_ != 2;
|
|
my $result = RegQueryValue($self->{'handle'}, $_[0], $_[1]);
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item QueryKey
|
|
|
|
$reg_obj->QueryKey($classref, $number_of_subkeys, $number_of_values);
|
|
|
|
Gets information on a key specified by $reg_obj.
|
|
|
|
=cut
|
|
|
|
sub QueryKey {
|
|
my $garbage;
|
|
my $self = shift;
|
|
die 'usage: $obj->QueryKey($classref, $number_of_subkeys, $number_of_values)'
|
|
if @_ != 3;
|
|
|
|
my $result = RegQueryInfoKey($self->{'handle'}, $_[0],
|
|
$garbage, $garbage, $_[1],
|
|
$garbage, $garbage, $_[2],
|
|
$garbage, $garbage, $garbage, $garbage);
|
|
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item QueryValueEx
|
|
|
|
$reg_obj->QueryValueEx($value_name, $type, $value);
|
|
|
|
Gets the value for the value name identified by $value_name
|
|
in the key specified by $reg_obj.
|
|
|
|
=cut
|
|
|
|
sub QueryValueEx {
|
|
my $self = shift;
|
|
die 'usage: $obj->QueryValueEx($value_name, $type, $value)' if @_ != 3;
|
|
my $result = RegQueryValueEx($self->{'handle'}, $_[0], undef, $_[1], $_[2]);
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item GetKeys
|
|
|
|
my @keys;
|
|
$reg_obj->GetKeys(\@keys);
|
|
|
|
Populates the supplied array reference with the names of all the keys
|
|
within the registry object $reg_obj.
|
|
|
|
=cut
|
|
|
|
sub GetKeys {
|
|
my $self = shift;
|
|
die 'usage: $obj->GetKeys($arrayref)' if @_ != 1 or ref($_[0]) ne 'ARRAY';
|
|
|
|
my ($result, $i, $keyname);
|
|
$keyname = "DummyVal";
|
|
$i = 0;
|
|
$result = 1;
|
|
|
|
while ( $result ) {
|
|
$result = RegEnumKey( $self->{'handle'},$i++, $keyname );
|
|
if ($result) {
|
|
push( @{$_[0]}, $keyname );
|
|
}
|
|
}
|
|
return(1);
|
|
}
|
|
|
|
=item GetValues
|
|
|
|
my %values;
|
|
$reg_obj->GetValues(\%values);
|
|
|
|
Populates the supplied hash reference with entries of the form
|
|
|
|
$value_name => [ $value_name, $type, $data ]
|
|
|
|
for each value in the registry object $reg_obj.
|
|
|
|
=cut
|
|
|
|
sub GetValues {
|
|
my $self = shift;
|
|
die 'usage: $obj->GetValues($hashref)' if @_ != 1;
|
|
|
|
my ($result,$name,$type,$data,$i);
|
|
$name = "DummyVal";
|
|
$i = 0;
|
|
while ( $result=RegEnumValue( $self->{'handle'},
|
|
$i++,
|
|
$name,
|
|
undef,
|
|
$type,
|
|
$data ))
|
|
{
|
|
$_[0]->{$name} = [ $name, $type, $data ];
|
|
}
|
|
return(1);
|
|
}
|
|
|
|
=item DeleteKey
|
|
|
|
$reg_obj->DeleteKey($sub_key_name);
|
|
|
|
Deletes a subkey specified by $sub_key_name from the registry.
|
|
|
|
=cut
|
|
|
|
sub DeleteKey {
|
|
my $self = shift;
|
|
die 'usage: $obj->DeleteKey($sub_key_name)' if @_ != 1;
|
|
my $result = RegDeleteKey($self->{'handle'}, @_);
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item DeleteValue
|
|
|
|
$reg_obj->DeleteValue($value_name);
|
|
|
|
Deletes a value identified by $value_name from the registry.
|
|
|
|
=cut
|
|
|
|
sub DeleteValue {
|
|
my $self = shift;
|
|
die 'usage: $obj->DeleteValue($value_name)' if @_ != 1;
|
|
my $result = RegDeleteValue($self->{'handle'}, @_);
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item Save
|
|
|
|
$reg_obj->Save($filename);
|
|
|
|
Saves the hive specified by $reg_obj to a file.
|
|
|
|
=cut
|
|
|
|
sub Save {
|
|
my $self = shift;
|
|
die 'usage: $obj->Save($filename)' if @_ != 1;
|
|
my $result = RegSaveKey($self->{'handle'}, @_);
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item Load
|
|
|
|
$reg_obj->Load($sub_key_name, $file_name);
|
|
|
|
Loads a key specified by $sub_key_name from a file.
|
|
|
|
=cut
|
|
|
|
sub Load {
|
|
my $self = shift;
|
|
die 'usage: $obj->Load($sub_key_name, $file_name)' if @_ != 2;
|
|
my $result = RegLoadKey($self->{'handle'}, @_);
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
=item UnLoad
|
|
|
|
$reg_obj->Unload($sub_key_name);
|
|
|
|
Unloads a registry hive.
|
|
|
|
=cut
|
|
|
|
sub UnLoad {
|
|
my $self = shift;
|
|
die 'usage: $obj->UnLoad($sub_key_name)' if @_ != 1;
|
|
my $result = RegUnLoadKey($self->{'handle'}, @_);
|
|
$! = Win32::GetLastError() unless $result;
|
|
return $result;
|
|
}
|
|
|
|
1;
|
|
__END__
|