home *** CD-ROM | disk | FTP | other *** search
/ Softwarová Záchrana 3 / Softwarova-zachrana-3.bin / StartRight / source.zip / UnitMyRegistry.pas < prev    next >
Pascal/Delphi Source File  |  2004-09-30  |  9KB  |  330 lines
  1. unit UnitMyRegistry;
  2. {
  3.     Purpose:
  4.         Remove the default behavoir of ReadKeyReadOnly making the Registry
  5.         change to readonly access - no matter the style or OpenKey used.
  6. }
  7.  
  8. interface
  9. uses Registry, Windows, Classes;
  10.  
  11. type TMyRegistry = class(TRegistry)
  12. public
  13.     procedure CloseKey;
  14.  
  15.     function ReadString(value, default : string) : string; overload;
  16.     function ReadBool(value : string; default : boolean) : boolean; overload;
  17.     function ReadInteger(value : string; default : Integer) : integer; overload;
  18.  
  19.     function ValueExistsString(key : string; value : string; var data : string) : boolean;
  20.     function ValueExistsInteger(key : string; value : string; var data : integer) : boolean;
  21.  
  22.     procedure EraseKey(HKEYVal : HKEY; basekey : string; key : string); overload;
  23.     procedure EraseKey(basekey : string; key : string); overload;
  24.  
  25.     procedure GetValues(
  26.         HKEYVal : HKEY; key : string; var names : TStringList); overload;
  27.     procedure GetValues(key : string; var names : TStringList); overload;
  28.  
  29.     procedure SetDataString(
  30.         HKEYVal : HKEY; key : string;
  31.         value : string; data : string;
  32.         canCreate : boolean = true);  overload;
  33.     procedure SetDataString(
  34.         key : string;
  35.         value : string; data : string;
  36.         canCreate : boolean = true);  overload;
  37.  
  38.     procedure SetDataInteger(
  39.         HKEYVal : HKEY; key : string;
  40.         value : string; data : integer;
  41.         canCreate : boolean = true);  overload;
  42.     procedure SetDataInteger(
  43.         key : string;
  44.         value : string; data : integer;
  45.         canCreate : boolean = true);  overload;
  46.  
  47.  
  48.     function GetDataString(
  49.         HKEYVal : HKEY; key : string;
  50.         value : string) : string; overload;
  51.     function GetDataString(
  52.         key : string;
  53.         value : string) : string; overload;
  54.     function GetDataString(
  55.         HKEYVal : HKEY; key : string;
  56.         value : string; data : string) : string; overload;
  57.  
  58.  
  59.     function GetDataInteger(
  60.         HKEYVal : HKEY; key : string;
  61.         value : string) : integer; overload;
  62.     function GetDataInteger(
  63.         key : string;
  64.         value : string) : integer; overload;
  65.     function GetDataInteger(
  66.         HKEYVal : HKEY; key : string;
  67.         value : string; data : integer) : integer; overload;
  68.  
  69.     function DeleteDataString(
  70.         HKEYVal : HKEY; key : string;
  71.         value : string) : string; overload;
  72.     function DeleteDataString(
  73.         key : string;
  74.         value : string) : string; overload;
  75.  
  76. end;
  77.  
  78. implementation
  79.  
  80. { TMyRegistry }
  81. uses SysUtils;
  82.  
  83. procedure TMyRegistry.SetDataString(
  84.     HKEYVal : HKEY; key : string;
  85.     value : string; data : string;
  86.     canCreate : boolean = true);
  87. begin
  88.  
  89.     self.RootKey := HKEYVal;
  90.     if self.OpenKey(key, canCreate) then begin
  91.         try
  92.             self.WriteString(value, data);
  93.             self.CloseKey;
  94.         except on e : Exception do
  95.             begin
  96.                 self.CloseKey;
  97.                 raise Exception.Create(e.Message);
  98.             end;
  99.         end;
  100.     end else begin
  101.         raise Exception.Create('Unable to open : ' + key);
  102.     end;
  103. end;
  104.  
  105. procedure TMyRegistry.SetDataString(
  106.     key : string;
  107.     value : string; data : string;
  108.     canCreate : boolean = true);
  109. begin
  110.     SetDataString(HKEY_LOCAL_MACHINE, key, value, data, CanCreate);
  111. end;
  112.  
  113. procedure TMyRegistry.SetDataInteger(HKEYVal: HKEY; key, value: string;
  114.   data: integer; canCreate: boolean);
  115. begin
  116.     self.RootKey := HKEYVal;
  117.     if self.OpenKey(key, canCreate) then begin
  118.         self.WriteInteger(value, data);
  119.         self.CloseKey;
  120.     end;
  121.  
  122. end;
  123.  
  124. procedure TMyRegistry.SetDataInteger(key, value: string; data: integer;
  125.   canCreate: boolean);
  126. begin
  127.     SetDataInteger(HKEY_LOCAL_MACHINE, key, value, data, CanCreate);
  128. end;
  129.  
  130. function TMyRegistry.GetDataString(
  131.     HKEYVal : HKEY; key : string;
  132.     value : string) : string;
  133. begin
  134.     result := '';
  135.     self.RootKey := HKEYVal;
  136.     if self.OpenKeyReadOnly(key) then begin
  137.         try
  138.             if self.ValueExists(value) then begin
  139.                 result := self.ReadString(value);
  140.             end;
  141.         finally
  142.             self.CloseKey;
  143.         end;
  144.     end;
  145. end;
  146.  
  147. function TMyRegistry.GetDataString(
  148.     key : string;
  149.     value : string) : string;
  150. begin
  151.     result := GetDataString(HKEY_LOCAL_MACHINE, key, value);
  152. end;
  153.  
  154.  
  155. function TMyRegistry.GetDataString(
  156.     HKEYVal : HKEY; key : string;
  157.     value : string; data : string) : string;
  158. begin
  159.     self.RootKey := HKEYVal;
  160.     if self.OpenKey(key, true) then begin
  161.         result := self.ReadString(value, data);
  162.         self.CloseKey;
  163.     end;
  164. end;
  165.  
  166.  
  167. function TMyRegistry.DeleteDataString(
  168.     HKEYVal : HKEY; key : string;
  169.     value : string) : string;
  170. begin
  171.     result := '';
  172.     self.RootKey := HKEYVal;
  173.     if self.OpenKey(key, false) then begin
  174.         if self.ValueExists(value) then begin
  175.             result := self.ReadString(value);
  176.             self.DeleteValue(value);
  177.         end;
  178.         self.CloseKey;
  179.     end;
  180. end;
  181.  
  182.  
  183. function TMyRegistry.DeleteDataString(
  184.     key : string;
  185.     value : string) : string;
  186. begin
  187.     result := DeleteDataString(HKEY_LOCAL_MACHINE, key, value);
  188. end;
  189.  
  190.  
  191. function TMyRegistry.GetDataInteger(HKEYVal: HKEY; key,
  192.   value: string): integer;
  193. begin
  194.     result := -1;
  195.     self.RootKey := HKEYVal;
  196.     if self.OpenKey(key, true) then begin
  197.         if self.ValueExists(value) then begin
  198.             result := self.ReadInteger(value);
  199.         end;
  200.         self.CloseKey;
  201.     end;
  202. end;
  203.  
  204. function TMyRegistry.GetDataInteger(key, value: string): integer;
  205. begin
  206.     result := GetDataInteger(HKEY_LOCAL_MACHINE, key, value);
  207. end;
  208.  
  209. function TMyRegistry.GetDataInteger(HKEYVal: HKEY; key, value: string;
  210.   data: integer): integer;
  211. begin
  212.     result := -1;
  213.     self.RootKey := HKEYVal;
  214.     if self.OpenKey(key, true) then begin
  215.         result := self.ReadInteger(value, data);
  216.         self.CloseKey;
  217.     end;
  218. end;
  219.  
  220.  
  221.  
  222.  
  223.  
  224. procedure TMyRegistry.CloseKey;
  225. begin
  226.     inherited CloseKey;
  227.     self.Access := KEY_ALL_ACCESS;
  228. end;
  229.  
  230. function TMyRegistry.ReadBool(value: string; default: boolean): boolean;
  231. begin
  232.     if self.ValueExists(value) then begin
  233.         result := inherited ReadBool(value);
  234.     end else begin
  235.         self.WriteBool(value, default);
  236.         result := default;
  237.     end;
  238.  
  239. end;
  240.  
  241. function TMyRegistry.ReadInteger(value: string; default: Integer): integer;
  242. begin
  243.     if self.ValueExists(value) then begin
  244.         result := inherited ReadInteger(value);
  245.     end else begin
  246.         self.WriteInteger(value, default);
  247.         result := default;
  248.     end;
  249. end;
  250.  
  251. function TMyRegistry.ReadString(value, default: string) : string;
  252. begin
  253.     if self.ValueExists(value) then begin
  254.         result := inherited ReadString(value);
  255.     end else begin
  256.         self.WriteString(value, default);
  257.         result := default;
  258.     end;
  259. end;
  260.  
  261.  
  262.  
  263.  
  264.  
  265. procedure TMyRegistry.EraseKey(basekey, key: string);
  266. begin
  267.     EraseKey(HKEY_LOCAL_MACHINE, basekey, key);
  268. end;
  269.  
  270. procedure TMyRegistry.EraseKey(HKEYVal: HKEY; basekey, key: string);
  271. begin
  272.     self.RootKey := HKEYVal;
  273.     if (self.OpenKey(basekey, false)) then begin
  274.         try
  275.             if self.KeyExists(key) then begin
  276.                 self.DeleteKey(key);
  277.             end;
  278.             self.CreateKey(key);
  279.         finally
  280.             self.CloseKey;
  281.         end;
  282.     end;
  283. end;
  284.  
  285. function TMyRegistry.ValueExistsInteger(key, value: string;
  286.   var data: integer): boolean;
  287. begin
  288.     result := false; // default to failure
  289.  
  290.     self.RootKey := HKEY_LOCAL_MACHINE;
  291.     if not self.OpenKeyReadOnly(Key) then EXIT;
  292.  
  293.     if self.ValueExists(value) then begin
  294.         data := self.ReadInteger(value);
  295.         result := true;
  296.     end;
  297.     self.CloseKey;
  298. end;
  299.  
  300. function TMyRegistry.ValueExistsString(key, value: string;
  301.   var data: string): boolean;
  302. begin
  303.     result := false; // default to failure
  304.  
  305.     self.RootKey := HKEY_LOCAL_MACHINE;
  306.     if not self.OpenKeyReadOnly(Key) then EXIT;
  307.  
  308.     if self.ValueExists(value) then begin
  309.         data := self.ReadString(value);
  310.         result := true;
  311.     end;
  312.     self.CloseKey;
  313. end;
  314.  
  315. procedure TMyRegistry.GetValues(HKEYVal: HKEY; key: string; var names : TStringList);
  316. begin
  317.     self.RootKey := HKEYVal;
  318.     if self.OpenKeyReadOnly(key) then begin
  319.         self.GetValueNames(names);
  320.         self.CloseKey;
  321.     end;
  322. end;
  323.  
  324. procedure TMyRegistry.GetValues(key: string; var names : TStringList);
  325. begin
  326.     self.GetValues(HKEY_LOCAL_MACHINE, key, names);
  327. end;
  328.  
  329. end.
  330.