3441 lines
109 KiB
Perl
3441 lines
109 KiB
Perl
# Win32/TieRegistry.pm -- Perl module to easily use a Registry
|
|
# (on Win32 systems so far).
|
|
# by Tye McQueen, tye@metronet.com, see http://www.metronet.com/~tye/.
|
|
|
|
#
|
|
# Skip to "=head" line for user documentation.
|
|
#
|
|
|
|
package Win32::TieRegistry;
|
|
|
|
use strict;
|
|
use vars qw( $PACK $VERSION @ISA @EXPORT @EXPORT_OK );
|
|
|
|
$PACK= "Win32::TieRegistry"; # Used in error messages.
|
|
$VERSION= '0.21'; # Released Sept 17, 1998
|
|
|
|
use Carp;
|
|
require Tie::Hash;
|
|
@ISA= qw(Tie::Hash);
|
|
|
|
# Required other modules:
|
|
use Win32API::Registry 0.12 qw( :KEY_ :HKEY_ :REG_ );
|
|
|
|
#Optional other modules:
|
|
use vars qw( $_NoMoreItems $_FileNotFound $_TooSmall $_MoreData $_SetDualVar );
|
|
|
|
if( eval { require Win32::WinError } ) {
|
|
$_NoMoreItems= Win32::WinError::constant("ERROR_NO_MORE_ITEMS",0);
|
|
$_FileNotFound= Win32::WinError::constant("ERROR_FILE_NOT_FOUND",0);
|
|
$_TooSmall= Win32::WinError::constant("ERROR_INSUFFICIENT_BUFFER",0);
|
|
$_MoreData= Win32::WinError::constant("ERROR_MORE_DATA",0);
|
|
} else {
|
|
$_NoMoreItems= "^No more data";
|
|
$_FileNotFound= "cannot find the file";
|
|
$_TooSmall= " data area passed to ";
|
|
$_MoreData= "^more data is avail";
|
|
}
|
|
if( $_SetDualVar= eval { require SetDualVar } ) {
|
|
import SetDualVar;
|
|
}
|
|
|
|
|
|
#Implementation details:
|
|
# When opened:
|
|
# HANDLE long; actual handle value
|
|
# MACHINE string; name of remote machine ("" if local)
|
|
# PATH list ref; machine-relative full path for this key:
|
|
# ["LMachine","System","Disk"]
|
|
# ["HKEY_LOCAL_MACHINE","System","Disk"]
|
|
# DELIM char; delimiter used to separate subkeys (def="\\")
|
|
# OS_DELIM char; always "\\" for Win32
|
|
# ACCESS long; usually KEY_ALL_ACCESS, perhaps KEY_READ, etc.
|
|
# ROOTS string; var name for "Lmachine"->HKEY_LOCAL_MACHINE map
|
|
# FLAGS int; bits to control certain options
|
|
# Often:
|
|
# VALUES ref to list of value names (data/type never cached)
|
|
# SUBKEYS ref to list of subkey names
|
|
# SUBCLASSES ref to list of subkey classes
|
|
# SUBTIMES ref to list of subkey write times
|
|
# MEMBERS ref to list of subkey_name.DELIM's, DELIM.value_name's
|
|
# MEMBHASH hash ref to with MEMBERS as keys and 1's as values
|
|
# Once Key "Info" requested:
|
|
# Class CntSubKeys CntValues MaxSubKeyLen MaxSubClassLen
|
|
# MaxValNameLen MaxValDataLen SecurityLen LastWrite
|
|
# When tied to a hash and iterating over key values:
|
|
# PREVIDX int; index of last MEMBERS element return
|
|
# When tied to a hash and iterating over key values:
|
|
# UNLOADME list ref; information about Load()ed key
|
|
# When a subkey of a "loaded" key:
|
|
# DEPENDON obj ref; object that can't be destroyed before us
|
|
|
|
|
|
#Package-local variables:
|
|
|
|
# Option flag bits:
|
|
use vars qw( $Flag_ArrVal $Flag_TieVal $Flag_DualTyp $Flag_DualBin
|
|
$Flag_FastDel $Flag_HexDWord $Flag_Split $Flag_FixNulls );
|
|
$Flag_ArrVal= 0x0001;
|
|
$Flag_TieVal= 0x0002;
|
|
$Flag_FastDel= 0x0004;
|
|
$Flag_HexDWord= 0x0008;
|
|
$Flag_Split= 0x0010;
|
|
$Flag_DualTyp= 0x0020;
|
|
$Flag_DualBin= 0x0040;
|
|
$Flag_FixNulls= 0x0080;
|
|
|
|
|
|
use vars qw( $RegObj %_Roots %RegHash $Registry );
|
|
|
|
# Short-hand for HKEY_* constants:
|
|
%_Roots= (
|
|
"Classes" => HKEY_CLASSES_ROOT,
|
|
"CUser" => HKEY_CURRENT_USER,
|
|
"LMachine" => HKEY_LOCAL_MACHINE,
|
|
"Users" => HKEY_USERS,
|
|
"PerfData" => HKEY_PERFORMANCE_DATA, # Too picky to be useful
|
|
"CConfig" => HKEY_CURRENT_CONFIG,
|
|
"DynData" => HKEY_DYN_DATA, # Too picky to be useful
|
|
);
|
|
|
|
# Basic master Registry object:
|
|
$RegObj= {};
|
|
@$RegObj{qw( HANDLE MACHINE PATH DELIM OS_DELIM ACCESS FLAGS ROOTS )}= (
|
|
"NONE", "", [], "\\", "\\",
|
|
KEY_READ|KEY_WRITE, $Flag_HexDWord|$Flag_FixNulls, "${PACK}::_Roots" );
|
|
$RegObj->{FLAGS} |= $Flag_DualTyp|$Flag_DualBin if $_SetDualVar;
|
|
bless $RegObj;
|
|
|
|
# Fill cache for master Registry object:
|
|
@$RegObj{qw( VALUES SUBKEYS SUBCLASSES SUBTIMES )}= (
|
|
[], [ keys(%_Roots) ], [], [] );
|
|
grep( s#$#$RegObj->{DELIM}#,
|
|
@{ $RegObj->{MEMBERS}= [ @{$RegObj->{SUBKEYS}} ] } );
|
|
@$RegObj{qw( Class MaxSubKeyLen MaxSubClassLen MaxValNameLen
|
|
MaxValDataLen SecurityLen LastWrite CntSubKeys CntValues )}=
|
|
( "", 0, 0, 0, 0, 0, 0, 0, 0 );
|
|
|
|
# Create master Registry tied hash:
|
|
$RegObj->Tie( \%RegHash );
|
|
|
|
# Create master Registry combination object and tied hash reference:
|
|
$Registry= \%RegHash;
|
|
bless $Registry;
|
|
|
|
|
|
# Preloaded methods go here.
|
|
|
|
# Map option names to name of subroutine that controls that option:
|
|
use vars qw( @_opt_subs %_opt_subs );
|
|
@_opt_subs= qw( Delimiter ArrayValues TieValues SplitMultis DWordsToHex
|
|
FastDelete FixSzNulls DualTypes DualBinVals AllowLoad AllowSave );
|
|
@_opt_subs{@_opt_subs}= @_opt_subs;
|
|
|
|
sub import
|
|
{
|
|
my $pkg= shift(@_);
|
|
my $level= $Exporter::ExportLevel;
|
|
my $expto= caller($level);
|
|
my @export= ();
|
|
my @consts= qw( :KEY_ :REG_ );
|
|
my $registry= $Registry->Clone;
|
|
local( $_ );
|
|
while( @_ ) {
|
|
$_= shift(@_);
|
|
if( /^\$(\w+::)*\w+$/ ) {
|
|
push( @export, "ObjVar" ) if /^\$RegObj$/;
|
|
push( @export, $_ );
|
|
} elsif( /^\%(\w+::)*\w+$/ ) {
|
|
push( @export, $_ );
|
|
} elsif( /^[$%]/ ) {
|
|
croak "${PACK}->import: Invalid variable name ($_)";
|
|
} elsif( /^:/ || /^(H?KEY|REG)_/ ) {
|
|
Win32API::Registry->export( $expto, $_ )
|
|
unless /^:$/;
|
|
@consts= ();
|
|
} elsif( ! @_ ) {
|
|
croak "${PACK}->import: Missing argument after option ($_)";
|
|
} elsif( exists $_opt_subs{$_} ) {
|
|
$_= $_opt_subs{$_};
|
|
$registry->$_( shift(@_) );
|
|
} elsif( /^TiedRef$/ ) {
|
|
$_= shift(@_);
|
|
if( ! ref($_) && /^(\$?)(\w+::)*\w+$/ ) {
|
|
$_= '$'.$_ unless '$' eq $1;
|
|
} elsif( "SCALAR" ne ref($_) ) {
|
|
croak "${PACK}->import: Invalid var after TiedRef ($_)";
|
|
}
|
|
push( @export, $_ );
|
|
} elsif( /^TiedHash$/ ) {
|
|
$_= shift(@_);
|
|
if( ! ref($_) && /^(\%?)(\w+::)*\w+$/ ) {
|
|
$_= '%'.$_ unless '%' eq $1;
|
|
} elsif( "HASH" ne ref($_) ) {
|
|
croak "${PACK}->import: Invalid var after TiedHash ($_)";
|
|
}
|
|
push( @export, $_ );
|
|
} elsif( /^ObjectRef$/ ) {
|
|
$_= shift(@_);
|
|
if( ! ref($_) && /^(\$?)(\w+::)*\w+$/ ) {
|
|
push( @export, "ObjVar" );
|
|
$_= '$'.$_ unless '$' eq $1;
|
|
} elsif( "SCALAR" eq ref($_) ) {
|
|
push( @export, "ObjRef" );
|
|
} else {
|
|
croak "${PACK}->import: Invalid var after ObjectRef ($_)";
|
|
}
|
|
push( @export, $_ );
|
|
} elsif( /^ExportLevel$/ ) {
|
|
$level= shift(@_);
|
|
$expto= caller($level);
|
|
} elsif( /^ExportTo$/ ) {
|
|
undef $level;
|
|
$expto= caller($level);
|
|
} else {
|
|
croak "${PACK}->import: Invalid option ($_)";
|
|
}
|
|
}
|
|
@export= ('$Registry') unless @export;
|
|
while( @export ) {
|
|
$_= shift( @export );
|
|
if( /^\$((?:\w+::)*)(\w+)$/ ) {
|
|
my( $pack, $sym )= ( $1, $2 );
|
|
$pack= $expto unless defined($pack) && "" ne $pack;
|
|
no strict 'refs';
|
|
*{"${pack}::$sym"}= \${"${pack}::$sym"};
|
|
${"${pack}::$sym"}= $registry;
|
|
} elsif( /^\%((?:\w+::)*)(\w+)$/ ) {
|
|
my( $pack, $sym )= ( $1, $2 );
|
|
$pack= $expto unless defined($pack) && "" ne $pack;
|
|
no strict 'refs';
|
|
*{"${pack}::$sym"}= \%{"${pack}::$sym"};
|
|
$registry->Tie( \%{"${pack}::$sym"} );
|
|
} elsif( "SCALAR" eq ref($_) ) {
|
|
$$_= $registry;
|
|
} elsif( "HASH" eq ref($_) ) {
|
|
$registry->Tie( $_ );
|
|
} elsif( /^ObjVar$/ ) {
|
|
$_= shift( @_ );
|
|
/^\$((?:\w+::)*)(\w+)$/;
|
|
my( $pack, $sym )= ( $1, $2 );
|
|
$pack= $expto unless defined($pack) && "" ne $pack;
|
|
no strict 'refs';
|
|
*{"${pack}::$sym"}= \${"${pack}::$sym"};
|
|
${"${pack}::$sym"}= $registry->ObjectRef;
|
|
} elsif( /^ObjRef$/ ) {
|
|
${shift(@_)}= $registry->ObjectRef;
|
|
} else {
|
|
die "Impossible var to export ($_)";
|
|
}
|
|
}
|
|
}
|
|
|
|
use vars qw( @_new_Opts %_new_Opts );
|
|
@_new_Opts= qw( ACCESS DELIM MACHINE DEPENDON );
|
|
@_new_Opts{@_new_Opts}= (1) x @_new_Opts;
|
|
|
|
sub _new
|
|
{
|
|
my $this= shift( @_ );
|
|
$this= tied(%$this) if ref($this) && tied(%$this);
|
|
my $class= ref($this) || $this;
|
|
my $self= {};
|
|
my( $handle, $rpath, $opts )= @_;
|
|
if( @_ < 2 || "ARRAY" ne ref($rpath) || 3 < @_
|
|
|| 3 == @_ && "HASH" ne ref($opts) ) {
|
|
croak "Usage: ${PACK}->_new( \$handle, \\\@path, {OPT=>VAL,...} );\n",
|
|
" options: @_new_Opts\nCalled";
|
|
}
|
|
@$self{qw( HANDLE PATH )}= ( $handle, $rpath );
|
|
@$self{qw( MACHINE ACCESS DELIM OS_DELIM ROOTS FLAGS )}=
|
|
( $this->Machine, $this->Access, $this->Delimiter,
|
|
$this->OS_Delimiter, $this->_Roots, $this->_Flags );
|
|
if( ref($opts) ) {
|
|
my @err= grep( ! $_new_Opts{$_}, keys(%$opts) );
|
|
@err and croak "${PACK}->_new: Invalid options (@err)";
|
|
@$self{ keys(%$opts) }= values(%$opts);
|
|
}
|
|
bless $self, $class;
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub _split
|
|
{
|
|
my $self= shift( @_ );
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $path= shift( @_ );
|
|
my $delim= @_ ? shift(@_) : $self->Delimiter;
|
|
my $list= [ split( /\Q$delim/, $path ) ];
|
|
$list;
|
|
}
|
|
|
|
|
|
sub _rootKey
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $keyPath= shift(@_);
|
|
my $delim= @_ ? shift(@_) : $self->Delimiter;
|
|
my( $root, $subPath );
|
|
if( "ARRAY" eq ref($keyPath) ) {
|
|
$subPath= $keyPath;
|
|
} else {
|
|
$subPath= $self->_split( $keyPath, $delim );
|
|
}
|
|
$root= shift( @$subPath );
|
|
if( $root =~ /^HKEY_/ ) {
|
|
my $handle= Win32API::Registry::constant($root,0);
|
|
$handle or croak "Invalid HKEY_ constant ($root): $!";
|
|
return( $self->_new( $handle, [$root], {DELIM=>$delim} ),
|
|
$subPath );
|
|
} elsif( $root =~ /^([-+]|0x)?\d/ ) {
|
|
return( $self->_new( $root, [sprintf("0x%lX",$root)],
|
|
{DELIM=>$delim} ),
|
|
$subPath );
|
|
} else {
|
|
my $roots= $self->Roots;
|
|
if( $roots->{$root} ) {
|
|
return( $self->_new( $roots->{$root}, [$root], {DELIM=>$delim} ),
|
|
$subPath );
|
|
}
|
|
croak "No such root key ($root)";
|
|
}
|
|
}
|
|
|
|
|
|
sub _open
|
|
{
|
|
my $this= shift(@_);
|
|
$this= tied(%$this) if ref($this) && tied(%$this);
|
|
my $subPath= shift(@_);
|
|
my $sam= @_ ? shift(@_) : $this->Access;
|
|
my $subKey= join( $this->OS_Delimiter, @$subPath );
|
|
my $handle= 0;
|
|
$this->RegOpenKeyEx( $subKey, 0, $sam, $handle )
|
|
or return wantarray ? () : undef;
|
|
return $this->_new( $handle, [ @{$this->_Path}, @$subPath ],
|
|
{ ACCESS=>$sam, ( defined($this->{UNLOADME}) ? ("DEPENDON",$this)
|
|
: defined($this->{DEPENDON}) ? ("DEPENDON",$this->{DEPENDON}) : () )
|
|
} );
|
|
}
|
|
|
|
|
|
sub ObjectRef
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
$self;
|
|
}
|
|
|
|
|
|
sub _connect
|
|
{
|
|
my $this= shift(@_);
|
|
$this= tied(%$this) if ref($this) && tied(%$this);
|
|
my $subPath= pop(@_);
|
|
$subPath= $this->_split( $subPath ) unless ref($subPath);
|
|
my $machine= @_ ? shift(@_) : shift(@$subPath);
|
|
my $handle= 0;
|
|
my( $temp )= $this->_rootKey( [@$subPath] );
|
|
$temp->RegConnectRegistry( $machine, $temp->Handle, $handle )
|
|
or return wantarray ? () : undef;
|
|
my $self= $this->_new( $handle, [shift(@$subPath)], {MACHINE=>$machine} );
|
|
( $self, $subPath );
|
|
}
|
|
|
|
|
|
use vars qw( @Connect_Opts %Connect_Opts );
|
|
@Connect_Opts= qw(Access Delimiter);
|
|
@Connect_Opts{@Connect_Opts}= (1) x @Connect_Opts;
|
|
|
|
sub Connect
|
|
{
|
|
my $this= shift(@_);
|
|
my $tied= ref($this) && tied(%$this);
|
|
$this= tied(%$this) if $tied;
|
|
my( $machine, $key, $opts )= @_;
|
|
my $delim= "";
|
|
my $sam;
|
|
my $subPath;
|
|
if( @_ < 2 || 3 < @_
|
|
|| 3 == @_ && "HASH" ne ref($opts) ) {
|
|
croak "Usage: \$obj= ${PACK}->Connect(",
|
|
" \$Machine, \$subKey, { OPT=>VAL,... } );\n",
|
|
" options: @Connect_Opts\nCalled";
|
|
}
|
|
if( ref($opts) ) {
|
|
my @err= grep( ! $Connect_Opts{$_}, keys(%$opts) );
|
|
@err and croak "${PACK}->Connect: Invalid options (@err)";
|
|
}
|
|
$delim= "$opts->{Delimiter}" if defined($opts->{Delimiter});
|
|
$delim= $this->Delimiter if "" eq $delim;
|
|
$sam= defined($opts->{Access}) ? $opts->{Access} : $this->Access;
|
|
$sam= Win32API::Registry::constant($sam,0) if $sam =~ /^KEY_/;
|
|
( $this, $subPath )= $this->_connect( $machine, $key );
|
|
return wantarray ? () : undef unless defined($this);
|
|
my $self= $this->_open( $subPath, $sam );
|
|
return wantarray ? () : undef unless defined($self);
|
|
$self->Delimiter( $delim );
|
|
$self= $self->TiedRef if $tied;
|
|
return $self;
|
|
}
|
|
|
|
|
|
my @_newVirtual_keys= qw( MEMBERS VALUES SUBKEYS SUBTIMES SUBCLASSES
|
|
Class SecurityLen LastWrite CntValues CntSubKeys
|
|
MaxValNameLen MaxValDataLen MaxSubKeyLen MaxSubClassLen );
|
|
|
|
sub _newVirtual
|
|
{
|
|
my $self= shift(@_);
|
|
my( $rPath, $root, $opts )= @_;
|
|
my $new= $self->_new( "NONE", $rPath, $opts )
|
|
or return wantarray ? () : undef;
|
|
@{$new}{@_newVirtual_keys}= @{$root->ObjectRef}{@_newVirtual_keys};
|
|
return $new;
|
|
}
|
|
|
|
|
|
#$key= new Win32::TieRegistry "LMachine/System/Disk";
|
|
#$key= new Win32::TieRegistry "//Server1/LMachine/System/Disk";
|
|
#Win32::TieRegistry->new( HKEY_LOCAL_MACHINE, {DELIM=>"/",ACCESS=>KEY_READ} );
|
|
#Win32::TieRegistry->new( [ HKEY_LOCAL_MACHINE, ".../..." ], {DELIM=>$DELIM} );
|
|
#$key->new( ... );
|
|
|
|
use vars qw( @new_Opts %new_Opts );
|
|
@new_Opts= qw(Access Delimiter);
|
|
@new_Opts{@new_Opts}= (1) x @new_Opts;
|
|
|
|
sub new
|
|
{
|
|
my $this= shift( @_ );
|
|
$this= tied(%$this) if ref($this) && tied(%$this);
|
|
my( $subKey, $opts )= @_;
|
|
my $delim= "";
|
|
my $dlen;
|
|
my $sam;
|
|
my $subPath;
|
|
if( @_ < 1 || 2 < @_
|
|
|| 2 == @_ && "HASH" ne ref($opts) ) {
|
|
croak "Usage: \$obj= ${PACK}->new( \$subKey, { OPT=>VAL,... } );\n",
|
|
" options: @new_Opts\nCalled";
|
|
}
|
|
if( defined($opts) ) {
|
|
my @err= grep( ! $new_Opts{$_}, keys(%$opts) );
|
|
@err and die "${PACK}->new: Invalid options (@err)";
|
|
}
|
|
$delim= "$opts->{Delimiter}" if defined($opts->{Delimiter});
|
|
$delim= $this->Delimiter if "" eq $delim;
|
|
$dlen= length($delim);
|
|
$sam= defined($opts->{Access}) ? $opts->{Access} : $this->Access;
|
|
$sam= Win32API::Registry::constant($sam,0) if $sam =~ /^KEY_/;
|
|
if( "ARRAY" eq ref($subKey) ) {
|
|
$subPath= $subKey;
|
|
if( "NONE" eq $this->Handle && @$subPath ) {
|
|
( $this, $subPath )= $this->_rootKey( $subPath );
|
|
}
|
|
} elsif( $delim x 2 eq substr($subKey,0,2*$dlen) ) {
|
|
my $path= $this->_split( substr($subKey,2*$dlen), $delim );
|
|
my $mach= shift(@$path);
|
|
if( ! @$path ) {
|
|
return $this->_newVirtual( $path, $Registry,
|
|
{MACHINE=>$mach,DELIM=>$delim,ACCESS=>$sam} );
|
|
}
|
|
( $this, $subPath )= $this->_connect( $mach, $path );
|
|
return wantarray ? () : undef if ! defined($this);
|
|
if( 0 == @$subPath ) {
|
|
$this->Delimiter( $delim );
|
|
return $this;
|
|
}
|
|
} elsif( $delim eq substr($subKey,0,$dlen) ) {
|
|
( $this, $subPath )= $this->_rootKey( substr($subKey,$dlen), $delim );
|
|
} elsif( "NONE" eq $this->Handle && "" ne $subKey ) {
|
|
my( $mach )= $this->Machine;
|
|
if( $mach ) {
|
|
( $this, $subPath )= $this->_connect( $mach, $subKey );
|
|
} else {
|
|
( $this, $subPath )= $this->_rootKey( $subKey, $delim );
|
|
}
|
|
} else {
|
|
$subPath= $this->_split( $subKey, $delim );
|
|
}
|
|
return wantarray ? () : undef unless defined($this);
|
|
if( 0 == @$subPath && "NONE" eq $this->Handle ) {
|
|
return $this->_newVirtual( $this->_Path, $this,
|
|
{ DELIM=>$delim, ACCESS=>$sam } );
|
|
}
|
|
my $self= $this->_open( $subPath, $sam );
|
|
return wantarray ? () : undef unless defined($self);
|
|
$self->Delimiter( $delim );
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub Open
|
|
{
|
|
my $self= shift(@_);
|
|
my $tied= ref($self) && tied(%$self);
|
|
$self= tied(%$self) if $tied;
|
|
$self= $self->new( @_ );
|
|
$self= $self->TiedRef if defined($self) && $tied;
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub Clone
|
|
{
|
|
my $self= shift( @_ );
|
|
my $new= $self->Open("");
|
|
return $new;
|
|
}
|
|
|
|
|
|
{ my @flush;
|
|
|
|
sub Flush
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my( $flush )= @_;
|
|
@_ and croak "Usage: \$key->Flush( \$bFlush );";
|
|
return 0 if "NONE" eq $self->Handle;
|
|
@flush= qw( VALUES SUBKEYS SUBCLASSES SUBTIMES MEMBERS Class
|
|
CntSubKeys CntValues MaxSubKeyLen MaxSubClassLen
|
|
MaxValNameLen MaxValDataLen SecurityLen LastWrite PREVIDX )
|
|
unless @flush;
|
|
delete( @$self{@flush} );
|
|
if( defined($flush) && $flush ) {
|
|
return $self->RegFlushKey();
|
|
} else {
|
|
return 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub _DualVal
|
|
{
|
|
my( $hRef, $num )= @_;
|
|
if( $_SetDualVar && $$hRef{$num} ) {
|
|
&SetDualVar( $num, "$$hRef{$num}", 0+$num );
|
|
}
|
|
$num;
|
|
}
|
|
|
|
|
|
use vars qw( @_RegDataTypes %_RegDataTypes );
|
|
@_RegDataTypes= qw( REG_NONE REG_SZ REG_EXPAND_SZ REG_BINARY
|
|
REG_DWORD_LITTLE_ENDIAN REG_DWORD_BIG_ENDIAN
|
|
REG_DWORD REG_LINK REG_MULTI_SZ REG_RESOURCE_LIST
|
|
REG_FULL_RESOURCE_DESCRIPTOR
|
|
REG_RESOURCE_REQUIREMENTS_LIST );
|
|
# Make sure REG_DWORD appears _after_ other REG_DWORD_* items above.
|
|
foreach( @_RegDataTypes ) {
|
|
$_RegDataTypes{Win32API::Registry::constant($_,0)}= $_;
|
|
}
|
|
|
|
sub GetValue
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
1 == @_ or croak "Usage: (\$data,\$type)= \$key->GetValue('ValName');";
|
|
my( $valName )= @_;
|
|
my( $valType, $valData, $dLen )= (0,"",0);
|
|
return wantarray ? () : undef if "NONE" eq $self->Handle;
|
|
$self->RegQueryValueEx( $valName, [], $valType, $valData,
|
|
$dLen= ( defined($self->{MaxValDataLen}) ? $self->{MaxValDataLen} : 0 )
|
|
) or return wantarray ? () : undef;
|
|
if( REG_DWORD == $valType ) {
|
|
my $val= unpack("L",$valData);
|
|
$valData= sprintf "0x%08.8lX", $val if $self->DWordsToHex;
|
|
&SetDualVar( $valData, $valData, $val ) if $self->DualBinVals
|
|
} elsif( REG_BINARY == $valType && length($valData) <= 4 ) {
|
|
&SetDualVar( $valData, $valData, hex reverse unpack("h*",$valData) )
|
|
if $self->DualBinVals;
|
|
} elsif( ( REG_SZ == $valType || REG_EXPAND_SZ == $valType )
|
|
&& $self->FixSzNulls ) {
|
|
substr($valData,-1)= "" if "\0" eq substr($valData,-1);
|
|
} elsif( REG_MULTI_SZ == $valType && $self->SplitMultis ) {
|
|
## $valData =~ s/\0\0$//; # Why does this often fail??
|
|
substr($valData,-2)= "" if "\0\0" eq substr($valData,-2);
|
|
$valData= [ split( /\0/, $valData, -1 ) ]
|
|
}
|
|
if( ! wantarray ) {
|
|
return $valData;
|
|
} elsif( ! $self->DualTypes ) {
|
|
return( $valData, $valType );
|
|
} else {
|
|
return( $valData, _DualVal( \%_RegDataTypes, $valType ) );
|
|
}
|
|
}
|
|
|
|
|
|
sub _ErrNum
|
|
{
|
|
# return $^E;
|
|
return Win32::GetLastError();
|
|
}
|
|
|
|
|
|
sub _ErrMsg
|
|
{
|
|
# return $^E;
|
|
return Win32::FormatMessage( Win32::GetLastError() );
|
|
}
|
|
|
|
sub _Err
|
|
{
|
|
my $err;
|
|
# return $^E;
|
|
return _ErrMsg if ! $_SetDualVar;
|
|
return &SetDualVar( $err, _ErrMsg, _ErrNum );
|
|
}
|
|
|
|
sub _NoMoreItems
|
|
{
|
|
$_NoMoreItems =~ /^\d/
|
|
? _ErrNum == $_NoMoreItems
|
|
: _ErrMsg =~ /$_NoMoreItems/io;
|
|
}
|
|
|
|
|
|
sub _FileNotFound
|
|
{
|
|
$_FileNotFound =~ /^\d/
|
|
? _ErrNum == $_FileNotFound
|
|
: _ErrMsg =~ /$_FileNotFound/io;
|
|
}
|
|
|
|
|
|
sub _TooSmall
|
|
{
|
|
$_TooSmall =~ /^\d/
|
|
? _ErrNum == $_TooSmall
|
|
: _ErrMsg =~ /$_TooSmall/io;
|
|
}
|
|
|
|
|
|
sub _MoreData
|
|
{
|
|
$_MoreData =~ /^\d/
|
|
? _ErrNum == $_MoreData
|
|
: _ErrMsg =~ /$_MoreData/io;
|
|
}
|
|
|
|
|
|
sub _enumValues
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my( @names )= ();
|
|
my $pos= 0;
|
|
my $name= "";
|
|
my $nlen= 1+$self->Information("MaxValNameLen");
|
|
while( $self->RegEnumValue($pos++,$name,$nlen,[],[],[],[]) ) {
|
|
push( @names, $name );
|
|
}
|
|
if( ! _NoMoreItems() ) {
|
|
return wantarray ? () : undef;
|
|
}
|
|
$self->{VALUES}= \@names;
|
|
1;
|
|
}
|
|
|
|
|
|
sub ValueNames
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \@names= \$key->ValueNames;";
|
|
$self->_enumValues unless $self->{VALUES};
|
|
return @{$self->{VALUES}};
|
|
}
|
|
|
|
|
|
sub _enumSubKeys
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my( @subkeys, @classes, @times )= ();
|
|
my $pos= 0;
|
|
my( $subkey, $class, $time )= ("","","");
|
|
my( $namSiz, $clsSiz )= $self->Information(
|
|
qw( MaxSubKeyLen MaxSubClassLen ));
|
|
$namSiz++; $clsSiz++;
|
|
while( $self->RegEnumKeyEx(
|
|
$pos++, $subkey, $namSiz, [], $class, $clsSiz, $time ) ) {
|
|
push( @subkeys, $subkey );
|
|
push( @classes, $class );
|
|
push( @times, $time );
|
|
}
|
|
if( ! _NoMoreItems() ) {
|
|
return wantarray ? () : undef;
|
|
}
|
|
$self->{SUBKEYS}= \@subkeys;
|
|
$self->{SUBCLASSES}= \@classes;
|
|
$self->{SUBTIMES}= \@times;
|
|
1;
|
|
}
|
|
|
|
|
|
sub SubKeyNames
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \@names= \$key->SubKeyNames;";
|
|
$self->_enumSubKeys unless $self->{SUBKEYS};
|
|
return @{$self->{SUBKEYS}};
|
|
}
|
|
|
|
|
|
sub SubKeyClasses
|
|
{
|
|
my $self= shift(@_);
|
|
@_ and croak "Usage: \@classes= \$key->SubKeyClasses;";
|
|
$self->_enumSubKeys unless $self->{SUBCLASSES};
|
|
return @{$self->{SUBCLASSES}};
|
|
}
|
|
|
|
|
|
sub SubKeyTimes
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \@times= \$key->SubKeyTimes;";
|
|
$self->_enumSubKeys unless $self->{SUBTIMES};
|
|
return @{$self->{SUBTIMES}};
|
|
}
|
|
|
|
|
|
sub _MemberNames
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \$arrayRef= \$key->_MemberNames;";
|
|
if( ! $self->{MEMBERS} ) {
|
|
$self->_enumValues unless $self->{VALUES};
|
|
$self->_enumSubKeys unless $self->{SUBKEYS};
|
|
my( @members )= ( map( $_.$self->{DELIM}, @{$self->{SUBKEYS}} ),
|
|
map( $self->{DELIM}.$_, @{$self->{VALUES}} ) );
|
|
$self->{MEMBERS}= \@members;
|
|
}
|
|
return $self->{MEMBERS};
|
|
}
|
|
|
|
|
|
sub _MembersHash
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \$hashRef= \$key->_MembersHash;";
|
|
if( ! $self->{MEMBHASH} ) {
|
|
my $aRef= $self->_MemberNames;
|
|
$self->{MEMBHASH}= {};
|
|
@{$self->{MEMBHASH}}{@$aRef}= (1) x @$aRef;
|
|
}
|
|
return $self->{MEMBHASH};
|
|
}
|
|
|
|
|
|
sub MemberNames
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \@members= \$key->MemberNames;";
|
|
return @{$self->_MemberNames};
|
|
}
|
|
|
|
|
|
sub Information
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my( $time, $nkeys, $nvals, $xsec, $xkey, $xcls, $xname, $xdata )=
|
|
("",0,0,0,0,0,0,0);
|
|
my $clen= 8;
|
|
if( ! $self->RegQueryInfoKey( [], [], $nkeys, $xkey, $xcls,
|
|
$nvals, $xname, $xdata, $xsec, $time ) ) {
|
|
return wantarray ? () : undef;
|
|
}
|
|
if( defined($self->{Class}) ) {
|
|
$clen= length($self->{Class});
|
|
} else {
|
|
$self->{Class}= "";
|
|
}
|
|
while( ! $self->RegQueryInfoKey( $self->{Class}, $clen,
|
|
[],[],[],[],[],[],[],[],[])
|
|
&& _MoreData ) {
|
|
$clen *= 2;
|
|
}
|
|
my( %info );
|
|
@info{ qw( LastWrite CntSubKeys CntValues SecurityLen
|
|
MaxValDataLen MaxSubKeyLen MaxSubClassLen MaxValNameLen )
|
|
}= ( $time, $nkeys, $nvals, $xsec,
|
|
$xdata, $xkey, $xcls, $xname );
|
|
if( @_ ) {
|
|
my( %check );
|
|
@check{keys(%info)}= keys(%info);
|
|
my( @err )= grep( ! $check{$_}, @_ );
|
|
if( @err ) {
|
|
croak "${PACK}::Information- Invalid info requested (@err)";
|
|
}
|
|
return @info{@_};
|
|
} else {
|
|
return %info;
|
|
}
|
|
}
|
|
|
|
|
|
sub Delimiter
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
$self= $RegObj unless ref($self);
|
|
my( $oldDelim )= $self->{DELIM};
|
|
if( 1 == @_ && "" ne "$_[0]" ) {
|
|
delete $self->{MEMBERS};
|
|
delete $self->{MEMBHASH};
|
|
$self->{DELIM}= "$_[0]";
|
|
} elsif( 0 != @_ ) {
|
|
croak "Usage: \$oldDelim= \$key->Delimiter(\$newDelim);";
|
|
}
|
|
$oldDelim;
|
|
}
|
|
|
|
|
|
sub Handle
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \$handle= \$key->Handle;";
|
|
$self= $RegObj unless ref($self);
|
|
$self->{HANDLE};
|
|
}
|
|
|
|
|
|
sub Path
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \$path= \$key->Path;";
|
|
my $delim= $self->{DELIM};
|
|
$self= $RegObj unless ref($self);
|
|
if( "" eq $self->{MACHINE} ) {
|
|
$delim . join( $delim, @{$self->{PATH}} ) . $delim;
|
|
} else {
|
|
$delim x 2
|
|
. join( $delim, $self->{MACHINE}, @{$self->{PATH}} )
|
|
. $delim;
|
|
}
|
|
}
|
|
|
|
|
|
sub _Path
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \$arrRef= \$key->_Path;";
|
|
$self= $RegObj unless ref($self);
|
|
$self->{PATH};
|
|
}
|
|
|
|
|
|
sub Machine
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \$machine= \$key->Machine;";
|
|
$self= $RegObj unless ref($self);
|
|
$self->{MACHINE};
|
|
}
|
|
|
|
|
|
sub Access
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \$access= \$key->Access;";
|
|
$self= $RegObj unless ref($self);
|
|
$self->{ACCESS};
|
|
}
|
|
|
|
|
|
sub OS_Delimiter
|
|
{
|
|
my $self= shift(@_);
|
|
@_ and croak "Usage: \$backslash= \$key->OS_Delimiter;";
|
|
$self->{OS_DELIM};
|
|
}
|
|
|
|
|
|
sub _Roots
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if ref($self) && tied(%$self);
|
|
@_ and croak "Usage: \$varName= \$key->_Roots;";
|
|
$self= $RegObj unless ref($self);
|
|
$self->{ROOTS};
|
|
}
|
|
|
|
|
|
sub Roots
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if ref($self) && tied(%$self);
|
|
@_ and croak "Usage: \$hashRef= \$key->Roots;";
|
|
$self= $RegObj unless ref($self);
|
|
eval "\\%$self->{ROOTS}";
|
|
}
|
|
|
|
|
|
sub TIEHASH
|
|
{
|
|
my( $this )= shift(@_);
|
|
$this= tied(%$this) if ref($this) && tied(%$this);
|
|
my( $key )= @_;
|
|
if( 1 == @_ && ref($key) && "$key" =~ /=/ ) {
|
|
return $key; # $key is already an object (blessed reference).
|
|
}
|
|
return $this->new( @_ );
|
|
}
|
|
|
|
|
|
sub Tie
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my( $hRef )= @_;
|
|
if( 1 != @_ || ! ref($hRef) || "$hRef" !~ /(^|=)HASH\(/ ) {
|
|
croak "Usage: \$key->Tie(\\\%hash);";
|
|
}
|
|
tie %$hRef, ref($self), $self;
|
|
}
|
|
|
|
|
|
sub TiedRef
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $hRef= @_ ? shift(@_) : {};
|
|
return wantarray ? () : undef if ! defined($self);
|
|
$self->Tie($hRef);
|
|
bless $hRef, ref($self);
|
|
$hRef;
|
|
}
|
|
|
|
|
|
sub _Flags
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $oldFlags= $self->{FLAGS};
|
|
if( 1 == @_ ) {
|
|
$self->{FLAGS}= shift(@_);
|
|
} elsif( 0 != @_ ) {
|
|
croak "Usage: \$oldBits= \$key->_Flags(\$newBits);";
|
|
}
|
|
$oldFlags;
|
|
}
|
|
|
|
|
|
sub ArrayValues
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $oldFlag= $Flag_ArrVal == ( $Flag_ArrVal & $self->{FLAGS} );
|
|
if( 1 == @_ ) {
|
|
my $bool= shift(@_);
|
|
if( $bool ) {
|
|
$self->{FLAGS} |= $Flag_ArrVal;
|
|
} else {
|
|
$self->{FLAGS} &= ~( $Flag_ArrVal | $Flag_TieVal );
|
|
}
|
|
} elsif( 0 != @_ ) {
|
|
croak "Usage: \$oldBool= \$key->ArrayValues(\$newBool);";
|
|
}
|
|
$oldFlag;
|
|
}
|
|
|
|
|
|
sub TieValues
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $oldFlag= $Flag_TieVal == ( $Flag_TieVal & $self->{FLAGS} );
|
|
if( 1 == @_ ) {
|
|
my $bool= shift(@_);
|
|
if( $bool ) {
|
|
croak "${PACK}->TieValues cannot be enabled with this version";
|
|
$self->{FLAGS} |= $Flag_TieVal;
|
|
} else {
|
|
$self->{FLAGS} &= ~$Flag_TieVal;
|
|
}
|
|
} elsif( 0 != @_ ) {
|
|
croak "Usage: \$oldBool= \$key->TieValues(\$newBool);";
|
|
}
|
|
$oldFlag;
|
|
}
|
|
|
|
|
|
sub FastDelete
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $oldFlag= $Flag_FastDel == ( $Flag_FastDel & $self->{FLAGS} );
|
|
if( 1 == @_ ) {
|
|
my $bool= shift(@_);
|
|
if( $bool ) {
|
|
$self->{FLAGS} |= $Flag_FastDel;
|
|
} else {
|
|
$self->{FLAGS} &= ~$Flag_FastDel;
|
|
}
|
|
} elsif( 0 != @_ ) {
|
|
croak "Usage: \$oldBool= \$key->FastDelete(\$newBool);";
|
|
}
|
|
$oldFlag;
|
|
}
|
|
|
|
|
|
sub SplitMultis
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $oldFlag= $Flag_Split == ( $Flag_Split & $self->{FLAGS} );
|
|
if( 1 == @_ ) {
|
|
my $bool= shift(@_);
|
|
if( $bool ) {
|
|
$self->{FLAGS} |= $Flag_Split;
|
|
} else {
|
|
$self->{FLAGS} &= ~$Flag_Split;
|
|
}
|
|
} elsif( 0 != @_ ) {
|
|
croak "Usage: \$oldBool= \$key->SplitMultis(\$newBool);";
|
|
}
|
|
$oldFlag;
|
|
}
|
|
|
|
|
|
sub DWordsToHex
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $oldFlag= $Flag_HexDWord == ( $Flag_HexDWord & $self->{FLAGS} );
|
|
if( 1 == @_ ) {
|
|
my $bool= shift(@_);
|
|
if( $bool ) {
|
|
$self->{FLAGS} |= $Flag_HexDWord;
|
|
} else {
|
|
$self->{FLAGS} &= ~$Flag_HexDWord;
|
|
}
|
|
} elsif( 0 != @_ ) {
|
|
croak "Usage: \$oldBool= \$key->DWordsToHex(\$newBool);";
|
|
}
|
|
$oldFlag;
|
|
}
|
|
|
|
|
|
sub FixSzNulls
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $oldFlag= $Flag_FixNulls == ( $Flag_FixNulls & $self->{FLAGS} );
|
|
if( 1 == @_ ) {
|
|
my $bool= shift(@_);
|
|
if( $bool ) {
|
|
$self->{FLAGS} |= $Flag_FixNulls;
|
|
} else {
|
|
$self->{FLAGS} &= ~$Flag_FixNulls;
|
|
}
|
|
} elsif( 0 != @_ ) {
|
|
croak "Usage: \$oldBool= \$key->FixSzNulls(\$newBool);";
|
|
}
|
|
$oldFlag;
|
|
}
|
|
|
|
|
|
sub DualTypes
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $oldFlag= $Flag_DualTyp == ( $Flag_DualTyp & $self->{FLAGS} );
|
|
if( 1 == @_ ) {
|
|
my $bool= shift(@_);
|
|
if( $bool ) {
|
|
croak "${PACK}->DualTypes cannot be enabled since ",
|
|
"SetDualVar module not installed"
|
|
unless $_SetDualVar;
|
|
$self->{FLAGS} |= $Flag_DualTyp;
|
|
} else {
|
|
$self->{FLAGS} &= ~$Flag_DualTyp;
|
|
}
|
|
} elsif( 0 != @_ ) {
|
|
croak "Usage: \$oldBool= \$key->DualTypes(\$newBool);";
|
|
}
|
|
$oldFlag;
|
|
}
|
|
|
|
|
|
sub DualBinVals
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $oldFlag= $Flag_DualBin == ( $Flag_DualBin & $self->{FLAGS} );
|
|
if( 1 == @_ ) {
|
|
my $bool= shift(@_);
|
|
if( $bool ) {
|
|
croak "${PACK}->DualBinVals cannot be enabled since ",
|
|
"SetDualVar module not installed"
|
|
unless $_SetDualVar;
|
|
$self->{FLAGS} |= $Flag_DualBin;
|
|
} else {
|
|
$self->{FLAGS} &= ~$Flag_DualBin;
|
|
}
|
|
} elsif( 0 != @_ ) {
|
|
croak "Usage: \$oldBool= \$key->DualBinVals(\$newBool);";
|
|
}
|
|
$oldFlag;
|
|
}
|
|
|
|
|
|
sub GetOptions
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my( $opt, $meth, @old );
|
|
foreach $opt ( @_ ) {
|
|
$meth= $_opt_subs{$opt};
|
|
if( defined $meth ) {
|
|
if( $opt eq "AllowLoad" || $opt eq "AllowSave" ) {
|
|
croak "${PACK}->GetOptions: Getting current setting of $opt ",
|
|
"not supported in this release";
|
|
}
|
|
push( @old, $self->$meth() );
|
|
} else {
|
|
croak "${PACK}->GetOptions: Invalid option ($opt) ",
|
|
"not one of ( ", join(" ",grep !/^Allow/, @_opt_subs), " )";
|
|
}
|
|
}
|
|
return wantarray ? @old : $old[-1];
|
|
}
|
|
|
|
|
|
sub SetOptions
|
|
{
|
|
my $self= shift(@_);
|
|
# Don't get object if hash ref so "ref" returns original ref.
|
|
my( $opt, $meth, @old );
|
|
while( @_ ) {
|
|
$opt= shift(@_);
|
|
$meth= $_opt_subs{$opt};
|
|
if( ! @_ ) {
|
|
croak "${PACK}->SetOptions: Option value missing ",
|
|
"after option name ($opt)";
|
|
} elsif( defined $meth ) {
|
|
push( @old, $self->$meth( shift(@_) ) );
|
|
} elsif( $opt eq substr("reference",0,length($opt)) ) {
|
|
shift(@_) if @_;
|
|
push( @old, $self );
|
|
} else {
|
|
croak "${PACK}->SetOptions: Invalid option ($opt) ",
|
|
"not one of ( @_opt_subs )";
|
|
}
|
|
}
|
|
return wantarray ? @old : $old[-1];
|
|
}
|
|
|
|
|
|
sub _parseTiedEnt
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $ent= shift(@_);
|
|
my $delim= shift(@_);
|
|
my $dlen= length( $delim );
|
|
my $parent= @_ ? shift(@_) : 0;
|
|
my $off;
|
|
if( $delim x 2 eq substr($ent,0,2*$dlen) && "NONE" eq $self->Handle ) {
|
|
if( 0 <= ( $off= index( $ent, $delim x 2, 2*$dlen ) ) ) {
|
|
( substr( $ent, 0, $off ), substr( $ent, 2*$dlen+$off ) );
|
|
} elsif( $delim eq substr($ent,-$dlen) ) {
|
|
( substr($ent,0,-$dlen) );
|
|
} elsif( 2*$dlen <= ( $off= rindex( $ent, $delim ) ) ) {
|
|
( substr( $ent, 0, $off ), undef, substr( $ent, $dlen+$off ) );
|
|
} elsif( $parent ) {
|
|
();
|
|
} else {
|
|
( $ent );
|
|
}
|
|
} elsif( $delim eq substr($ent,0,$dlen) && "NONE" ne $self->Handle ) {
|
|
( undef, substr($ent,$dlen) );
|
|
} elsif( $self->{MEMBERS} && $self->_MembersHash->{$ent} ) {
|
|
( substr($ent,0,-$dlen) );
|
|
} elsif( 0 <= ( $off= index( $ent, $delim x 2 ) ) ) {
|
|
( substr( $ent, 0, $off ), substr( $ent, 2*$dlen+$off ) );
|
|
} elsif( $delim eq substr($ent,-$dlen) ) {
|
|
if( $parent
|
|
&& 0 <= ( $off= rindex( $ent, $delim, length($ent)-2*$dlen ) ) ) {
|
|
( substr($ent,0,$off), undef, undef,
|
|
substr($ent,$dlen+$off,-$dlen) );
|
|
} else {
|
|
( substr($ent,0,-$dlen) );
|
|
}
|
|
} elsif( 0 <= ( $off= rindex( $ent, $delim ) ) ) {
|
|
( substr( $ent, 0, $off ), undef, substr( $ent, $dlen+$off ) );
|
|
} else {
|
|
( undef, undef, $ent );
|
|
}
|
|
}
|
|
|
|
|
|
sub FETCH
|
|
{
|
|
my $self= shift(@_);
|
|
my $ent= shift(@_);
|
|
my $delim= $self->Delimiter;
|
|
my( $key, $val, $ambig )= $self->_parseTiedEnt( $ent, $delim, 0 );
|
|
my $sub;
|
|
if( defined($key) ) {
|
|
if( defined($self->{MEMBHASH})
|
|
&& $self->{MEMBHASH}->{$key.$delim}
|
|
&& 0 <= index($key,$delim) ) {
|
|
return wantarray ? () : undef
|
|
unless $sub= $self->new( $key,
|
|
{"Delimiter"=>$self->OS_Delimiter} );
|
|
$sub->Delimiter($delim);
|
|
} else {
|
|
return wantarray ? () : undef
|
|
unless $sub= $self->new( $key );
|
|
}
|
|
} else {
|
|
$sub= $self;
|
|
}
|
|
if( defined($val) ) {
|
|
return $self->ArrayValues ? [ $sub->GetValue( $val ) ]
|
|
: $sub->GetValue( $val );
|
|
} elsif( ! defined($ambig) ) {
|
|
return $sub->TiedRef;
|
|
} elsif( defined($key) ) {
|
|
return $sub->FETCH( $ambig );
|
|
} elsif( "" eq $ambig ) {
|
|
return $self->ArrayValues ? [ $sub->GetValue( $ambig ) ]
|
|
: $sub->GetValue( $ambig );
|
|
} else {
|
|
my $data= [ $sub->GetValue( $ambig ) ];
|
|
return $sub->ArrayValues ? $data : $$data[0]
|
|
if 0 != @$data;
|
|
$data= $sub->new( $ambig );
|
|
return defined($data) ? $data->TiedRef : wantarray ? () : undef;
|
|
}
|
|
}
|
|
|
|
|
|
sub _FetchOld
|
|
{
|
|
my( $self, $key )= @_;
|
|
my $old= $self->FETCH($key);
|
|
if( $old ) {
|
|
my $copy= {};
|
|
%$copy= %$old;
|
|
return $copy;
|
|
}
|
|
# return $^E;
|
|
return _Err;
|
|
}
|
|
|
|
|
|
sub DELETE
|
|
{
|
|
my $self= shift(@_);
|
|
my $ent= shift(@_);
|
|
my $delim= $self->Delimiter;
|
|
my( $key, $val, $ambig, $subkey )= $self->_parseTiedEnt( $ent, $delim, 1 );
|
|
my $sub;
|
|
my $fast= defined(wantarray) ? $self->FastDelete : 2;
|
|
my $old= 1; # Value returned if FastDelete is set.
|
|
if( defined($key)
|
|
&& ( defined($val) || defined($ambig) || defined($subkey) ) ) {
|
|
return wantarray ? () : undef
|
|
unless $sub= $self->new( $key );
|
|
} else {
|
|
$sub= $self;
|
|
}
|
|
if( defined($val) ) {
|
|
$old= $sub->GetValue($val) || _Err unless 2 <= $fast;
|
|
$sub->RegDeleteValue( $val );
|
|
} elsif( defined($subkey) ) {
|
|
$old= $sub->_FetchOld( $subkey.$delim ) unless $fast;
|
|
$sub->RegDeleteKey( $subkey );
|
|
} elsif( defined($ambig) ) {
|
|
if( defined($key) ) {
|
|
$old= $sub->DELETE($ambig);
|
|
} else {
|
|
$old= $sub->GetValue($ambig) || _Err unless 2 <= $fast;
|
|
if( defined( $old ) ) {
|
|
$sub->RegDeleteValue( $ambig );
|
|
} else {
|
|
$old= $sub->_FetchOld( $ambig.$delim ) unless $fast;
|
|
$sub->RegDeleteKey( $ambig );
|
|
}
|
|
}
|
|
} elsif( defined($key) ) {
|
|
$old= $sub->_FetchOld( $key.$delim ) unless $fast;
|
|
$sub->RegDeleteKey( $key );
|
|
} else {
|
|
croak "${PACK}->DELETE: Key ($ent) can never be deleted";
|
|
}
|
|
$old;
|
|
}
|
|
|
|
|
|
sub SetValue
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
my $name= shift(@_);
|
|
my $data= shift(@_);
|
|
my( $type )= @_;
|
|
my $size;
|
|
if( ! defined($type) ) {
|
|
if( "ARRAY" eq ref($data) ) {
|
|
croak "${PACK}->SetValue: Value is array reference but ",
|
|
"no data type given"
|
|
unless 2 == @$data;
|
|
( $data, $type )= @$data;
|
|
} else {
|
|
$type= REG_SZ;
|
|
}
|
|
}
|
|
$type= Win32API::Registry::constant($type,0) if $type =~ /^REG_/;
|
|
if( REG_MULTI_SZ == $type && "ARRAY" eq ref($data) ) {
|
|
$data= join( "\0", @$data ) . "\0\0";
|
|
## $data= pack( "a*" x (1+@$data), map( $_."\0", @$data, "" ) );
|
|
} elsif( ( REG_SZ == $type || REG_EXPAND_SZ == $type )
|
|
&& $self->FixSzNulls ) {
|
|
$data .= "\0" unless "\0" eq substr($data,0,-1);
|
|
} elsif( REG_DWORD == $type && $data =~ /^0x[0-9a-fA-F]{3,}$/ ) {
|
|
$data= pack( "L", hex($data) );
|
|
# We could to $data=pack("L",$data) for REG_DWORD but I see
|
|
# no nice way to always destinguish when to do this or not.
|
|
}
|
|
$self->RegSetValueEx( $name, 0, $type, $data, length($data) );
|
|
}
|
|
|
|
|
|
sub StoreKey
|
|
{
|
|
my $this= shift(@_);
|
|
$this= tied(%$this) if ref($this) && tied(%$this);
|
|
my $subKey= shift(@_);
|
|
my $data= shift(@_);
|
|
my $ent;
|
|
my $self;
|
|
if( ! ref($data) || "$data" !~ /(^|=)HASH/ ) {
|
|
croak "${PACK}->StoreKey: For ", $this->Path.$subKey, ",\n",
|
|
" subkey data must be a HASH reference";
|
|
}
|
|
if( defined( $$data{""} ) && "HASH" eq ref($$data{""}) ) {
|
|
$self= $this->CreateKey( $subKey, delete $$data{""} );
|
|
} else {
|
|
$self= $this->CreateKey( $subKey );
|
|
}
|
|
return wantarray ? () : undef if ! defined($self);
|
|
foreach $ent ( keys(%$data) ) {
|
|
return wantarray ? () : undef
|
|
unless $self->STORE( $ent, $$data{$ent} );
|
|
}
|
|
$self;
|
|
}
|
|
|
|
|
|
# = { "" => {OPT=>VAL}, "val"=>[], "key"=>{} } creates a new key
|
|
# = "string" creates a new REG_SZ value
|
|
# = [ data, type ] creates a new value
|
|
sub STORE
|
|
{
|
|
my $self= shift(@_);
|
|
my $ent= shift(@_);
|
|
my $data= shift(@_);
|
|
my $delim= $self->Delimiter;
|
|
my( $key, $val, $ambig, $subkey )= $self->_parseTiedEnt( $ent, $delim, 1 );
|
|
my $sub;
|
|
if( defined($key)
|
|
&& ( defined($val) || defined($ambig) || defined($subkey) ) ) {
|
|
return wantarray ? () : undef
|
|
unless $sub= $self->new( $key );
|
|
} else {
|
|
$sub= $self;
|
|
}
|
|
if( defined($val) ) {
|
|
croak "${PACK}->STORE: For ", $sub->Path.$delim.$val, ",\n",
|
|
" value data cannot be a HASH reference"
|
|
if ref($data) && "$data" =~ /(^|=)HASH/;
|
|
$sub->SetValue( $val, $data );
|
|
} elsif( defined($subkey) ) {
|
|
croak "${PACK}->STORE: For ", $sub->Path.$subkey.$delim, ",\n",
|
|
" subkey data must be a HASH reference"
|
|
unless ref($data) && "$data" =~ /(^|=)HASH/;
|
|
$sub->StoreKey( $subkey, $data );
|
|
} elsif( defined($ambig) ) {
|
|
if( ref($data) && "$data" =~ /(^|=)HASH/ ) {
|
|
$sub->StoreKey( $ambig, $data );
|
|
} else {
|
|
$sub->SetValue( $ambig, $data );
|
|
}
|
|
} elsif( defined($key) ) {
|
|
croak "${PACK}->STORE: For ", $sub->Path.$key.$delim, ",\n",
|
|
" subkey data must be a HASH reference"
|
|
unless ref($data) && "$data" =~ /(^|=)HASH/;
|
|
$sub->StoreKey( $key, $data );
|
|
} else {
|
|
croak "${PACK}->STORE: Key ($ent) can never be created nor set";
|
|
}
|
|
}
|
|
|
|
|
|
sub EXISTS
|
|
{
|
|
my $self= shift(@_);
|
|
my $ent= shift(@_);
|
|
defined( $self->FETCH($ent) );
|
|
}
|
|
|
|
|
|
sub FIRSTKEY
|
|
{
|
|
my $self= shift(@_);
|
|
my $members= $self->_MemberNames;
|
|
$self->{PREVIDX}= 0;
|
|
@{$members} ? $members->[0] : undef;
|
|
}
|
|
|
|
|
|
sub NEXTKEY
|
|
{
|
|
my $self= shift(@_);
|
|
my $prev= shift(@_);
|
|
my $idx= $self->{PREVIDX};
|
|
my $members= $self->_MemberNames;
|
|
if( ! defined($idx) || $prev ne $members->[$idx] ) {
|
|
$idx= 0;
|
|
while( $idx < @$members && $prev ne $members->[$idx] ) {
|
|
$idx++;
|
|
}
|
|
}
|
|
$self->{PREVIDX}= ++$idx;
|
|
$members->[$idx];
|
|
}
|
|
|
|
|
|
sub DESTROY
|
|
{
|
|
my $self= shift(@_);
|
|
return if tied(%$self);
|
|
my $unload= $self->{UNLOADME};
|
|
my $debug= $ENV{DEBUG_TIE_REGISTRY};
|
|
if( defined($debug) ) {
|
|
if( 1 < $debug ) {
|
|
my $hand= $self->Handle;
|
|
my $dep= $self->{DEPENDON};
|
|
carp "${PACK} destroying ", $self->Path, " (",
|
|
"NONE" eq $hand ? $hand : sprintf("0x%lX",$hand), ")",
|
|
defined($dep) ? (" [depends on ",$dep->Path,"]") : ();
|
|
} else {
|
|
warn "${PACK} destroying ", $self->Path, ".\n";
|
|
}
|
|
}
|
|
$self->RegCloseKey
|
|
unless "NONE" eq $self->Handle;
|
|
if( defined($unload) ) {
|
|
if( defined($debug) && 1 < $debug ) {
|
|
my( $obj, $subKey, $file )= @$unload;
|
|
warn "Unloading ", $self->Path,
|
|
" (from ", $obj->Path, ", $subKey)...\n";
|
|
}
|
|
$self->UnLoad
|
|
|| warn "Couldn't unload ", $self->Path, ": ", _ErrMsg, "\n";
|
|
## carp "Never unloaded ${PACK}::Load($$unload[2])";
|
|
}
|
|
#delete $self->{DEPENDON};
|
|
}
|
|
|
|
|
|
use vars qw( @CreateKey_Opts %CreateKey_Opts );
|
|
@CreateKey_Opts= qw( Access Class Options Delimiter
|
|
Disposition Security Volatile Backup );
|
|
@CreateKey_Opts{@CreateKey_Opts}= (1) x @CreateKey_Opts;
|
|
|
|
sub CreateKey
|
|
{
|
|
my $self= shift(@_);
|
|
my $tied= tied(%$self);
|
|
$self= tied(%$self) if $tied;
|
|
my( $subKey, $opts )= @_;
|
|
my( $sam )= $self->Access;
|
|
my( $delim )= $self->Delimiter;
|
|
my( $class )= "";
|
|
my( $flags )= 0;
|
|
my( $secure )= [];
|
|
my( $garb )= 0;
|
|
my( $result )= \$garb;
|
|
my( $handle )= 0;
|
|
if( @_ < 1 || 2 < @_
|
|
|| 2 == @_ && "HASH" ne ref($opts) ) {
|
|
croak "Usage: \$new= \$old->CreateKey( \$subKey, {OPT=>VAL,...} );\n",
|
|
" options: @CreateKey_Opts\nCalled";
|
|
}
|
|
if( defined($opts) ) {
|
|
$sam= $opts->{"Access"} if defined($opts->{"Access"});
|
|
$class= $opts->{Class} if defined($opts->{Class});
|
|
$flags= $opts->{Options} if defined($opts->{Options});
|
|
$delim= $opts->{"Delimiter"} if defined($opts->{"Delimiter"});
|
|
$secure= $opts->{Security} if defined($opts->{Security});
|
|
if( defined($opts->{Disposition}) ) {
|
|
"SCALAR" eq ref($opts->{Disposition})
|
|
or croak "${PACK}->CreateKey option `Disposition'",
|
|
" must provide a scalar reference";
|
|
$result= $opts->{Disposition};
|
|
}
|
|
$result= ${$opts->{Disposition}} if defined($opts->{Disposition});
|
|
if( 0 == $flags ) {
|
|
$flags |= REG_OPTION_VOLATILE
|
|
if defined($opts->{Volatile}) && $opts->{Volatile};
|
|
$flags |= REG_OPTION_BACKUP_RESTORE
|
|
if defined($opts->{Backup}) && $opts->{Backup};
|
|
}
|
|
}
|
|
my $subPath= ref($subKey) ? $subKey : $self->_split($subKey,$delim);
|
|
$subKey= join( $self->OS_Delimiter, @$subPath );
|
|
$self->RegCreateKeyEx( $subKey, 0, $class, $flags, $sam,
|
|
$secure, $handle, $$result )
|
|
or return wantarray ? () : undef;
|
|
my $new= $self->_new( $handle, [ @{$self->_Path}, @{$subPath} ] );
|
|
$new->{ACCESS}= $sam;
|
|
$new->{DELIM}= $delim;
|
|
$new= $new->TiedRef if $tied;
|
|
return $new;
|
|
}
|
|
|
|
|
|
use vars qw( $Load_Cnt @Load_Opts %Load_Opts );
|
|
$Load_Cnt= 0;
|
|
@Load_Opts= qw(NewSubKey);
|
|
@Load_Opts{@Load_Opts}= (1) x @Load_Opts;
|
|
|
|
sub Load
|
|
{
|
|
my $this= shift(@_);
|
|
my $tied= ref($this) && tied(%$this);
|
|
$this= tied(%$this) if $tied;
|
|
my( $file, $subKey, $opts )= @_;
|
|
if( 2 == @_ && "HASH" eq ref($subKey) ) {
|
|
$opts= $subKey;
|
|
undef $subKey;
|
|
}
|
|
@_ < 1 || 3 < @_ || defined($opts) && "HASH" ne ref($opts)
|
|
and croak "Usage: \$key= ",
|
|
"${PACK}->Load( \$fileName, [\$newSubKey,] {OPT=>VAL...} );\n",
|
|
" options: @Load_Opts @new_Opts\nCalled";
|
|
if( defined($opts) && exists($opts->{NewSubKey}) ) {
|
|
$subKey= delete $opts->{NewSubKey};
|
|
}
|
|
if( ! defined( $subKey ) ) {
|
|
if( "" ne $this->Machine ) {
|
|
( $this )= $this->_connect( [$this->Machine,"LMachine"] );
|
|
} else {
|
|
( $this )= $this->_rootKey( "LMachine" ); # Could also be "Users"
|
|
}
|
|
$subKey= "PerlTie:$$." . ++$Load_Cnt;
|
|
}
|
|
$this->RegLoadKey( $subKey, $file )
|
|
or return wantarray ? () : undef;
|
|
my $self= $this->new( $subKey, defined($opts) ? $opts : () );
|
|
if( ! defined( $self ) ) {
|
|
{ my $err= Win32::GetLastError();
|
|
#{ local( $^E );
|
|
$this->RegUnLoadKey( $subKey )
|
|
or carp "Can't unload $subKey from ", $this->Path, ": $^E\n";
|
|
Win32::SetLastError($err);
|
|
}
|
|
return wantarray ? () : undef;
|
|
}
|
|
$self->{UNLOADME}= [ $this, $subKey, $file ];
|
|
$self= $self->TiedRef if $tied;
|
|
$self;
|
|
}
|
|
|
|
|
|
sub UnLoad
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
@_ and croak "Usage: \$key->UnLoad;";
|
|
my $unload= $self->{UNLOADME};
|
|
"ARRAY" eq ref($unload)
|
|
or croak "${PACK}->UnLoad called on a key which was not Load()ed";
|
|
my( $obj, $subKey, $file )= @$unload;
|
|
$self->RegCloseKey;
|
|
Win32API::Registry::RegUnLoadKey( $obj->Handle, $subKey );
|
|
}
|
|
|
|
|
|
sub AllowSave
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
$self->AllowPriv( "SeBackupPrivilege", @_ );
|
|
}
|
|
|
|
|
|
sub AllowLoad
|
|
{
|
|
my $self= shift(@_);
|
|
$self= tied(%$self) if tied(%$self);
|
|
$self->AllowPriv( "SeRestorePrivilege", @_ );
|
|
}
|
|
|
|
|
|
# RegNotifyChangeKeyValue( hKey, bWatchSubtree, iNotifyFilter, hEvent, bAsync )
|
|
|
|
|
|
sub RegCloseKey { my $self= shift(@_);
|
|
Win32API::Registry::RegCloseKey $self->Handle, @_; }
|
|
sub RegConnectRegistry { my $self= shift(@_);
|
|
Win32API::Registry::RegConnectRegistry @_; }
|
|
sub RegCreateKey { my $self= shift(@_);
|
|
Win32API::Registry::RegCreateKey $self->Handle, @_; }
|
|
sub RegCreateKeyEx { my $self= shift(@_);
|
|
Win32API::Registry::RegCreateKeyEx $self->Handle, @_; }
|
|
sub RegDeleteKey { my $self= shift(@_);
|
|
Win32API::Registry::RegDeleteKey $self->Handle, @_; }
|
|
sub RegDeleteValue { my $self= shift(@_);
|
|
Win32API::Registry::RegDeleteValue $self->Handle, @_; }
|
|
sub RegEnumKey { my $self= shift(@_);
|
|
Win32API::Registry::RegEnumKey $self->Handle, @_; }
|
|
sub RegEnumKeyEx { my $self= shift(@_);
|
|
Win32API::Registry::RegEnumKeyEx $self->Handle, @_; }
|
|
sub RegEnumValue { my $self= shift(@_);
|
|
Win32API::Registry::RegEnumValue $self->Handle, @_; }
|
|
sub RegFlushKey { my $self= shift(@_);
|
|
Win32API::Registry::RegFlushKey $self->Handle, @_; }
|
|
sub RegGetKeySecurity { my $self= shift(@_);
|
|
Win32API::Registry::RegGetKeySecurity $self->Handle, @_; }
|
|
sub RegLoadKey { my $self= shift(@_);
|
|
Win32API::Registry::RegLoadKey $self->Handle, @_; }
|
|
sub RegNotifyChangeKeyValue { my $self= shift(@_);
|
|
Win32API::Registry::RegNotifyChangeKeyValue $self->Handle, @_; }
|
|
sub RegOpenKey { my $self= shift(@_);
|
|
Win32API::Registry::RegOpenKey $self->Handle, @_; }
|
|
sub RegOpenKeyEx { my $self= shift(@_);
|
|
Win32API::Registry::RegOpenKeyEx $self->Handle, @_; }
|
|
sub RegQueryInfoKey { my $self= shift(@_);
|
|
Win32API::Registry::RegQueryInfoKey $self->Handle, @_; }
|
|
sub RegQueryMultipleValues { my $self= shift(@_);
|
|
Win32API::Registry::RegQueryMultipleValues $self->Handle, @_; }
|
|
sub RegQueryValue { my $self= shift(@_);
|
|
Win32API::Registry::RegQueryValue $self->Handle, @_; }
|
|
sub RegQueryValueEx { my $self= shift(@_);
|
|
Win32API::Registry::RegQueryValueEx $self->Handle, @_; }
|
|
sub RegReplaceKey { my $self= shift(@_);
|
|
Win32API::Registry::RegReplaceKey $self->Handle, @_; }
|
|
sub RegRestoreKey { my $self= shift(@_);
|
|
Win32API::Registry::RegRestoreKey $self->Handle, @_; }
|
|
sub RegSaveKey { my $self= shift(@_);
|
|
Win32API::Registry::RegSaveKey $self->Handle, @_; }
|
|
sub RegSetKeySecurity { my $self= shift(@_);
|
|
Win32API::Registry::RegSetKeySecurity $self->Handle, @_; }
|
|
sub RegSetValue { my $self= shift(@_);
|
|
Win32API::Registry::RegSetValue $self->Handle, @_; }
|
|
sub RegSetValueEx { my $self= shift(@_);
|
|
Win32API::Registry::RegSetValueEx $self->Handle, @_; }
|
|
sub RegUnLoadKey { my $self= shift(@_);
|
|
Win32API::Registry::RegUnLoadKey $self->Handle, @_; }
|
|
sub AllowPriv { my $self= shift(@_);
|
|
Win32API::Registry::AllowPriv @_; }
|
|
|
|
|
|
# Autoload methods go after =cut, and are processed by the autosplit program.
|
|
|
|
1;
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Win32::TieRegistry - Powerful and easy ways to manipulate a registry
|
|
[on Win32 for now].
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Win32::TieRegistry 0.20 ( UseOptionName=>UseOptionValue[,...] );
|
|
|
|
$Registry->SomeMethodCall(arg1,...);
|
|
|
|
$subKey= $Registry->{"Key\\SubKey\\"};
|
|
$valueData= $Registry->{"Key\\SubKey\\\\ValueName"};
|
|
$Registry->{"Key\\SubKey\\"}= { "NewSubKey" => {...} };
|
|
$Registry->{"Key\\SubKey\\\\ValueName"}= "NewValueData";
|
|
$Registry->{"\\ValueName"}= [ pack("fmt",$data), REG_DATATYPE ];
|
|
|
|
=head1 EXAMPLES
|
|
|
|
use Win32::TieRegistry( Delimiter=>"#", ArrayValues=>0 );
|
|
$pound= $Registry->Delimiter("/");
|
|
$diskKey= $Registry->{"LMachine/System/Disk/"}
|
|
or die "Can't read LMachine/System/Disk key: $^E\n";
|
|
$data= $key->{"/Information"}
|
|
or die "Can't read LMachine/System/Disk//Information value: $^E\n";
|
|
$remoteKey= $Registry->{"//ServerA/LMachine/System/"}
|
|
or die "Can't read //ServerA/LMachine/System/ key: $^E\n";
|
|
$remoteData= $remoteKey->{"Disk//Information"}
|
|
or die "Can't read ServerA's System/Disk//Information value: $^E\n";
|
|
foreach $entry ( keys(%$diskKey) ) {
|
|
...
|
|
}
|
|
foreach $subKey ( $diskKey->SubKeyNames ) {
|
|
...
|
|
}
|
|
$diskKey->AllowSave( 1 );
|
|
$diskKey->RegSaveKey( "C:/TEMP/DiskReg", [] );
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The I<Win32::TieRegistry> module lets you manipulate the Registry
|
|
via objects [as in "object oriented"] or via tied hashes. But
|
|
you will probably mostly use a combination reference, that is, a
|
|
reference to a tied hash that has also been made an object so that
|
|
you can mix both access methods [as shown above].
|
|
|
|
If you did not get this module as part of libwin32, you might
|
|
want to get a recent version of libwin32 from CPAN which should
|
|
include this module and the C<Win32API::Registry> module that it
|
|
uses.
|
|
|
|
Skip to the L<SUMMARY> section if you just want to dive in and start
|
|
using the Registry from Perl.
|
|
|
|
Accessing and manipulating the registry is extremely simple using
|
|
I<Win32::TieRegistry>. A single, simple expression can return
|
|
you almost any bit of information stored in the Registry.
|
|
I<Win32::TieRegistry> also gives you full access to the "raw"
|
|
underlying API calls so that you can do anything with the Registry
|
|
in Perl that you could do in C. But the "simple" interface has
|
|
been carefully designed to handle almost all operations itself
|
|
without imposing arbitrary limits while providing sensible
|
|
defaults so you can list only the parameters you care about.
|
|
|
|
But first, an overview of the Registry itself.
|
|
|
|
=head2 The Registry
|
|
|
|
The Registry is a forest: a collection of several tree structures.
|
|
The root of each tree is a key. These root keys are identified by
|
|
predefined constants whose names start with "HKEY_". Although all
|
|
keys have a few attributes associated with each [a class, a time
|
|
stamp, and security information], the most important aspect of keys
|
|
is that each can contain subkeys and can contain values.
|
|
|
|
Each subkey has a name: a string which cannot be blank and cannot
|
|
contain the delimiter character [backslash: C<'\\'>] nor nul
|
|
[C<'\0'>]. Each subkey is also a key and so can contain subkeys
|
|
and values [and has a class, time stamp, and security information].
|
|
|
|
Each value has a name: a string which E<can> be blank and E<can>
|
|
contain the delimiter character [backslash: C<'\\'>] and any
|
|
character except for null, C<'\0'>. Each value also has data
|
|
associated with it. Each value's data is a contiguous chunk of
|
|
bytes, which is exactly what a Perl string value is so Perl
|
|
strings will usually be used to represent value data.
|
|
|
|
Each value also has a data type which says how to interpret the
|
|
value data. The primary data types are:
|
|
|
|
=over
|
|
|
|
=item REG_SZ
|
|
|
|
A null-terminated string.
|
|
|
|
=item REG_EXPAND_SZ
|
|
|
|
A null-terminated string which contains substrings consisting of a
|
|
percent sign [C<'%'>], an environment variable name, then a percent
|
|
sign, that should be replaced with the value associate with that
|
|
environment variable. The system does I<not> automatically do this
|
|
substitution.
|
|
|
|
=item REG_BINARY
|
|
|
|
Some arbitrary binary value. You can think of these as being
|
|
"packed" into a string.
|
|
|
|
If your system has the L<SetDualVar> module installed,
|
|
the C<DualBinVals()> option wasn't turned off, and you
|
|
fetch a C<REG_BINARY> value of 4 bytes or fewer, then
|
|
you can use the returned value in a numeric context to
|
|
get at the "unpacked" numeric value. See C<GetValue()>
|
|
for more information.
|
|
|
|
=item REG_MULTI_SZ
|
|
|
|
Several null-terminated strings concatenated together with an
|
|
extra trailing C<'\0'> at the end of the list. Note that the list
|
|
can include empty strings so use the value's length to determine
|
|
the end of the list, not the first occurrence of C<'\0\0'>.
|
|
It is best to set the C<SplitMultis()> option so I<Win32::TieRegistry>
|
|
will split these values into an array of strings for you.
|
|
|
|
=item REG_DWORD
|
|
|
|
A long [4-byte] integer value. These values are expected either
|
|
packed into a 4-character string or as a hex string of E<more than>
|
|
4 characters [but I<not> as a numeric value, unfortunately, as there is
|
|
no sure way to tell a numeric value from a packed 4-byte string that
|
|
just happens to be a string containing a valid numeric value].
|
|
|
|
How such values are returned depends on the C<DualBinVals()> and
|
|
C<DWordsToHex()> options. See C<GetValue()> for details.
|
|
|
|
=back
|
|
|
|
In the underlying Registry calls, most places which take a
|
|
subkey name also allow you to pass in a subkey "path" -- a
|
|
string of several subkey names separated by the delimiter
|
|
character, backslash [C<'\\'>]. For example, doing
|
|
C<RegOpenKeyEx(HKEY_LOCAL_MACHINE,"SYSTEM\\DISK",...)>
|
|
is much like opening the C<"SYSTEM"> subkey of C<HKEY_LOCAL_MACHINE>,
|
|
then opening its "DISK" subkey, then closing the C<"SYSTEM"> subkey.
|
|
|
|
All of the I<Win32::TieRegistry> features allow you to use your
|
|
own delimiter in place of the system's delimiter, [C<'\\'>]. In
|
|
most of our examples we will use a forward slash [C<'/'>] as our
|
|
delimiter as it is easier to read and less error prone to use when
|
|
writing Perl code since you have to type two backslashes for each
|
|
backslash you want in a string. Note that this is true even when
|
|
using single quotes -- C<'\\HostName\LMachine\'> is an invalid
|
|
string and must be written as C<'\\\\HostName\\LMachine\\'>.
|
|
|
|
You can also connect to the registry of other computers on your
|
|
network. This will be discussed more later.
|
|
|
|
Although the Registry does not have a single root key, the
|
|
I<Win32::TieRegistry> module creates a virtual root key for you
|
|
which has all of the I<HKEY_*> keys as subkeys.
|
|
|
|
=head2 Tied Hashes Documentation
|
|
|
|
Before you can use a tied hash, you must create one. One way to
|
|
do that is via:
|
|
|
|
use Win32::TieRegistry ( TiedHash => '%RegHash' );
|
|
|
|
which exports a C<%RegHash> variable into your package and ties it
|
|
to the virtual root key of the Registry. An alternate method is:
|
|
|
|
my %RegHash;
|
|
use Win32::TieRegistry ( TiedHash => \%RegHash );
|
|
|
|
There are also several ways you can tie a hash variable to any
|
|
other key of the Registry, which are discussed later.
|
|
|
|
Note that you will most likely use C<$Registry> instead of using
|
|
a tied hash. C<$Registry> is a reference to a hash that has
|
|
been tied to the virtual root of your computer's Registry [as if,
|
|
C<$Registry= \%RegHash>]. So you would use C<$Registry-E<gt>{Key}>
|
|
rather than C<$RegHash{Key}> and use C<keys %{$Registry}> rather
|
|
than C<keys %RegHash>, for example.
|
|
|
|
For each hash which has been tied to a Registry key, the Perl
|
|
C<keys> function will return a list containing the name of each
|
|
of the key's subkeys with a delimiter character appended to it and
|
|
containing the name of each of the key's values with a delimiter
|
|
prepended to it. For example:
|
|
|
|
keys( %{ $Registry->{"HKEY_CLASSES_ROOT\\batfile\\"} } )
|
|
|
|
might yield the following list value:
|
|
|
|
( "DefaultIcon\\", # The subkey named "DefaultIcon"
|
|
"shell\\", # The subkey named "shell"
|
|
"shellex\\", # The subkey named "shellex"
|
|
"\\", # The default value [named ""]
|
|
"\\EditFlags" ) # The value named "EditFlags"
|
|
|
|
For the virtual root key, short-hand subkey names are used as
|
|
shown below. You can use the short-hand name, the regular
|
|
I<HKEY_*> name, or any numeric value to access these keys, but
|
|
the short-hand names are all that will be returned by the C<keys>
|
|
function.
|
|
|
|
=over
|
|
|
|
=item "Classes" for HKEY_CLASSES_ROOT
|
|
|
|
Contains mappings between file name extensions and the uses
|
|
for such files along with configuration information for COM
|
|
[MicroSoft's Common Object Model] objects. Usually a link to
|
|
the C<"SOFTWARE\\Classes"> subkey of the C<HKEY_LOCAL_MACHINE>
|
|
key.
|
|
|
|
=item "CUser" for HKEY_CURRENT_USER
|
|
|
|
Contains information specific to the currently logged-in user.
|
|
Mostly software configuration information. Usually a link to
|
|
a subkey of the C<HKEY_USERS> key.
|
|
|
|
=item "LMachine" for HKEY_LOCAL_MACHINE
|
|
|
|
Contains all manner of information about the computer.
|
|
|
|
=item "Users" for HKEY_USERS
|
|
|
|
Contains one subkey, C<".DEFAULT">, which gets copied to a new
|
|
subkey whenever a new user is added. Also contains a subkey for
|
|
each user of the system, though only those for active users
|
|
[usually only one] are loaded at any given time.
|
|
|
|
=item "PerfData" for HKEY_PERFORMANCE_DATA
|
|
|
|
Used to access data about system performance. Access via this key
|
|
is "special" and all but the most carefully constructed calls will
|
|
fail, usually with C<ERROR_INSUFFICIENT_BUFFER>. For example, you
|
|
can't enumerate key names without also enumerating values which
|
|
require huge buffers but the exact buffer size required cannot be
|
|
determined beforehand because C<RegQueryInfoKey()> E<always> fails
|
|
with C<ERROR_INSUFFICIENT_BUFFER> for C<HKEY_PERFORMANCE_DATA> no
|
|
matter how it is called. So it is currently not very useful to
|
|
tie a hash to this key. You can use it to create an object to use
|
|
for making carefully constructed calls to the underlying Reg*()
|
|
routines.
|
|
|
|
=item "CConfig" for HKEY_CURRENT_CONFIG
|
|
|
|
Contains minimal information about the computer's current
|
|
configuration that is required very early in the boot process.
|
|
For example, setting for the display adapter such as screen
|
|
resolution and refresh rate are found in here.
|
|
|
|
=item "DynData" for HKEY_DYN_DATA
|
|
|
|
Dynamic data. We have found no documentation for this key.
|
|
|
|
=back
|
|
|
|
A tied hash is much like a regular hash variable in Perl -- you give
|
|
it a key string inside braces, [C<{> and C<}>], and it gives you
|
|
back a value [or lets you set a value]. For I<Win32::TieRegistry>
|
|
hashes, there are two types of values that will be returned.
|
|
|
|
=over
|
|
|
|
=item SubKeys
|
|
|
|
If you give it a string which represents a subkey, then it will
|
|
give you back a reference to a hash which has been tied to that
|
|
subkey. It can't return the hash itself, so it returns a
|
|
reference to it. It also blesses that reference so that it is
|
|
also an object so you can use it to call method functions.
|
|
|
|
=item Values
|
|
|
|
If you give it a string which is a value name, then it will give
|
|
you back a string which is the data for that value. Alternately,
|
|
you can request that it give you both the data value string and
|
|
the data value type [we discuss how to request this later]. In
|
|
this case, it would return a reference to an array where the value
|
|
data string is element C<[0]> and the value data type is element
|
|
C<[1]>.
|
|
|
|
=back
|
|
|
|
The key string which you use in the tied hash must be interpreted
|
|
to determine whether it is a value name or a key name or a path
|
|
that combines several of these or even other things. There are
|
|
two simple rules that make this interpretation easy and
|
|
unambiguous:
|
|
|
|
Put a delimiter after each key name.
|
|
Put a delimiter in front of each value name.
|
|
|
|
Exactly how the key string will be intepreted is governed by the
|
|
following cases, in the order listed. These cases are designed
|
|
to "do what you mean". Most of the time you won't have to think
|
|
about them, especially if you follow the two simple rules above.
|
|
After the list of cases we give several examples which should be
|
|
clear enough so feel free to skip to them unless you are worried
|
|
about the details.
|
|
|
|
=over
|
|
|
|
=item Remote machines
|
|
|
|
If the hash is tied to the virtual root of the registry [or the
|
|
virtual root of a remote machine's registry], then we treat hash
|
|
key strings which start with the delimiter character specially.
|
|
|
|
If the hash key string starts with two delimiters in a row, then
|
|
those should be immediately followed by the name of a remote
|
|
machine whose registry we wish to connect to. That can be
|
|
followed by a delimiter and more subkey names, etc. If the
|
|
machine name is not following by anything, then a virtual root
|
|
for the remote machine's registry is created, a hash is tied to
|
|
it, and a reference to that hash it is returned.
|
|
|
|
=item Hash key string starts with the delimiter
|
|
|
|
If the hash is tied to a virtual root key, then the leading
|
|
delimiter is ignored. It should be followed by a valid Registry
|
|
root key name [either a short-hand name like C<"LMachine">, an
|
|
I<HKEY_*> value, or a numeric value]. This alternate notation is
|
|
allowed in order to be more consistant with the C<Open()> method
|
|
function.
|
|
|
|
For all other Registry keys, the leading delimiter indicates
|
|
that the rest of the string is a value name. The leading
|
|
delimiter is stripped and the rest of the string [which can
|
|
be empty and can contain more delimiters] is used as a value
|
|
name with no further parsing.
|
|
|
|
=item Exact match with direct subkey name followed by delimiter
|
|
|
|
If you have already called the Perl C<keys> function on the tied
|
|
hash [or have already called C<MemberNames> on the object] and the
|
|
hash key string exactly matches one of the strings returned, then
|
|
no further parsing is done. In other words, if the key string
|
|
exactly matches the name of a direct subkey with a delimiter
|
|
appended, then a reference to a hash tied to that subkey is
|
|
returned [but only if C<keys> or C<MemberNames> has already
|
|
been called for that tied hash].
|
|
|
|
This is only important if you have selected a delimiter other than
|
|
the system default delimiter and one of the subkey names contains
|
|
the delimiter you have chosen. This rule allows you to deal with
|
|
subkeys which contain your chosen delimiter in their name as long
|
|
as you only traverse subkeys one level at a time and always
|
|
enumerate the list of members before doing so.
|
|
|
|
The main advantage of this is that Perl code which recursively
|
|
traverses a hash will work on hashes tied to Registry keys even if
|
|
a non-default delimiter has been selected.
|
|
|
|
=item Hash key string contains two delimiters in a row
|
|
|
|
If the hash key string contains two [or more] delimiters in a row,
|
|
then the string is split between the first pair of delimiters.
|
|
The first part is interpreted as a subkey name or a path of subkey
|
|
names separated by delimiters and with a trailing delimiter. The
|
|
second part is interpreted as a value name with one leading
|
|
delimiter [any extra delimiters are considered part of the value
|
|
name].
|
|
|
|
=item Hash key string ends with a delimiter
|
|
|
|
If the key string ends with a delimiter, then it is treated
|
|
as a subkey name or path of subkey names separated by delimiters.
|
|
|
|
=item Hash key string contains a delimiter
|
|
|
|
If the key string contains a delimiter, then it is split after
|
|
the last delimiter. The first part is treated as a subkey name or
|
|
path of subkey names separated by delimiters. The second part
|
|
is ambiguous and is treated as outlined in the next item.
|
|
|
|
=item Hash key string contains no delimiters
|
|
|
|
If the hash key string contains no delimiters, then it is ambiguous.
|
|
|
|
If you are reading from the hash [fetching], then we first use the
|
|
key string as a value name. If there is a value with a matching
|
|
name in the Registry key which the hash is tied to, then the value
|
|
data string [and possibly the value data type] is returned.
|
|
Otherwise, we retry by using the hash key string as a subkey name.
|
|
If there is a subkey with a matching name, then we return a
|
|
reference to a hash tied to that subkey. Otherwise we return
|
|
C<undef>.
|
|
|
|
If you are writing to the hash [storing], then we use the key
|
|
string as a subkey name only if the value you are storing is a
|
|
reference to a hash value. Otherwise we use the key string as
|
|
a value name.
|
|
|
|
=back
|
|
|
|
=head3 Examples
|
|
|
|
Here are some examples showing different ways of accessing Registry
|
|
information using references to tied hashes:
|
|
|
|
=over
|
|
|
|
=item Canonical value fetch
|
|
|
|
$tip18= $Registry->{"HKEY_LOCAL_MACHINE\\Software\\Microsoft\\"
|
|
. 'Windows\\CurrentVersion\\Explorer\\Tips\\\\18'};
|
|
|
|
Should return the text of important tip number 18. Note that two
|
|
backslashes, C<"\\">, are required to get a single backslash into
|
|
a Perl double-quoted or single-qouted string. Note that C<"\\">
|
|
is appended to each key name [C<"HKEY_LOCAL_MACHINE"> through
|
|
C<"Tips">] and C<"\\"> is prepended to the value name, C<"18">.
|
|
|
|
=item Changing your delimiter
|
|
|
|
$Registry->Delimiter("/");
|
|
$tip18= $Registry->{"HKEY_LOCAL_MACHINE/Software/Microsoft/"
|
|
. 'Windows/CurrentVersion/Explorer/Tips//18'};
|
|
|
|
This usually makes things easier to read when working in Perl.
|
|
All remaining examples will assume the delimiter has been changed
|
|
as above.
|
|
|
|
=item Using intermediate keys
|
|
|
|
$ms= $Registry->{"LMachine/Software/Microsoft/"};
|
|
$tips= $ms->{"Windows/CurrentVersion/Explorer/Tips/"};
|
|
$tip18= $winlogon->{"/18"};
|
|
|
|
Same as above but opens more keys into the Registry which lets you
|
|
efficiently re-access those intermediate keys. This is slightly
|
|
less efficient if you never reuse those intermediate keys.
|
|
|
|
=item Chaining in a single statement
|
|
|
|
$tip18= $Registry->{"LMachine/Software/Microsoft/"}->
|
|
{"Windows/CurrentVersion/Explorer/Tips/"}->{"/18"};
|
|
|
|
Like above, this creates intermediate key objects then uses
|
|
them to access other data. Once this statement finishes, the
|
|
intermediate key objects are destroyed. Several handles into
|
|
the Registry are opened and closed by this statement so it is
|
|
less efficient but there are times when this will be useful.
|
|
|
|
=item Even less efficient example of chaining
|
|
|
|
$tip18= $Registry->{"LMachine/Software/Microsoft"}->
|
|
{"Windows/CurrentVersion/Explorer/Tips"}->{"/18"};
|
|
|
|
Because we left off the trailing delimiters, I<Win32::TieRegistry>
|
|
doesn't know whether final names, C<"Microsoft"> and C<"Tips">,
|
|
are subkey names or value names. So this statement ends up
|
|
executing the same code as the next one.
|
|
|
|
=item What the above really does
|
|
|
|
$tip18= $Registry->{"LMachine/Software/"}->{"Microsoft"}->
|
|
{"Windows/CurrentVersion/Explorer/"}->{"Tips"}->{"/18"};
|
|
|
|
With more chains to go through, more temporary objects are created
|
|
and later destroyed than in our first chaining example. Also,
|
|
when C<"Microsoft"> is looked up, I<Win32::TieRegistry> first
|
|
tries to open it as a value and fails then tries it as a subkey.
|
|
The same is true for when it looks up C<"Tips">.
|
|
|
|
=item Getting all of the tips
|
|
|
|
$tips= $Registry->{"LMachine/Software/Microsoft/"}->
|
|
{"Windows/CurrentVersion/Explorer/Tips/"}
|
|
or die "Can't find the Windows tips: $^E\n";
|
|
foreach( keys %$tips ) {
|
|
print "$_: ", $tips->{$_}, "\n";
|
|
}
|
|
|
|
First notice that we actually check for failure for the first time.
|
|
Note that your version of Perl may not set C<$^E> properly [see
|
|
the L<BUGS> section]. We are assuming that the C<"Tips"> key
|
|
contains no subkeys. Otherwise the C<print> statement would show
|
|
something like C<"Win32::TieRegistry=HASH(0xc03ebc)"> for each subkey.
|
|
|
|
The output from the above code will start something like:
|
|
|
|
/0: If you don't know how to do something,[...]
|
|
|
|
=back
|
|
|
|
=head3 Deleting items
|
|
|
|
You can use the Perl C<delete> function to delete a value from a
|
|
Registry key or to delete a subkey as long that subkey contains
|
|
no subkeys of its own. See L<More Examples>, below, for more
|
|
information.
|
|
|
|
=head3 Storing items
|
|
|
|
You can use the Perl assignment operator [C<=>] to create new
|
|
keys, create new values, or replace values. The values you store
|
|
should be in the same format as the values you would fetch from a
|
|
tied hash. For example, you can use a single assignment statement
|
|
to copy an entire Registry tree. The following statement:
|
|
|
|
$Registry->{"LMachine/Software/Classes/Tie_Registry/"}=
|
|
$Registry->{"LMachine/Software/Classes/batfile/"};
|
|
|
|
creates a C<"Tie_Registry"> subkey under the C<"Software\\Classes">
|
|
subkey of the C<HKEY_LOCAL_MACHINE> key. Then it populates it
|
|
with copies of all of the subkeys and values in the C<"batfile">
|
|
subkey and all of its subkeys. Note that you need to have
|
|
called C<$Registry-E<gt>ArrayValues(1)> for the proper value data
|
|
type information to be copied. Note also that this release of
|
|
I<Win32::TieRegistry> does not copy key attributes such as class
|
|
name and security information [this is planned for a future release].
|
|
|
|
The following statement creates a whole subtree in the Registry:
|
|
|
|
$Registry->{"LMachine/Software/FooCorp/"}= {
|
|
"FooWriter/" => {
|
|
"/Version" => "4.032",
|
|
"Startup/" => {
|
|
"/Title" => "Foo Writer Deluxe ][",
|
|
"/WindowSize" => [ pack("LL",$wid,$ht), REG_BINARY ],
|
|
"/TaskBarIcon" => [ "0x0001", REG_DWORD ],
|
|
},
|
|
"Compatibility/" => {
|
|
"/AutoConvert" => "Always",
|
|
"/Default Palette" => "Windows Colors",
|
|
},
|
|
},
|
|
"/License", => "0123-9C8EF1-09-FC",
|
|
};
|
|
|
|
Note that all but the last Registry key used on the left-hand
|
|
side of the assignment [that is, "LMachine/Software/" but not
|
|
"FooCorp/"] must already exist for this statement to succeed.
|
|
|
|
By using the leading a trailing delimiters on each subkey name and
|
|
value name, I<Win32::TieRegistry> will tell you if you try to assign
|
|
subkey information to a value or visa-versa.
|
|
|
|
=head3 More examples
|
|
|
|
=over
|
|
|
|
=item Adding a new tip
|
|
|
|
$tips= $Registry->{"LMachine/Software/Microsoft/"}->
|
|
{"Windows/CurrentVersion/Explorer/Tips/"}
|
|
or die "Can't find the Windows tips: $^E\n";
|
|
$tips{'/186'}= "Be very careful when making changes to the Registry!";
|
|
|
|
=item Deleting our new tip
|
|
|
|
$tips= $Registry->{"LMachine/Software/Microsoft/"}->
|
|
{"Windows/CurrentVersion/Explorer/Tips/"}
|
|
or die "Can't find the Windows tips: $^E\n";
|
|
$tip186= delete $tips{'/186'};
|
|
|
|
Note that Perl's C<delete> function returns the value that was deleted.
|
|
|
|
=item Adding a new tip differently
|
|
|
|
$Registry->{"LMachine/Software/Microsoft/" .
|
|
"Windows/CurrentVersion/Explorer/Tips//186"}=
|
|
"Be very careful when making changes to the Registry!";
|
|
|
|
=item Deleting differently
|
|
|
|
$tip186= delete $Registry->{"LMachine/Software/Microsoft/Windows/" .
|
|
"CurrentVersion/Explorer/Tips//186"};
|
|
|
|
Note that this only deletes the tail of what we looked up, the
|
|
C<"186"> value, not any of the keys listed.
|
|
|
|
=item Deleting a key
|
|
|
|
WARNING: The following code will delete all information about the
|
|
current user's tip preferences. Actually executing this command
|
|
would probably cause the user to see the Welcome screen the next
|
|
time they log in and may cause more serious problems. This
|
|
statement is shown as an example only and should not be used when
|
|
experimenting.
|
|
|
|
$tips= delete $Registry->{"CUser/Software/Microsoft/Windows/" .
|
|
"CurrentVersion/Explorer/Tips/"};
|
|
|
|
This deletes the C<"Tips"> key and the values it contains. The
|
|
C<delete> function will return a reference to a hash [not a tied
|
|
hash] containing the value names and value data that were deleted.
|
|
|
|
The information to be returned is copied from the Registry into a
|
|
regular Perl hash before the key is deleted. If the key has many
|
|
subkeys, this copying could take a significant amount of memory
|
|
and/or processor time. So you can disable this process by calling
|
|
the C<FastDelete> member function:
|
|
|
|
$prevSetting= $regKey->FastDelete(1);
|
|
|
|
which will cause all subsequent delete operations via C<$regKey>
|
|
to simply return a true value if they succeed. This optimization
|
|
is automatically done if you use C<delete> in a void context.
|
|
|
|
=item Technical notes on deleting
|
|
|
|
If you use C<delete> to delete a Registry key or value and use
|
|
the return value, then C<Win32::TieRegistry> usually looks up the
|
|
current contents of that key or value so they can be returned if
|
|
the deletion is successful. If the deletion succeeds but the
|
|
attempt to lookup the old contents failed, then the return value
|
|
of C<delete> will be C<$^E> from the failed part of the operation.
|
|
|
|
=item Undeleting a key
|
|
|
|
$Registry->{"LMachine/Software/Microsoft/Windows/" .
|
|
"CurrentVersion/Explorer/Tips/"}= $tips;
|
|
|
|
This adds back what we just deleted. Note that this version of
|
|
I<Win32::TieRegistry> will use defaults for the key attributes
|
|
[such as class name and security] and will not restore the
|
|
previous attributes.
|
|
|
|
=item Not deleting a key
|
|
|
|
WARNING: Actually executing the following code could cause
|
|
serious problems. This statement is shown as an example only and
|
|
should not be used when experimenting.
|
|
|
|
$res= delete $Registry->{"CUser/Software/Microsoft/Windows/"}
|
|
defined($res) || die "Can't delete URL key: $^E\n";
|
|
|
|
Since the "Windows" key should contain subkeys, that C<delete>
|
|
statement should make no changes to the Registry, return C<undef>,
|
|
and set C<$^E> to "Access is denied" [but see the L<BUGS> section
|
|
about C<$^E>].
|
|
|
|
=item Not deleting again
|
|
|
|
$tips= $Registry->{"CUser/Software/Microsoft/Windows/" .
|
|
"CurrentVersion/Explorer/Tips/"};
|
|
delete $tips;
|
|
|
|
The Perl C<delete> function requires that its argument be an
|
|
expression that ends in a hash element lookup [or hash slice],
|
|
which is not the case here. The C<delete> function doesn't
|
|
know which hash $tips came from and so can't delete it.
|
|
|
|
=back
|
|
|
|
=head2 Objects Documentation
|
|
|
|
The following member functions are defined for use on
|
|
I<Win32::TieRegistry> objects:
|
|
|
|
=over
|
|
|
|
=item new
|
|
|
|
The C<new> method creates a new I<Win32::TieRegistry> object.
|
|
C<new> is mostly a synonym for C<Open()> so see C<Open()> below for
|
|
information on what arguments to pass in. Examples:
|
|
|
|
$machKey= new Win32::TieRegistry "LMachine"
|
|
or die "Can't access HKEY_LOCAL_MACHINE key: $^E\n";
|
|
$userKey= Win32::TieRegistry->new("CUser")
|
|
or die "Can't access HKEY_CURRENT_USER key: $^E\n";
|
|
|
|
Note that calling C<new> via a reference to a tied hash returns
|
|
a simple object, not a reference to a tied hash.
|
|
|
|
=item Open
|
|
|
|
=item $subKey= $key->Open( $sSubKey, $rhOptions )
|
|
|
|
The C<Open> method opens a Registry key and returns a new
|
|
I<Win32::TieRegistry> object associated with that Registry key.
|
|
If C<Open> is called via a reference to a tied hash, then C<Open>
|
|
returns another reference to a tied hash. Otherwise C<Open>
|
|
returns a simple object and you should then use C<TiedRef> to get
|
|
a reference to a tied hash.
|
|
|
|
C<$sSubKey> is a string specifying a subkey to be opened.
|
|
Alternately C<$sSubKey> can be a reference to an array value
|
|
containing the list of increasingly deep subkeys specifying the
|
|
path to the subkey to be opened.
|
|
|
|
C<$rhOptions> is an optional reference to a hash containing extra
|
|
options. The C<Open> method supports two options, C<"Delimiter">
|
|
and C<"Access">, and C<$rhOptions> should have only have zero or
|
|
more of these strings as keys. See the "Examples" section below
|
|
for more information.
|
|
|
|
The C<"Delimiter"> option specifies what string [usually a single
|
|
character] will be used as the delimiter to be appended to subkey
|
|
names and prepended to value names. If this option is not specified,
|
|
the new key [C<$subKey>] inherits the delimiter of the old key
|
|
[C<$key>].
|
|
|
|
The C<"Access"> option specifies what level of access to the
|
|
Registry key you wish to have once it has been opened. If this
|
|
option is not specified, the new key [C<$subKey>] is opened with
|
|
the same access level used when the old key [C<$key>] was opened.
|
|
The virtual root of the Registry pretends it was opened with
|
|
access C<KEY_READ|KEY_WRITE> so this is the default access when
|
|
opening keys directory via C<$Registry>. If you don't plan on
|
|
modifying a key, you should open it with C<KEY_READ> access as
|
|
you may not have C<KEY_WRITE> access to it or some of its subkeys.
|
|
|
|
If the C<"Access"> option value is a string that starts with
|
|
C<"KEY_">, then it should match E<one> of the predefined access
|
|
levels [probably C<"KEY_READ">, C<"KEY_WRITE">, or
|
|
C<"KEY_ALL_ACCESS">] exported by the C<Win32API::Registry> module.
|
|
Otherwise, a numeric value is expected. For maximum flexibility,
|
|
include C<use Win32API::Registry qw(:KEY_);>, for example, near
|
|
the top of your script so you can specify more complicated access
|
|
levels such as C<KEY_READ|KEY_WRITE>.
|
|
|
|
If C<$sSubKey> does not begin with the delimiter [or C<$sSubKey>
|
|
is an array reference], then the path to the subkey to be opened
|
|
will be relative to the path of the original key [C<$key>]. If
|
|
C<$sSubKey> begins with a single delimiter, then the path to the
|
|
subkey to be opened will be relative to the virtual root of the
|
|
Registry on whichever machine the original key resides. If
|
|
C<$sSubKey> begins with two consectutive delimiters, then those
|
|
must be followed by a machine name which causes the C<Connect()>
|
|
method function to be called.
|
|
|
|
Examples:
|
|
|
|
$machKey= $Registry->Open( "LMachine", {Access=>KEY_READ,Delimiter=>"/"} )
|
|
or die "Can't open HKEY_LOCAL_MACHINE key: $^E\n";
|
|
$swKey= $machKey->Open( "Software" );
|
|
$logonKey= $swKey->Open( "Microsoft/Windows NT/CurrentVersion/Winlogon/" );
|
|
$NTversKey= $swKey->Open( ["Microsoft","Windows NT","CurrentVersion"] );
|
|
$versKey= $swKey->Open( qw(Microsoft Windows CurrentVersion) );
|
|
|
|
$remoteKey= $Registry->Open( "//HostA/LMachine/System/", {Delimiter=>"/"} )
|
|
or die "Can't connect to HostA or can't open subkey: $^E\n";
|
|
|
|
=item Clone
|
|
|
|
=item $copy= $key->Clone
|
|
|
|
Creates a new object that is associated with the same Registry key
|
|
as the invoking object.
|
|
|
|
=item Connect
|
|
|
|
=item $remoteKey= $Registry->Connect( $sMachineName, $sKeyPath, $rhOptions )
|
|
|
|
The C<Connect> method connects to the Registry of a remote machine,
|
|
and opens a key within it, then returns a new I<Win32::TieRegistry>
|
|
object associated with that remote Registry key. If C<Connect>
|
|
was called using a reference to a tied hash, then the return value
|
|
will also be a reference to a tied hash [or C<undef>]. Otherwise,
|
|
if you wish to use the returned object as a tied hash [not just as
|
|
an object], then use the C<TiedRef> method function after C<Connect>.
|
|
|
|
C<$sMachineName> is the name of the remote machine. You don't have
|
|
to preceed the machine name with two delimiter characters.
|
|
|
|
C<$sKeyPath> is a string specifying the remote key to be opened.
|
|
Alternately C<$sKeyPath> can be a reference to an array value
|
|
containing the list of increasingly deep keys specifying the path
|
|
to the key to be opened.
|
|
|
|
C<$rhOptions> is an optional reference to a hash containing extra
|
|
options. The C<Connect> method supports two options, C<"Delimiter">
|
|
and C<"Access">. See the C<Open> method documentation for more
|
|
information on these options.
|
|
|
|
C<$sKeyPath> is already relative to the virtual root of the Registry
|
|
of the remote machine. A single leading delimiter on C<sKeyPath>
|
|
will be ignored and is not required.
|
|
|
|
C<$sKeyPath> can be empty in which case C<Connect> will return an
|
|
object representing the virtual root key of the remote Registry.
|
|
Each subsequent use of C<Open> on this virtual root key will call
|
|
the system C<RegConnectRegistry> function.
|
|
|
|
The C<Connect> method can be called via any I<Win32::TieRegistry>
|
|
object, not just C<$Registry>. Attributes such as the desired
|
|
level of access and the delimiter will be inherited from the
|
|
object used but the C<$sKeyPath> will always be relative to the
|
|
virtual root of the remote machine's registry.
|
|
|
|
Examples:
|
|
|
|
$remMachKey= $Registry->Connect( "HostA", "LMachine", {Delimiter->"/"} )
|
|
or die "Can't connect to HostA's HKEY_LOCAL_MACHINE key: $^E\n";
|
|
|
|
$remVersKey= $remMachKey->Connect( "www.microsoft.com",
|
|
"LMachine/Software/Microsoft/Inetsrv/CurrentVersion/",
|
|
{ Access->KEY_READ, Delimiter->"/" } )
|
|
or die "Can't check what version of IIS Microsoft is running: $^E\n";
|
|
|
|
$remVersKey= $remMachKey->Connect( "www",
|
|
qw(LMachine Software Microsoft Inetsrv CurrentVersion) )
|
|
or die "Can't check what version of IIS we are running: $^E\n";
|
|
|
|
=item ObjectRef
|
|
|
|
=item $object_ref= $obj_or_hash_ref->ObjectRef
|
|
|
|
For a simple object, just returns itself [C<$obj == $obj->ObjectRef>].
|
|
|
|
For a reference to a tied hash [if it is also an object], C<ObjectRef>
|
|
returns the simple object that the hash is tied to.
|
|
|
|
This is primarilly useful when debugging since typing C<x $Registry>
|
|
will try to display your I<entire> registry contents to your screen.
|
|
But the debugger command C<x $Registry->ObjectRef> will just dump
|
|
the implementation details of the underlying object to your screen.
|
|
|
|
=item Flush( $bFlush )
|
|
|
|
Flushes all cached information about the Registry key so that future
|
|
uses will get fresh data from the Registry.
|
|
|
|
If the optional C<$bFlush> is specified and a true value, then
|
|
C<RegFlushKey()> will be called, which is almost never necessary.
|
|
|
|
=item GetValue
|
|
|
|
=item $ValueData= $key->GetValue( $sValueName )
|
|
|
|
=item ($ValueData,$ValueType)= $key->GetValue( $sValueName )
|
|
|
|
Gets a Registry value's data and data type.
|
|
|
|
C<$ValueData> is usually just a Perl string that contains the
|
|
value data [packed into it]. For certain types of data, however,
|
|
C<$ValueData> may be processed as described below.
|
|
|
|
C<$ValueType> is the C<REG_*> constant describing the type of value
|
|
data stored in C<$ValueData>. If the C<DualTypes()> option is on,
|
|
then C<$ValueType> will be a dual value. That is, when used in a
|
|
numeric context, C<$ValueType> will give the numeric value of a
|
|
C<REG_*> constant. However, when used in a non-numeric context,
|
|
C<$ValueType> will return the name of the C<REG_*> constant, for
|
|
example C<"REG_SZ"> [note the quotes]. So both of the following
|
|
can be true at the same time:
|
|
|
|
$ValueType == REG_SZ
|
|
and
|
|
$ValueType eq "REG_SZ"
|
|
|
|
=over
|
|
|
|
=item REG_SZ and REG_EXPAND_SZ
|
|
|
|
If the C<FixSzNulls()> option is on, then the trailing C<'\0'> will be
|
|
stripped [unless there isn't one] before values of type C<REG_SZ>
|
|
and C<REG_EXPAND_SZ> are returned. Note that C<SetValue()> will add
|
|
a trailing C<'\0'> under similar circumstances.
|
|
|
|
=item REG_MULTI_SZ
|
|
|
|
If the C<SplitMultis()> option is on, then values of this type are
|
|
returned as a reference to an array containing the strings. For
|
|
example, a value that, with C<SplitMultis()> off, would be returned as:
|
|
|
|
"Value1\000Value2\000\000"
|
|
|
|
would be returned, with C<SplitMultis()> on, as:
|
|
|
|
[ "Value1", "Value2" ]
|
|
|
|
=item REG_DWORD
|
|
|
|
If the C<DualBinVals()> option is on, then the value is returned
|
|
as a scalar containing both a string and a number [much like
|
|
the C<$!> variable -- see the C<SetDualVar()> module for more
|
|
information] where the number part is the "unpacked" value.
|
|
Use the returned value in a numeric context to access this part
|
|
of the value. For example:
|
|
|
|
$num= 0 + $Registry->{"CUser/Console//ColorTable01"};
|
|
|
|
If the C<DWordsToHex()> option is off, the string part of the
|
|
returned value is a packed, 4-byte string [use C<unpack("L",$value)>
|
|
to get the numeric value.
|
|
|
|
If C<DWordsToHex()> is on, the string part of the returned value is
|
|
a 10-character hex strings [with leading "0x"]. You can use
|
|
C<hex($value)> to get the numeric value.
|
|
|
|
Note that C<SetValue()> will properly understand each of these
|
|
returned value formats no matter how C<DualBinVals()> is set.
|
|
|
|
=back
|
|
|
|
=item ValueNames
|
|
|
|
=item @names= $key->ValueNames
|
|
|
|
Returns the list of value names stored directly in a Registry key.
|
|
Note that the names returned do I<not> have a delimiter prepended
|
|
to them like with C<MemberNames()> and tied hashes.
|
|
|
|
Once you request this information, it is cached in the object and
|
|
future requests will always return the same list unless C<Flush()>
|
|
has been called.
|
|
|
|
=item SubKeyNames
|
|
|
|
=item @key_names= $key->SubKeyNames
|
|
|
|
Returns the list of subkey names stored directly in a Registry key.
|
|
Note that the names returned do I<not> have a delimiter appended
|
|
to them like with C<MemberNames()> and tied hashes.
|
|
|
|
Once you request this information, it is cached in the object and
|
|
future requests will always return the same list unless C<Flush()>
|
|
has been called.
|
|
|
|
=item SubKeyClasses
|
|
|
|
=item @classes= $key->SubKeyClasses
|
|
|
|
Returns the list of classes for subkeys stored directly in a
|
|
Registry key. The classes are returned in the same order as
|
|
the subkey names returned by C<SubKeyNames()>.
|
|
|
|
=item SubKeyTimes
|
|
|
|
=item @times= $key->SubKeyTimes
|
|
|
|
Returns the list of last-modified times for subkeys stored
|
|
directly in a Registry key. The times are returned in the same
|
|
order as the subkey names returned by C<SubKeyNames()>. Each
|
|
time is a C<FILETIME> structure packed into a Perl string.
|
|
|
|
Once you request this information, it is cached in the object and
|
|
future requests will always return the same list unless C<Flush()>
|
|
has been called.
|
|
|
|
=item MemberNames
|
|
|
|
=item @members= $key->MemberNames
|
|
|
|
Returns the list of subkey names and value names stored directly
|
|
in a Registry key. Subkey names have a delimiter appended to the
|
|
end and value names have a delimiter prepended to the front.
|
|
|
|
Note that a value name could end in a delimiter [or could be C<"">
|
|
so that the member name returned is just a delimiter] so the
|
|
presence or absence of the leading delimiter is what should be
|
|
used to determine whether a particular name is for a subkey or a
|
|
value, not the presence or absence of a trailing delimiter.
|
|
|
|
Once you request this information, it is cached in the object and
|
|
future requests will always return the same list unless C<Flush()>
|
|
has been called.
|
|
|
|
=item Information
|
|
|
|
=item %info= $key->Information
|
|
|
|
=item @items= $key->Information( @itemNames );
|
|
|
|
Returns the following information about a Registry key:
|
|
|
|
=over
|
|
|
|
=item LastWrite
|
|
|
|
A C<FILETIME> structure indicating when the key was last modified
|
|
and packed into a Perl string.
|
|
|
|
=item CntSubKeys
|
|
|
|
The number of subkeys stored directly in this key.
|
|
|
|
=item CntValues
|
|
|
|
The number of values stored directly in this key.
|
|
|
|
=item SecurityLen
|
|
|
|
The length [in bytes] of the largest[?] C<SECURITY_DESCRIPTOR>
|
|
associated with the Registry key.
|
|
|
|
=item MaxValDataLen
|
|
|
|
The length [in bytes] of the longest value data associated with
|
|
a value stored in this key.
|
|
|
|
=item MaxSubKeyLen
|
|
|
|
The length [in chars] of the longest subkey name associated with
|
|
a subkey stored in this key.
|
|
|
|
=item MaxSubClassLen
|
|
|
|
The length [in chars] of the longest class name associated with
|
|
a subkey stored directly in this key.
|
|
|
|
=item MaxValNameLen
|
|
|
|
The length [in chars] of the longest value name associated with
|
|
a value stored in this key.
|
|
|
|
=back
|
|
|
|
With no arguments, returns a hash [not a reference to a hash] where
|
|
the keys are the names for the items given above and the values
|
|
are the information describe above. For example:
|
|
|
|
%info= ( "CntValues" => 25, # Key contains 25 values.
|
|
"MaxValNameLen" => 20, # One of which has a 20-char name.
|
|
"MaxValDataLen" => 42, # One of which has a 42-byte value.
|
|
"CntSubKeys" => 1, # Key has 1 immediate subkey.
|
|
"MaxSubKeyLen" => 13, # One of which has a 12-char name.
|
|
"MaxSubClassLen" => 0, # All of which have class names of "".
|
|
"SecurityLen" => 232, # One SECURITY_DESCRIPTOR is 232 bytes.
|
|
"LastWrite" => "\x90mZ\cX{\xA3\xBD\cA\c@\cA"
|
|
# Key was last modifed 1998/06/01 16:29:32 GMT
|
|
);
|
|
|
|
With arguments, each one must be the name of a item given above.
|
|
The return value is the information associated with the listed
|
|
names. In other words:
|
|
|
|
return $key->Information( @names );
|
|
|
|
returns the same list as:
|
|
|
|
%info= $key->Information;
|
|
return @info{@names};
|
|
|
|
=item Delimiter
|
|
|
|
=item $oldDelim= $key->Delimiter
|
|
|
|
=item $oldDelim= $key->Delimiter( $newDelim )
|
|
|
|
Gets and possibly changes the delimiter used for this object. The
|
|
delimiter is appended to subkey names and prepended to value names
|
|
in many return values. It is also used when parsing keys passed
|
|
to tied hashes.
|
|
|
|
The delimiter defaults to backslash (C<'\\'>) but is inherited from
|
|
the object used to create a new object and can be specified by an
|
|
option when a new object is created.
|
|
|
|
=item Handle
|
|
|
|
=item $handle= $key->Handle
|
|
|
|
Returns the raw C<HKEY> handle for the associated Registry key as
|
|
an integer value. This value can then be used to Reg*() calls
|
|
from C<Win32API::Registry>. However, it is usually easier to just
|
|
call the C<Win32API::Registry> calls directly via:
|
|
|
|
$key->RegNotifyChangeKeyValue( ... );
|
|
|
|
For the virtual root of the local or a remote Registry,
|
|
C<Handle()> return C<"NONE">.
|
|
|
|
=item Path
|
|
|
|
=item $path= $key->Path
|
|
|
|
Returns a string describing the path of key names to this
|
|
Registry key. The string is built so that if it were passed
|
|
to C<$Registry->Open()>, it would reopen the same Registry key
|
|
[except in the rare case where one of the key names contains
|
|
C<$key->Delimiter>].
|
|
|
|
=item Machine
|
|
|
|
=item $computerName= $key->Machine
|
|
|
|
Returns the name of the computer [or "machine"] on which this Registry
|
|
key resides. Returns C<""> for local Registry keys.
|
|
|
|
=item Access
|
|
|
|
Returns the numeric value of the bit mask used to specify the
|
|
types of access requested when this Registry key was opened. Can
|
|
be compared to C<KEY_*> values.
|
|
|
|
=item OS_Delimiter
|
|
|
|
Returns the delimiter used by the operating system's RegOpenKeyEx()
|
|
call. For Win32, this is always backslash (C<"\\">).
|
|
|
|
=item Roots
|
|
|
|
Returns the mapping from root key names like C<"LMachine"> to their
|
|
associated C<HKEY_*> constants. Primarily for internal use and
|
|
subject to change.
|
|
|
|
=item Tie
|
|
|
|
=item $key->Tie( \%hash );
|
|
|
|
Ties the referenced hash to that Registry key. Pretty much the
|
|
same as
|
|
|
|
tie %hash, ref($key), $key;
|
|
|
|
Since C<ref($key)> is the class [package] to tie the hash to and
|
|
C<TIEHASH()> just returns its argument, C<$key>, [without calling
|
|
C<new()>] when it sees that it is already a blessed object.
|
|
|
|
=item TiedRef
|
|
|
|
=item $TiedHashRef= $hash_or_obj_ref->TiedRef
|
|
|
|
For a simple object, returns a reference to a hash tied to the
|
|
object. Used to promote a simple object into a combined object
|
|
and hash ref.
|
|
|
|
If already a reference to a tied hash [that is also an object],
|
|
it just returns itself [C<$ref == $ref->TiedRef>].
|
|
|
|
Mostly used internally.
|
|
|
|
=item ArrayValues
|
|
|
|
=item $oldBool= $key->ArrayValues
|
|
|
|
=item $oldBool= $key->ArrayValues( $newBool )
|
|
|
|
Gets the current setting of the C<ArrayValues> option and possibly
|
|
turns it on or off.
|
|
|
|
When off, Registry values fetched via a tied hash are returned as
|
|
just a value scalar [the same as C<GetValue()> in a scalar context].
|
|
When on, they are returned as a reference to an array containing
|
|
the value data as the C<[0]> element and the data type as the C<[1]>
|
|
element.
|
|
|
|
=item TieValues
|
|
|
|
=item $oldBool= TieValues
|
|
|
|
=item $oldBool= TieValues( $newBool )
|
|
|
|
Gets the current setting of the C<TieValues> option and possibly
|
|
turns it on or off.
|
|
|
|
Turning this option on is not yet supported in this release of
|
|
C<Win32::TieRegistry>. In a future release, turning this option
|
|
on will cause Registry values returned from a tied hash to be
|
|
a tied array that you can use to modify the value in the Registry.
|
|
|
|
=item FastDelete
|
|
|
|
=item $oldBool= $key->FastDelete
|
|
|
|
=item $oldBool= $key->FastDelete( $newBool )
|
|
|
|
Gets the current setting of the C<FastDelete> option and possibly
|
|
turns it on or off.
|
|
|
|
When on, successfully deleting a Registry key [via a tied hash]
|
|
simply returns C<1>.
|
|
|
|
When off, successfully deleting a Registry key [via a tied hash
|
|
and not in a void context] returns a reference to a hash that
|
|
contains the values present in the key when it was deleted. This
|
|
hash is just like that returned when referencing the key before it
|
|
was deleted except that it is an ordinary hash, not one tied to
|
|
the C<Win32::TieRegistry> package.
|
|
|
|
Note that deleting either a Registry key or value via a tied hash
|
|
I<in a void context> prevents any overhead in trying to build an
|
|
appropriate return value.
|
|
|
|
Note that deleting a Registry I<value> via a tied hash [not in
|
|
a void context] returns the value data even if <FastDelete> is on.
|
|
|
|
=item SplitMultis
|
|
|
|
=item $oldBool= $key->SplitMultis
|
|
|
|
=item $oldBool= $key->SplitMultis( $newBool )
|
|
|
|
Gets the current setting of the C<SplitMultis> option and possibly
|
|
turns it on or off.
|
|
|
|
If on, Registry values of type C<REG_MULTI_SZ> are returned as
|
|
a reference to an array of strings. See C<GetValue()> for more
|
|
information.
|
|
|
|
=item DWordsToHex
|
|
|
|
=item $oldBool= $key->DWordsToHex
|
|
|
|
=item $oldBool= $key->DWordsToHex( $newBool )
|
|
|
|
Gets the current setting of the C<DWordsToHex> option and possibly
|
|
turns it on or off.
|
|
|
|
If on, Registry values of type C<REG_DWORD> are returned as a hex
|
|
string with leading C<"0x"> and longer than 4 characters. See
|
|
C<GetValue()> for more information.
|
|
|
|
=item FixSzNulls
|
|
|
|
=item $oldBool= $key->FixSzNulls
|
|
|
|
=item $oldBool= $key->FixSzNulls( $newBool )
|
|
|
|
Gets the current setting of the C<FixSzNulls> option and possibly
|
|
turns it on or off.
|
|
|
|
If on, Registry values of type C<REG_SZ> and C<REG_EXPAND_SZ> have
|
|
trailing C<'\0'>s added before they are set and stripped before
|
|
they are returned. See C<GetValue()> and C<SetValue()> for more
|
|
information.
|
|
|
|
=item DualTypes
|
|
|
|
=item $oldBool= $key->DualTypes
|
|
|
|
=item $oldBool= $key->DualTypes( $newBool )
|
|
|
|
Gets the current setting of the C<DualTypes> option and possibly
|
|
turns it on or off.
|
|
|
|
If on, data types are returned as a combined numeric/string value
|
|
holding both the numeric value of a C<REG_*> constant and the
|
|
string value of the constant's name. See C<GetValue()> for
|
|
more information.
|
|
|
|
=item DualBinVals
|
|
|
|
=item $oldBool= $key->DualBinVals
|
|
|
|
=item $oldBool= $key->DualBinVals( $newBool )
|
|
|
|
Gets the current setting of the C<DualBinVals> option and possibly
|
|
turns it on or off.
|
|
|
|
If on, Registry value data of type C<REG_BINARY> and no more than
|
|
4 bytes long and Registry values of type C<REG_DWORD> are returned
|
|
as a combined numeric/string value where the numeric value is the
|
|
"unpacked" binary value as returned by:
|
|
|
|
hex reverse unpack( "h*", $valData )
|
|
|
|
on a "little-endian" computer. [Would be C<hex unpack("H*",$valData)>
|
|
on a "big-endian" computer if this module is ever ported to one.]
|
|
|
|
See C<GetValue()> for more information.
|
|
|
|
=item GetOptions
|
|
|
|
=item @oldOpts= $key->GetOptions( @optionNames )
|
|
|
|
Returns the current setting of any of the following options:
|
|
|
|
Delimiter FixSzNulls DWordsToHex
|
|
ArrayValues SplitMultis DualBinVals
|
|
TieValues FastDelete DualTypes
|
|
|
|
=item SetOptions
|
|
|
|
=item @oldOpts= $key->SetOptions( optNames=>$optValue,... )
|
|
|
|
Changes the current setting of any of the following options,
|
|
returning the previous setting(s):
|
|
|
|
Delimiter FixSzNulls DWordsToHex AllowLoad
|
|
ArrayValues SplitMultis DualBinVals AllowSave
|
|
TieValues FastDelete DualTypes
|
|
|
|
For C<AllowLoad> and C<AllowSave>, instead of the previous
|
|
setting, C<SetOptions> returns whether or not the change was
|
|
successful.
|
|
|
|
In a scalar context, returns only the last item. The last
|
|
option can also be specified as C<"ref"> or C<"r"> [which doesn't
|
|
need to be followed by a value] to allow chaining:
|
|
|
|
$key->SetOptions(AllowSave=>1,"ref")->RegSaveKey(...)
|
|
|
|
=item SetValue
|
|
|
|
=item $okay= $key->SetValue( $ValueName, $ValueData );
|
|
|
|
=item $okay= $key->SetValue( $ValueName, $ValueData, $ValueType );
|
|
|
|
Adds or replaces a Registry value. Returns a true value if
|
|
successfully, false otherwise.
|
|
|
|
C<$ValueName> is the name of the value to add or replace and
|
|
should I<not> have a delimiter prepended to it. Case is ignored.
|
|
|
|
C<$ValueType> is assumed to be C<REG_SZ> if it is omitted. Otherwise,
|
|
it should be one the C<REG_*> constants.
|
|
|
|
C<$ValueData> is the data to be stored in the value, probably packed
|
|
into a Perl string. Other supported formats for value data are
|
|
listed below for each posible C<$ValueType>.
|
|
|
|
=over
|
|
|
|
=item REG_SZ or REG_EXPAND_SZ
|
|
|
|
The only special processing for these values is the addition of
|
|
the required trailing C<'\0'> if it is missing. This can be
|
|
turned off by disabling the C<FixSzNulls> option.
|
|
|
|
=item REG_MULTI_SZ
|
|
|
|
These values can also be specified as a reference to a list of
|
|
strings. For example, the following two lines are equivalent:
|
|
|
|
$key->SetValue( "Val1\000Value2\000LastVal\000\000", REG_MULTI_SZ );
|
|
vs.
|
|
$key->SetValue( ["Val1","Value2","LastVal"], REG_MULTI_SZ );
|
|
|
|
Note that if the required two trailing nulls (C<"\000\000">) are
|
|
missing, then this release of C<SetValue()> will I<not> add them.
|
|
|
|
=item REG_DWORD
|
|
|
|
These values can also be specified as a hex value with the leading
|
|
C<"0x"> included and totaling I<more than> 4 bytes. These will be
|
|
packed into a 4-byte string via:
|
|
|
|
$data= pack( "L", hex($data) );
|
|
|
|
=item REG_BINARY
|
|
|
|
This value type is listed just to emphasize that no alternate
|
|
format is supported for it. In particular, you should I<not> pass
|
|
in a numeric value for this type of data. C<SetValue()> cannot
|
|
distinguish such from a packed string that just happens to match
|
|
a numeric value and so will treat it as a packed string.
|
|
|
|
=back
|
|
|
|
An alternate calling format:
|
|
|
|
$okay= $key->SetValue( $ValueName, [ $ValueData, $ValueType ] );
|
|
|
|
[two arguments, the second of which is a reference to an array
|
|
containing the value data and value type] is supported to ease
|
|
using tied hashes with C<SetValue()>.
|
|
|
|
=item CreateKey
|
|
|
|
=item $newKey= $key->CreateKey( $subKey );
|
|
|
|
=item $newKey= $key->CreateKey( $subKey, { Option=>OptVal,... } );
|
|
|
|
Creates a Registry key or just updates attributes of one. Calls
|
|
C<RegCreateKeyEx()> then, if it succeeded, creates an object
|
|
associated with the [possibly new] subkey.
|
|
|
|
C<$subKey> is the name of a subkey [or a path to one] to be
|
|
created or updated. It can also be a reference to an array
|
|
containing a list of subkey names.
|
|
|
|
The second argument, if it exists, should be a reference to a
|
|
hash specifying options either to be passed to C<RegCreateKeyEx()>
|
|
or to be used when creating the associated object. The following
|
|
items are the supported keys for this options hash:
|
|
|
|
=over
|
|
|
|
=item Delimiter
|
|
|
|
Specifies the delimiter to be used to parse C<$subKey> and to be
|
|
used in the new object. Defaults to C<$key->Delimiter>.
|
|
|
|
=item Access
|
|
|
|
Specifies the types of access requested when the subkey is opened.
|
|
Should be a numeric bit mask that combines one or more C<KEY_*>
|
|
constant values.
|
|
|
|
=item Class
|
|
|
|
The name to assign as the class of the new or updated subkey.
|
|
Defaults to C<""> as we have never seen a use for this information.
|
|
|
|
=item Disposition
|
|
|
|
Lets you specify a reference to a scalar where, upon success,
|
|
either C<REG_CREATED_NEW_KEY> or C<REG_OPENED_EXISTING_KEY>
|
|
depending on whether a new key was created or an existing key
|
|
was opened.
|
|
|
|
=item Security
|
|
|
|
Lets you specify a C<SECURITY_ATTRIBUTES> structure packed into a
|
|
Perl string. See C<Win32API::Registry::RegCreateKeyEx()> for more
|
|
information.
|
|
|
|
=item Volatile
|
|
|
|
If true, specifies that the new key should be volatile, that is,
|
|
stored only in memory and not backed by a hive file [and not saved
|
|
if the computer is rebooted]. This option is ignored under
|
|
Windows 95. Specifying C<Volatile=E<GT>1> is the same as
|
|
specifying C<Options=E<GT>REG_OPTION_VOLATILE>.
|
|
|
|
=item Backup
|
|
|
|
If true, specifies that the new key should be opened for
|
|
backup/restore access. The C<Access> option is ignored. If the
|
|
calling process has enabled C<"SeBackupPrivilege">, then the
|
|
subkey is opened with C<KEY_READ> access as the C<"LocalSystem">
|
|
user which should have access to all subkeys. If the calling
|
|
process has enabled C<"SeRestorePrivilege">, then the subkey is
|
|
opened with C<KEY_WRITE> access as the C<"LocalSystem"> user which
|
|
should have access to all subkeys.
|
|
|
|
This option is ignored under Windows 95. Specifying C<Backup=E<GT>1>
|
|
is the same as specifying C<Options=E<GT>REG_OPTION_BACKUP_RESTORE>.
|
|
|
|
=item Options
|
|
|
|
Lets you specify options to the C<RegOpenKeyEx()> call. The value
|
|
for this option should be a numeric value combining zero or more
|
|
of the C<REG_OPTION_*> bit masks. You may with to used the
|
|
C<Volatile> and/or C<Backup> options instead of this one.
|
|
|
|
=back
|
|
|
|
=item StoreKey
|
|
|
|
=item $newKey= $key->StoreKey( $subKey, \%Contents );
|
|
|
|
Primarily for internal use.
|
|
|
|
Used to create or update a Registry key and any number of subkeys
|
|
or values under it or its subkeys.
|
|
|
|
C<$subKey> is the name of a subkey to be created [or a path of
|
|
subkey names separated by delimiters]. If that subkey already
|
|
exists, then it is updated.
|
|
|
|
C<\%Contents> is a reference to a hash containing pairs of
|
|
value names with value data and/or subkey names with hash
|
|
references similar to C<\%Contents>. Each of these cause
|
|
a value or subkey of C<$subKey> to be created or updated.
|
|
|
|
If C<$Contents{""}> exists and is a reference to a hash, then
|
|
it used as the options argument when C<CreateKey()> is called
|
|
for C<$subKey>. This allows you to specify ...
|
|
|
|
if( defined( $$data{""} ) && "HASH" eq ref($$data{""}) ) {
|
|
$self= $this->CreateKey( $subKey, delete $$data{""} );
|
|
|
|
=item Load
|
|
|
|
=item $newKey= $key->Load( $file )
|
|
|
|
=item $newKey= $key->Load( $file, $newSubKey )
|
|
|
|
=item $newKey= $key->Load( $file, $newSubKey, { Option=>OptVal... } )
|
|
|
|
=item $newKey= $key->Load( $file, { Option=>OptVal... } )
|
|
|
|
Loads a hive file into a Registry. That is, creates a new subkey
|
|
and associates a hive file with it.
|
|
|
|
C<$file> is a hive file, that is a file created by calling
|
|
C<RegSaveKey()>. The C<$file> path is interpreted relative to
|
|
C<%SystemRoot%/System32/config> on the machine where C<$key>
|
|
resides.
|
|
|
|
C<$newSubKey> is the name to be given to the new subkey. If
|
|
C<$newSubKey> is specified, then C<$key> must be
|
|
C<HKEY_LOCAL_MACHINE> or C<HKEY_USERS> of the local computer
|
|
or a remote computer and C<$newSubKey> should not contain any
|
|
occurrences of either the delimiter or the OS delimiter.
|
|
|
|
If C<$newSubKey> is not specified, then it is as if C<$key>
|
|
was C<$Registry-E<GT>{LMachine}> and C<$newSubKey> is
|
|
C<"PerlTie:999"> where C<"999"> is actually a sequence number
|
|
incremented each time this process calls C<Load()>.
|
|
|
|
You can specify as the last argument a reference to a hash
|
|
containing options. You can specify the same options that you
|
|
can specify to C<Open()>. See C<Open()> for more information on
|
|
those. In addition, you can specify the option C<"NewSubKey">.
|
|
The value of this option is interpretted exactly as if it was
|
|
specified as the C<$newSubKey> parameter and overrides the
|
|
C<$newSubKey> if one was specified.
|
|
|
|
=item UnLoad
|
|
|
|
=item $okay= $key->UnLoad
|
|
|
|
Unloads a hive that was loaded via C<Load()>. Cannot unload other
|
|
hives. C<$key> must be the return from a previous call to C<Load()>.
|
|
C<$key> is closed and then the hive is unloaded.
|
|
|
|
=item AllowSave
|
|
|
|
=item $okay= AllowSave( $bool )
|
|
|
|
Enables or disables the C<"ReBackupPrivilege"> privilege for the
|
|
current process. You will probably have to enable this privilege
|
|
before you can use C<RegSaveKey()>.
|
|
|
|
The return value indicates whether the operation succeeded, not
|
|
whether the privilege was previously enabled.
|
|
|
|
=item AllowLoad
|
|
|
|
=item $okay= AllowLoad( $bool )
|
|
|
|
Enables or disables the C<"ReRestorePrivilege"> privilege for the
|
|
current process. You will probably have to enable this privilege
|
|
before you can use C<RegLoadKey()>, C<RegUnLoadKey()>,
|
|
C<RegReplaceKey()>, or C<RegRestoreKey> and thus C<Load()> and
|
|
C<UnLoad()>.
|
|
|
|
The return value indicates whether the operation succeeded, not
|
|
whether the privilege was previously enabled.
|
|
|
|
=back
|
|
|
|
=head1 SUMMARY
|
|
|
|
Most things can be done most easily via tied hashes. Skip down to the
|
|
the L<Tied Hashes Summary> to get started quickly.
|
|
|
|
=head2 Objects Summary
|
|
|
|
Here are quick examples that document the most common functionality
|
|
of all of the method functions [except for a few almost useless ones].
|
|
|
|
# Just another way of saying Open():
|
|
$key= new Win32::TieRegistry "LMachine\\Software\\",
|
|
{ Access=>KEY_READ|KEY_WRITE, Delimiter=>"\\" };
|
|
|
|
# Open a Registry key:
|
|
$subKey= $key->Open( "SubKey/SubSubKey/",
|
|
{ Access=>KEY_ALL_ACCESS, Delimiter=>"/" } );
|
|
|
|
# Connect to a remote Registry key:
|
|
$remKey= $Registry->Connect( "MachineName", "LMachine/",
|
|
{ Access=>KEY_READ, Delimiter=>"/" } );
|
|
|
|
# Get value data:
|
|
$valueString= $key->GetValue("ValueName");
|
|
( $valueString, $valueType )= $key->GetValue("ValueName");
|
|
|
|
# Get list of value names:
|
|
@valueNames= $key->ValueNames;
|
|
|
|
# Get list of subkey names:
|
|
@subKeyNames= $key->SubKeyNames;
|
|
|
|
# Get combined list of value names (with leading delimiters)
|
|
# and subkey names (with trailing delimiters):
|
|
@memberNames= $key->MemberNames;
|
|
|
|
# Get all information about a key:
|
|
%keyInfo= $key->Information;
|
|
# keys(%keyInfo)= qw( Class LastWrite SecurityLen
|
|
# CntSubKeys MaxSubKeyLen MaxSubClassLen
|
|
# CntValues MaxValNameLen MaxValDataLen );
|
|
|
|
# Get selected information about a key:
|
|
( $class, $cntSubKeys )= $key->Information( "Class", "CntSubKeys" );
|
|
|
|
# Get and/or set delimiter:
|
|
$delim= $key->Delimiter;
|
|
$oldDelim= $key->Delimiter( $newDelim );
|
|
|
|
# Get "path" for an open key:
|
|
$path= $key->Path;
|
|
# For example, "/CUser/Control Panel/Mouse/"
|
|
# or "//HostName/LMachine/System/DISK/".
|
|
|
|
# Get name of machine where key is from:
|
|
$mach= $key->Machine;
|
|
# Will usually be "" indicating key is on local machine.
|
|
|
|
# Control different options (see main documentation for descriptions):
|
|
$oldBool= $key->ArrayValues( $newBool );
|
|
$oldBool= $key->FastDelete( $newBool );
|
|
$oldBool= $key->FixSzNulls( $newBool );
|
|
$oldBool= $key->SplitMultis( $newBool );
|
|
$oldBool= $key->DWordsToHex( $newBool );
|
|
$oldBool= $key->DualBinVals( $newBool );
|
|
$oldBool= $key->DualTypes( $newBool );
|
|
@oldBools= $key->SetOptions( ArrayValues=>1, FastDelete=>1, FixSzNulls=>0,
|
|
Delimiter=>"/", AllowLoad=>1, AllowSave=>1 );
|
|
@oldBools= $key->GetOptions( ArrayValues, FastDelete, FixSzNulls );
|
|
|
|
# Add or set a value:
|
|
$key->SetValue( "ValueName", $valueDataString );
|
|
$key->SetValue( "ValueName", pack($format,$valueData), "REG_BINARY" );
|
|
|
|
# Add or set a key:
|
|
$key->CreateKey( "SubKeyName" );
|
|
$key->CreateKey( "SubKeyName",
|
|
{ Access=>"KEY_ALL_ACCESS", Class=>"ClassName",
|
|
Delimiter=>"/", Volatile=>1, Backup=>1 } );
|
|
|
|
# Load an off-line Registry hive file into the on-line Registry:
|
|
$newKey= $Registry->Load( "C:/Path/To/Hive/FileName" );
|
|
$newKey= $key->Load( "C:/Path/To/Hive/FileName", "NewSubKeyName",
|
|
{ Access=>KEY_READ } );
|
|
# Unload a Registry hive file loaded via the Load() method:
|
|
$newKey->UnLoad;
|
|
|
|
# (Dis)Allow yourself to load Registry hive files:
|
|
$success= $Registry->AllowLoad( $bool );
|
|
|
|
# (Dis)Allow yourself to save a Registry key to a hive file:
|
|
$success= $Registry->AllowSave( $bool );
|
|
|
|
# Save a Registry key to a new hive file:
|
|
$key->RegSaveKey( "C:/Path/To/Hive/FileName", [] );
|
|
|
|
=head3 Other Useful Methods
|
|
|
|
See C<Win32API::Registry> for more information on these methods.
|
|
These methods are provided for coding convenience and are
|
|
identical to the C<Win32API::Registry> functions except that these
|
|
don't take a handle to a Registry key, instead getting the handle
|
|
from the invoking object [C<$key>].
|
|
|
|
$key->RegGetKeySecurity( $iSecInfo, $sSecDesc, $lenSecDesc );
|
|
$key->RegLoadKey( $sSubKeyName, $sPathToFile );
|
|
$key->RegNotifyChangeKeyValue(
|
|
$bWatchSubtree, $iNotifyFilter, $hEvent, $bAsync );
|
|
$key->RegQueryMultipleValues(
|
|
$structValueEnts, $cntValueEnts, $Buffer, $lenBuffer );
|
|
$key->RegReplaceKey( $sSubKeyName, $sPathToNewFile, $sPathToBackupFile );
|
|
$key->RegRestoreKey( $sPathToFile, $iFlags );
|
|
$key->RegSetKeySecurity( $iSecInfo, $sSecDesc );
|
|
$key->RegUnLoadKey( $sSubKeyName );
|
|
|
|
=head2 Tied Hashes Summary
|
|
|
|
For fast learners, this may be the only section you need to read.
|
|
Always append one delimiter to the end of each Registry key name
|
|
and prepend one delimiter to the front of each Registry value name.
|
|
|
|
=head3 Opening keys
|
|
|
|
use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>1 );
|
|
$Registry->Delimiter("/"); # Set delimiter to "/".
|
|
$swKey= $Registry->{"LMachine/Software/"};
|
|
$winKey= $swKey->{"Microsoft/Windows/CurrentVersion/"};
|
|
$userKey= $Registry->
|
|
{"CUser/Software/Microsoft/Windows/CurrentVersion/"};
|
|
$remoteKey= $Registry->{"//HostName/LMachine/"};
|
|
|
|
=head3 Reading values
|
|
|
|
$progDir= $winKey->{"/ProgramFilesDir"}; # "C:\\Program Files"
|
|
$tip21= $winKey->{"Explorer/Tips//21"}; # Text of tip #21.
|
|
|
|
$winKey->ArrayValues(1);
|
|
( $devPath, $type )= $winKey->{"/DevicePath"};
|
|
# $devPath eq "%SystemRoot%\\inf"
|
|
# $type eq "REG_EXPAND_SZ" [if you have SetDualVar.pm installed]
|
|
# $type == REG_EXPAND_SZ [if you did "use Win32API::Registry qw(REG_)"]
|
|
|
|
=head3 Setting values
|
|
|
|
$winKey->{"Setup//SourcePath"}= "\\\\SwServer\\SwShare\\Windows";
|
|
# Simple. Assumes data type of REG_SZ.
|
|
|
|
$winKey->{"Setup//Installation Sources"}=
|
|
[ "D:\x00\\\\SwServer\\SwShare\\Windows\0\0", "REG_MULTI_SZ" ];
|
|
# "\x00" and "\0" used to mark ends of each string and end of list.
|
|
|
|
$winKey->{"Setup//Installation Sources"}=
|
|
[ ["D:","\\\\SwServer\\SwShare\\Windows"], "REG_MULTI_SZ" ];
|
|
# Alternate method that is easier to read.
|
|
|
|
$userKey->{"Explorer/Tips//DisplayInitialTipWindow"}=
|
|
[ pack("L",0), "REG_DWORD" ];
|
|
$userKey->{"Explorer/Tips//Next"}= [ pack("S",3), "REG_BINARY" ];
|
|
$userKey->{"Explorer/Tips//Show"}= [ pack("L",0), "REG_BINARY" ];
|
|
|
|
=head3 Adding keys
|
|
|
|
$swKey->{"FooCorp/"}= {
|
|
"FooWriter/" => {
|
|
"/Version" => "4.032",
|
|
"Startup/" => {
|
|
"/Title" => "Foo Writer Deluxe ][",
|
|
"/WindowSize" => [ pack("LL",$wid,$ht), REG_BINARY ],
|
|
"/TaskBarIcon" => [ "0x0001", REG_DWORD ],
|
|
},
|
|
"Compatibility/" => {
|
|
"/AutoConvert" => "Always",
|
|
"/Default Palette" => "Windows Colors",
|
|
},
|
|
},
|
|
"/License", => "0123-9C8EF1-09-FC",
|
|
};
|
|
|
|
=head3 Listing all subkeys and values
|
|
|
|
@members= keys( %{$swKey} );
|
|
@subKeys= grep( m#^/#, keys( %{$swKey->{"Classes/batfile/"}} ) );
|
|
# @subKeys= ( "/", "/EditFlags" );
|
|
@valueNames= grep( ! m#^/#, keys( %{$swKey->{"Classes/batfile/"}} ) );
|
|
# @valueNames= ( "DefaultIcon/", "shell/", "shellex/" );
|
|
|
|
=head3 Deleting values or keys with no subkeys
|
|
|
|
$oldValue= delete $userKey->{"Explorer/Tips//Next"};
|
|
|
|
$oldValues= delete $userKey->{"Explorer/Tips/"};
|
|
# $oldValues will be reference to hash containing deleted keys values.
|
|
|
|
=head3 Closing keys
|
|
|
|
undef $swKey; # Explicit way to close a key.
|
|
$winKey= "Anything else"; # Implicitly closes a key.
|
|
exit 0; # Implicitly closes all keys.
|
|
|
|
=head2 Tie::Registry
|
|
|
|
This module was originally called C<Tie::Registry>. Changing code
|
|
that used C<Tie::Registry> over to C<Win32::TieRegistry> is trivial
|
|
as the module name should only be mentioned once, in the C<use>
|
|
line. However, finding all of the places that used C<Tie::Registry>
|
|
may not be completely trivial so we have included F<Tie/Registry.pm>
|
|
which you can install to provide backward compatibility.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Tye McQueen, tye@metronet.com, see http://www.metronet.com/~tye/.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
C<Win32API::Registry> - Provides access to Reg*(), HKEY_*,
|
|
KEY_*, REG_* [required].
|
|
|
|
C<Win32::WinError> - Defines ERROR_* values [optional].
|
|
|
|
C<SetDualVar> - For returning REG_* values as combined
|
|
string/integer [optional].
|
|
|
|
=head1 BUGS
|
|
|
|
Because I<Win32::TieRegistry> requires C<Win32API::Registry>
|
|
which uses the standard Perl tools for building extensions,
|
|
L<MakeMaker>, and these are not supported with the ActiveWare
|
|
versions of Perl, I<Win32::TieRegistry> cannot be used with the
|
|
ActiveWare versions of Perl. Sorry. The ActiveWare version and
|
|
standard version of Perl are merging so you may want to switch to
|
|
the standard version of Perl soon.
|
|
|
|
Because Perl hashes are case sensitive, certain lookups are also
|
|
case sensistive. In particular, the root keys ("Classes", "CUser",
|
|
"LMachine", "Users", "PerfData", "CConfig", "DynData", and HKEY_*)
|
|
must always be entered without changing between upper and lower
|
|
case letters. Also, the special rule for matching subkey names
|
|
that contain the user-selected delimiter only works if case is
|
|
matched. All other key name and value name lookups should be case
|
|
insensitive because the underlying Reg*() calls ignore case.
|
|
|
|
Perl5.004_02 has bugs that make Win32::TieRegistry fail in strange
|
|
and subtle ways.
|
|
|
|
Information about each key is cached when using a tied hash. A
|
|
future release should use C<RegNotifyChangeKeyValue()> to prevent
|
|
this cache from becoming out-of-date.
|
|
|
|
There is no test suite.
|
|
|
|
=cut
|
|
|
|
# Autoload not currently supported by Perl under Windows.
|