home *** CD-ROM | disk | FTP | other *** search
/ c't freeware shareware 1997 / CT_SW_97.ISO / mac / Software / entwickl / win95 / pw32i306.exe / lib / Win32 / registry.pm < prev    next >
Text File  |  1997-03-04  |  10KB  |  487 lines
  1. package Win32::Registry;
  2. #######################################################################
  3. #Perl Module for Registry Extensions
  4. # This module creates an object oriented interface to the Win32
  5. # Registry.
  6. #
  7. # NOTE: This package exports four instantiated keys to
  8. # the main:: name space.  ( The pre-defined keys )
  9. # these keys:
  10. # $main::CLASSES_ROOT
  11. # $main::CURRENT_USER
  12. # $main::LOCAL_MACHINE
  13. # $main::USERS
  14. #
  15. #######################################################################
  16.  
  17. require Exporter;       #to export the constants to the main:: space
  18. require DynaLoader;     # to dynuhlode the module.
  19. use Win32::WinError;         # for windows constants.
  20.  
  21.  
  22. @ISA= qw( Exporter DynaLoader );
  23. @EXPORT = qw(
  24.     HKEY_CLASSES_ROOT
  25.     HKEY_CURRENT_USER
  26.     HKEY_LOCAL_MACHINE
  27.     HKEY_PERFORMANCE_DATA
  28.     HKEY_PERFORMANCE_NLSTEXT
  29.     HKEY_PERFORMANCE_TEXT
  30.     HKEY_USERS
  31.     KEY_ALL_ACCESS
  32.     KEY_CREATE_LINK
  33.     KEY_CREATE_SUB_KEY
  34.     KEY_ENUMERATE_SUB_KEYS
  35.     KEY_EXECUTE
  36.     KEY_NOTIFY
  37.     KEY_QUERY_VALUE
  38.     KEY_READ
  39.     KEY_SET_VALUE
  40.     KEY_WRITE
  41.     REG_BINARY
  42.     REG_CREATED_NEW_KEY
  43.     REG_DWORD
  44.     REG_DWORD_BIG_ENDIAN
  45.     REG_DWORD_LITTLE_ENDIAN
  46.     REG_EXPAND_SZ
  47.     REG_FULL_RESOURCE_DESCRIPTOR
  48.     REG_LEGAL_CHANGE_FILTER
  49.     REG_LEGAL_OPTION
  50.     REG_LINK
  51.     REG_MULTI_SZ
  52.     REG_NONE
  53.     REG_NOTIFY_CHANGE_ATTRIBUTES
  54.     REG_NOTIFY_CHANGE_LAST_SET
  55.     REG_NOTIFY_CHANGE_NAME
  56.     REG_NOTIFY_CHANGE_SECURITY
  57.     REG_OPENED_EXISTING_KEY
  58.     REG_OPTION_BACKUP_RESTORE
  59.     REG_OPTION_CREATE_LINK
  60.     REG_OPTION_NON_VOLATILE
  61.     REG_OPTION_RESERVED
  62.     REG_OPTION_VOLATILE
  63.     REG_REFRESH_HIVE
  64.     REG_RESOURCE_LIST
  65.     REG_RESOURCE_REQUIREMENTS_LIST
  66.     REG_SZ
  67.     REG_WHOLE_HIVE_VOLATILE
  68. );
  69.  
  70. #######################################################################
  71. # This AUTOLOAD is used to 'autoload' constants from the constant()
  72. # XS function.  If a constant is not found then control is passed
  73. # to the AUTOLOAD in AutoLoader.
  74.  
  75. sub AUTOLOAD {
  76.     my($constname);
  77.     ($constname = $AUTOLOAD) =~ s/.*:://;
  78.     #reset $! to zero to reset any current errors.
  79.     $!=0;
  80.     my $val = constant($constname, @_ ? $_[0] : 0);
  81.     if ($! != 0) {
  82.     if ($! =~ /Invalid/) {
  83.         $AutoLoader::AUTOLOAD = $AUTOLOAD;
  84.         goto &AutoLoader::AUTOLOAD;
  85.     }
  86.     else {
  87.         ($pack,$file,$line) = caller;
  88.         die "Your vendor has not defined Win32::Registry macro $constname, used at $file line $line.";
  89.     }
  90.     }
  91.     eval "sub $AUTOLOAD { $val }";
  92.     goto &$AUTOLOAD;
  93. }
  94.  
  95. #######################################################################
  96. # _new is a private constructor, not intended for public use.
  97. #
  98.  
  99. sub show_me
  100. {
  101.     $self=shift;
  102.     print $self->{'handle'};
  103. }
  104.  
  105. sub _new
  106. {
  107.     my $self={};
  108.     if ($_[0]){
  109.         $self->{'handle'} = $_[0];
  110.         bless $self
  111.         }
  112.     else{
  113.             undef($self);
  114.     }
  115.     $self;
  116. }
  117.  
  118. #define the basic registry objects to be exported.
  119. #these had to be hardwired unfortunately.
  120.  
  121.  
  122. $main::HKEY_CLASSES_ROOT = _new(0x80000000);
  123. $main::HKEY_CURRENT_USER = _new(0x80000001);
  124. $main::HKEY_LOCAL_MACHINE = _new(0x80000002);
  125. $main::HKEY_USERS = _new(0x80000003);
  126. $main::HKEY_PERFORMANCE_DATA = _new(0x80000004 );
  127. $main::HKEY_PERFORMANCE_TEXT =_new(0x80000050 );
  128. $main::HKEY_PERFORMANCE_NLSTEXT =_new(0x80000060 );
  129.  
  130.  
  131.  
  132.  
  133.  
  134. #######################################################################
  135. #Open: creates a new Registry object from an existing one.
  136. # usage: $RegObj->Open( "SubKey",$SubKeyObj );
  137. #               $SubKeyObj->Open( "SubberKey", *SubberKeyObj );
  138.  
  139. sub Open
  140. {
  141.     my $self = shift;
  142.     
  143.     if( $#_ != 1 ){
  144.         die 'usage: Open( $SubKey, $ObjRef )';
  145.     }
  146.     
  147.     ($SubKey) = @_;
  148.     local ($Result,$SubHandle);
  149.  
  150.     $Result = RegOpenKey($self->{'handle'},$SubKey,$SubHandle);
  151.     $_[1] = _new( $SubHandle );
  152.     
  153.     if (!$_[1] ){
  154.         return 0;
  155.     }
  156.  
  157.      if(!$Result){
  158.         $! = Win32::GetLastError();
  159.     }
  160.  
  161.     # return a boolean value
  162.     return($Result);
  163.  
  164. }
  165.  
  166. #######################################################################
  167. #Close
  168. # close an open registry key.
  169. #
  170. sub Close
  171. {
  172.     my $self = shift;
  173.     
  174.     if( $#_ != -1 ){
  175.         die "usage: Close()";
  176.     }
  177.  
  178.     $Result = RegCloseKey( $self->{'handle'});
  179.     undef($self);
  180.  
  181.     if(!$Result){
  182.         $! = Win32::GetLastError();
  183.     }
  184.  
  185.     return($Result);
  186. }
  187.  
  188.  
  189. #######################################################################
  190. #Create
  191. # open a subkey.  If it doesn't exist, create it.
  192. #
  193.  
  194. sub Create
  195. {
  196.     my $self = shift;
  197.  
  198.     if($#_ != 1 ){
  199.         die 'usage: Create( $SubKey,$ScalarRef )';
  200.     }
  201.  
  202.     ($SubKey) = @_;
  203.     local ($Result,$SubHandle);
  204.  
  205.     #call the API, and create the object.
  206.     $Result = RegCreateKey($self->{'handle'},$SubKey,$SubHandle);
  207.     $_[1] = _new ( $SubHandle );
  208.     if (!$_[1]){
  209.         return(0);
  210.     }
  211.     #error checking
  212.  
  213.      if(!$Result){
  214.         $! = Win32::GetLastError();
  215.     }
  216.  
  217.     return($Result);
  218.  
  219. }
  220.  
  221. #######################################################################
  222. #SetValue
  223. # SetValue sets a value in the current key.
  224. #
  225.  
  226. sub SetValue
  227. {
  228.     my $self = shift;
  229.     if($#_ != 2 ){
  230.         die 'usage: SetValue($SubKey,$Type,$value )';
  231.     }
  232.  
  233.     local($SubKey,$type,$value) = @_;
  234.  
  235.     # set the value.
  236.     $Result = RegSetValue( $self->{'handle'},$SubKey,$type,$value);
  237.     
  238.      if(!$Result){
  239.         $! = Win32::GetLastError();
  240.     }
  241.  
  242.     return($Result);
  243.  
  244. }
  245.  
  246. sub SetValueEx
  247. {
  248.     my $self = shift;
  249.     if($#_ != 3){
  250.         die 'usage: SetValueEx( $SubKey,$Reserved,$type,$value )';
  251.     }
  252.  
  253.     local( $SubKey,$Reserved,$type,$value) =@_;
  254.  
  255.     $Result = RegSetValueEx( $self->{'handle'},$SubKey,$Reserved,$type,$value);
  256.     
  257.     if(!$Result){
  258.         $! = Win32::GetLastError();
  259.     }
  260.  
  261.     return($Result);
  262. }
  263.  
  264. #######################################################################
  265. #QueryValue  and QueryKey
  266. # QueryValue gets information on a value in the current key.
  267. # QueryKey "    "       "       "  key  "       "       "       
  268.  
  269. sub QueryValue
  270. {
  271.     my $self = shift;
  272.  
  273.     if($#_ != 1 ){
  274.         die 'usage: QueryValue( $SubKey,$valueref )';
  275.     }
  276.  
  277.     #Query the value.
  278.     $Result = RegQueryValue( $self->{'handle'}, $_[0], $_[1]);
  279.  
  280.     #check the results.
  281.  
  282.      if(!$Result){
  283.         $! = Win32::GetLastError();
  284.     }
  285.  
  286.     return($Result);
  287. }
  288.  
  289. sub QueryKey
  290. {
  291.     my $garbage;
  292.     my $self = shift;
  293.  
  294.     if($#_ != 2 ){
  295.         die 'usage: QueryKey( $classref, $numberofSubkeys, $numberofVals )';
  296.     }
  297.  
  298.     local ($Result);
  299.  
  300.     $Result = RegQueryInfoKey( $self->{'handle'}, $_[0], $garbage, $_[1],
  301.                    $garbage, $garbage, $_[2],
  302.                    $garbage, $garbage, $garbage, $garbage);
  303.  
  304.  
  305.      if(!$Result){
  306.         $! = Win32::GetLastError();
  307.     }
  308.     return($Result);
  309. }
  310.  
  311. #######################################################################
  312. #GetKeys
  313. #Note: the list object must be passed by reference: 
  314. #       $myobj->GetKeys( \@mylist )
  315. sub GetKeys
  316. {
  317.     my $self = shift;
  318.     if($#_ != 0 ){
  319.         die 'usage: GetKeys( $arrayref )';
  320.     }
  321.  
  322.     if (ref $_[0] ne ARRAY){
  323.         die "GetKeys requires a list reference as an arguement";
  324.     }
  325.  
  326.     local ($Result,$ValueName,$i,$keyname);
  327.  
  328.     $ValueName="DummyVal";$i=0;
  329.     $Result = 1;
  330.     
  331.     while( $Result ){
  332.         $Result = RegEnumKey( $self->{'handle'},$i++, $keyname );
  333.         if ($Result){
  334.             push( @{$_[0]}, $keyname );
  335.         }
  336.     }
  337.     return(1);
  338.  
  339. }
  340. #######################################################################
  341. #GetValues
  342. # GetValues creates a hash containing 'name'=> ( name,type,data )
  343. # for each value in the current key.
  344.  
  345. sub GetValues
  346. {
  347.     my $self = shift;
  348.  
  349.     if($#_ != 0 ){
  350.         die 'usage: GetValues( $hashref )';
  351.     }
  352.  
  353.     local ($Result,$ValueName,$i);
  354.  
  355.     $ValueName="DummyVal";$i=0;
  356.     while( $Result=RegEnumValue( $self->{'handle'},
  357.                     $i++,
  358.                     $ValueName,
  359.                     NULL,
  360.                     $ValueType,
  361.                     $ValueData )){
  362.  
  363.         $aref = [ $ValueName, $ValueType,$ValueData ];
  364.  
  365.         $_[0]->{$ValueName} = $aref;
  366.     }
  367.         
  368.     return(1);
  369. }
  370.  
  371. #######################################################################
  372. #DeleteKey
  373. # delete a key from the registry.
  374. #  eg: $CLASSES_ROOT->DeleteKey( "KeyNameToDelete");
  375. #
  376.  
  377. sub DeleteKey
  378. {
  379.     my $self = shift;
  380.     local($Result);
  381.     if($#_ != 0 ){
  382.         die 'usage: DeleteKey( $SubKey )';
  383.     }
  384.  
  385.     local( $name ) = @_;
  386.  
  387.     $Result=RegDeleteKey($self->{'handle'},$name);
  388.  
  389.      if(!$Result){
  390.         $! = Win32::GetLastError();
  391.     }
  392.     return($Result);
  393.  
  394. }
  395. #######################################################################
  396. #DeleteValue
  397. # delete a value from the current key in the registry
  398. #  $CLASSES_ROOT->DeleteValue( "\000" );
  399.  
  400. sub DeleteValue
  401. {
  402.     my $self = shift;
  403.     local( $Result );
  404.  
  405.     if($#_ != 0 ){
  406.         die 'usage: DeleteValue( $SubKey )';
  407.     }
  408.  
  409.     local( $name )=@_;
  410.     
  411.     $Result=RegDeleteValue( $self->{'handle'},$name);
  412.     
  413.     if( !$Result){
  414.         $!=Win32::GetLastError();
  415.     }
  416.  
  417.     return($Result);
  418.  
  419. }
  420.  
  421. #######################################################################
  422. #save
  423. #saves the current hive to a file.
  424. #
  425.  
  426. sub Save
  427. {
  428.     my $self=shift;
  429.  
  430.     if($#_ != 0 ){
  431.         die 'usage: Save( $FileName )';
  432.     }
  433.  
  434.     local( $FileName ) = @_;
  435.  
  436.     $Result=RegSaveKey( $self->{'handle'},$FileName );
  437.  
  438.     if( !$Result){
  439.         $!=Win32::GetLastError();
  440.     }
  441.  
  442.     return($Result);
  443. }
  444.  
  445. #######################################################################
  446. #Load
  447. #loads a saved key from a file.
  448.  
  449. sub Load
  450. {
  451.     my $self = shift;
  452.     if($#_ != 1 ){
  453.         die 'usage: Load( $SubKey,$FileName )';
  454.     }
  455.  
  456.     local( $SubKey,$FileName) = @_;
  457.  
  458.     $Result=RegLoadKey( $self->{'handle'},$SubKey,$FileName);
  459.  
  460.     if( !$Result){
  461.         $!=Win32::GetLastError();
  462.     }
  463.  
  464.     return($Result);
  465. }
  466. #######################################################################
  467. # dynamically load in the Registry.pll module.
  468.  
  469.  
  470. bootstrap Win32::Registry;
  471.  
  472. # Preloaded methods go here.
  473.  
  474. #Currently Autoloading is not implemented in Perl for win32
  475. # Autoload methods go after __END__, and are processed by the autosplit program.
  476.  
  477. 1;
  478. __END__
  479.  
  480.  
  481.  
  482.  
  483.  
  484.     
  485.  
  486.     
  487.