?? tieregistry.pm
字號:
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__
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -