diff options
Diffstat (limited to 'Master/tlpkg/tlperl.old/lib/Win32/Registry.pm')
| -rw-r--r-- | Master/tlpkg/tlperl.old/lib/Win32/Registry.pm | 547 |
1 files changed, 547 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.old/lib/Win32/Registry.pm b/Master/tlpkg/tlperl.old/lib/Win32/Registry.pm new file mode 100644 index 00000000000..c83fca5a3b1 --- /dev/null +++ b/Master/tlpkg/tlperl.old/lib/Win32/Registry.pm @@ -0,0 +1,547 @@ +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; + +require Win32 unless defined &Win32::GetLastError; + +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. + local $! = 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__ |