home *** CD-ROM | disk | FTP | other *** search
/ Borland Programmer's Resource / Borland_Programmers_Resource_CD_1995.iso / ntcode / ntperlb / t / nt / registry.nt next >
Encoding:
Text File  |  1995-05-19  |  3.3 KB  |  169 lines
  1. print "1..14\n";
  2.  
  3. unshift(@INC, "d:\\perl-4.036\\lib");
  4.  
  5. require "registry.pl";
  6.  
  7. #
  8. # test the NT Registry access functions
  9. #
  10.  
  11. # create a key
  12.  
  13. $subkey_string = "SOFTWARE\\Intergraph\\PerlTest";
  14.  
  15. if (&RegOpenKeyEx ($HKEY_LOCAL_MACHINE, $subkey_string, 0, 
  16.            $KEY_ALL_ACCESS, $key)) {
  17.     &DeleteAllKeys($key);
  18.     &RegCloseKey($key);
  19.     &RegDeleteKey($HKEY_LOCAL_MACHINE, $subkey_string) ||
  20.     die "Can't delete $subkey_string: $!\n";
  21. }
  22.  
  23. $return = &RegCreateKeyEx($HKEY_LOCAL_MACHINE, $subkey_string, 0, "testclass", 
  24.               $REG_OPTION_NON_VOLATILE, $KEY_ALL_ACCESS, 0, $key, 
  25.               $disposition);
  26. if ($return != 1) {
  27.     print "not ok 1 # $!\n";
  28.     exit(0);
  29. }
  30. print "ok 1\n";
  31.  
  32. # set a value
  33.  
  34. $return = &RegSetValueEx ($key, "Test1", 0, $REG_SZ, "foobar");
  35. if ($return != 1) {
  36.     print "not ok 2\n";
  37.     exit(0);
  38. }
  39. print "ok 2\n";
  40.  
  41. $return = &RegCloseKey ($key);
  42. if ($return != 1) {
  43.     print "not ok 3\n";
  44.     exit(0);
  45. }
  46. print "ok 3\n";
  47.  
  48. $return = &RegOpenKey($HKEY_LOCAL_MACHINE, $subkey_string, $key);
  49. if ($return != 1) {
  50.     print "not ok 4\n";
  51.     exit(0);
  52. }
  53. print "ok 4\n";
  54.  
  55. $return = &RegQueryValue ($key, "Test1", $val);
  56. if ($return != 1) {
  57.     print "not ok 5\n";
  58.     exit(0);
  59. }
  60. print "ok 5\n";
  61.  
  62. $return = &RegSaveKey($key, "save.$$");
  63. # check for privledge violation
  64. if ($return != 0 && $! != 1314) {
  65.     print "not ok 6\n";
  66.     exit(0);
  67. }
  68. print "ok 6\n";
  69.  
  70. unlink "save.$$" if -e "save.$$";
  71.  
  72. &RegCloseKey($key);
  73.     
  74. if ($val eq "foobar") {
  75.     print "ok 7\n";
  76. } 
  77. else {
  78.     print "not ok 7\n";
  79. }
  80.  
  81. $return = &RegCreateKey($HKEY_LOCAL_MACHINE, $subkey_string, $key);
  82. if ($return != 1) {
  83.     print "not ok 8\n";
  84.     exit(0);
  85. }
  86. print "ok 8\n";
  87.  
  88. $return = &RegDeleteKey($HKEY_LOCAL_MACHINE, $subkey_string);
  89. if ($return != 1) {
  90.     print "not ok 9\n";
  91.     exit(0);
  92. }
  93. print "ok 9\n";
  94.     
  95. #
  96. # shouldn't be able to open it now
  97. #
  98.  
  99. $return = &RegOpenKey($HKEY_LOCAL_MACHINE, 
  100.               "SOFTWARE\\Intergraph\\PerlTest", $key);
  101. if ($return == 0) {print "ok 10\n";} else {print "not ok 10\n";}
  102.  
  103.  
  104. #
  105. # Now make a  few keys and values, then test the enumerating functions
  106. #
  107.  
  108. $return = &RegCreateKey($HKEY_LOCAL_MACHINE, $subkey_string, $key);
  109. if ($return != 1) {
  110.     print "not ok 11\n";
  111.     exit(0);
  112. }
  113. print "ok 11\n";
  114.  
  115. $return = &RegCreateKey($key, "Key1", $nkey);
  116. if ($return != 1) {
  117.     print "not ok 12\n";
  118.     exit(0);
  119. }
  120. print "ok 12\n";
  121. &RegCloseKey($nkey);
  122.  
  123. $return = &RegCreateKey($key, "Key2", $nkey);
  124. if ($return != 1) {
  125.     print "not ok 13\n";
  126.     exit(0);
  127. }
  128. print "ok 13\n";
  129. &RegCloseKey($nkey);
  130.  
  131. $idx = 0;
  132. $cnt = 0;
  133.  
  134. while(&RegEnumKeyEx($key, $idx++, $name,0, $class, $time)) {
  135.     if ($name ne "Key$idx") {
  136.     print "not ok 14\n";
  137.     exit;
  138.     }
  139.     &RegDeleteKey($key, $name);
  140. }
  141. print "ok 14\n";
  142.  
  143. #
  144. # clean up
  145. #
  146.  
  147. &DeleteAllKeys($key);
  148. &RegCloseKey($key);
  149. &RegDeleteKey($HKEY_LOCAL_MACHINE, $subkey_string);
  150.  
  151. exit;
  152.  
  153. sub DeleteAllKeys {
  154.     local($key) = @_;
  155.     local($idx) = 0;
  156.     local($newkey, $name);
  157.  
  158.     $idx = 0;
  159.     while (&RegEnumKey($key, $idx++, $name)) {
  160.     &RegOpenKeyEx($key, $name, 0, $KEY_ALL_ACCESS, $newkey) ||
  161.         die "Can't open $name subkey: $!\n";
  162.     &DeleteAllKeys($newkey);
  163.     &RegCloseKey($newkey);
  164.     &RegDeleteKey($key, $name) ||
  165.         die "Can't delete key $name: $!\n";
  166.     }
  167. }
  168.     
  169.