[已解决]perl 如何查询注册表某个键的内容

tnarp

写了一个perl查询注册表的例子，总是报错，请各位大侠赐教：
环境：win xp sp2   perl version： This is perl, v5.10.0 built for MSWin32-x86-multi-thread

#!C:\Perl\lib

use Win32::Registry;

$ORACLE_HOME=_queryreg("SOFTWARE\\ORACLE\\KEY_OraDb10g_home1","ORACLE_HOME");

print ("Info  checkVarAndLang,ORACLE_HOME=".$ORACLE_HOME);

$ORACLE_SID=_queryreg("SOFTWARE\\ORACLE\\KEY_OraDb10g_home1","ORACLE_SID");

print ("Info  checkVarAndLang,ORACLE_SID=".$ORACLE_SID);

$NLS_LANG=_queryreg("SOFTWARE\\ORACLE\\KEY_OraDb10g_home1","NLS_LANG");

print ("Info  checkVarAndLang, DB Client:NLS_LANG=".$NLS_LANG);

$ORACLE_BASE=_queryreg("SOFTWARE\\ORACLE\\KEY_OraDb10g_home1","ORACLE_BASE");

print ("Info  checkVarAndLang,ORACLE_BASE=".$ENV{ORACLE_BASE});

sub _queryreg($$)
{
        my ($Register)=shift;
        my ($subkey)=shift;
       
        print $Register."\n";
        print $subkey."\n";
       
        my $hkey,$value;
       
        $HKEY_LOCAL_MACHINE->Open($Register,$hkey)|| die $!;
        $hkey->QueryValueEx($subkey,NULL,$value);
        print "the $subkey value is : ";
        if ($value eq '')
        {
                print "undefined\n";
        }
        else
        {
                print "$value\n";
        }
        $hkey->Close();
        return $value;
}

报错：

C:\>perl testRegister.pl
SOFTWARE\ORACLE\KEY_OraDb10g_home1
ORACLE_HOME
Modification of a read-only value attempted at C:\Perl\lib/Win32/Registry.pm line 401.

Registry.pm line 401

sub QueryValueEx {
    my $self = shift;
    die 'usage: $obj->QueryValueEx($value_name, $type, $value)' if @_ != 3;
    my $result = RegQueryValueEx($self->{'handle'}, $_[0], undef, $_[1], $_[2]);     # line 401
    $! = Win32::GetLastError() unless $result;
    return $result;
}

各位大侠，看看那里有问题？


今天仔细看了Win32::Registry的脚本，忽然想到了解决方法：
下面是已经修改正确的代码：

#!C:\Perl\lib

#use Win32::Registry;
use POSIX;
use Sys::Hostname;

#判断操作系统
($sysname)=uname();
#print $sysname;

if($sysname=~/^\s*windows\s*/i)
{
        eval "use Win32API::File qw(:ALL);";
        eval "use Win32::Registry;";
}

$ORACLE_HOME=_queryreg("SOFTWARE\\ORACLE\\KEY_OraDb10g_home1","ORACLE_HOME");
print ("Info  checkVarAndLang,ORACLE_HOME=".$ORACLE_HOME."\n");

$ORACLE_SID=_queryreg("SOFTWARE\\ORACLE\\KEY_OraDb10g_home1","ORACLE_SID");
print ("Info  checkVarAndLang,ORACLE_SID=".$ORACLE_SID."\n");

$NLS_LANG=_queryreg("SOFTWARE\\ORACLE\\KEY_OraDb10g_home1","NLS_LANG");
print ("Info  checkVarAndLang, DB Client:NLS_LANG=".$NLS_LANG."\n");

$ORACLE_BASE=_queryreg("SOFTWARE\\ORACLE\\KEY_OraDb10g_home1","ORACLE_BASE");
print ("Info  checkVarAndLang,ORACLE_BASE=".$ORACLE_BASE."\n");

sub _queryreg()
{
        my ($Register,$subkey)=@_;
       
        #print $Register."\n";
        #print $subkey."\n";
       
        my $hkey;
        $HKEY_LOCAL_MACHINE->Open($Register, $hkey) or die "Can't open tips: $^E";
       
        my ($type, $value);
        $hkey->QueryValueEx($subkey, $type, $value) or die "No tip #$subkey: $^E";
       
        print "the $subkey value is : ";
        if ($value eq '')
        {
                print "undefined\n";
        }
        else
        {
                print "$value\n";
        }
        $hkey->Close();
        return $value;
}

[ 本帖最后由 tnarp 于 2009-6-12 11:40 编辑 ]