home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d3456 / MINIREG.ZIP / MiniReg.pas
Pascal/Delphi Source File  |  2002-05-30  |  13KB  |  424 lines
  1. unit MiniReg;
  2.  
  3. {
  4.   lightweight replacement for TRegistry. Does not use Classes or SysUtils. Intended
  5.   for space-limited applets where only the commonly used functions are necessary.
  6.   Returns True if Successful, else False.
  7.  
  8.   Written by Ben Hochstrasser (bhoc@surfeu.ch).
  9.   This code is GPL.
  10.  
  11.   Function Examples:
  12.  
  13.   procedure TForm1.Button1Click(Sender: TObject);
  14.   var
  15.     ba1, ba2: array of byte;
  16.     n: integer;
  17.     s: String;
  18.     d: Cardinal;
  19.   begin
  20.     setlength(ba1, 10);
  21.     for n := 0 to 9 do ba1[n] := byte(n);
  22.  
  23.     RegSetString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestString', 'TestMe');
  24.     RegSetExpandString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestExpandString', '%SystemRoot%\Test');
  25.     RegSetMultiString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestMultiString', 'String1'#0'String2'#0'String3');
  26.     RegSetDword(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestDword', 7);
  27.     RegSetBinary(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestBinary', ba1);
  28.  
  29.     RegGetString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestString', s);
  30.     RegGetMultiString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestMultiString', s);
  31.     RegGetExpandString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestExpandString', s);
  32.     RegGetDWORD(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestDword', d);
  33.     RegGetBinary(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestBinary', s);
  34.     SetLength(ba2, Length(s));
  35.     for n := 1 to Length(s) do ba2[n-1] := byte(s[n]);
  36.     Button1.Caption := IntToStr(Length(ba2));
  37.  
  38.     if RegKeyExists(HKEY_CURRENT_USER, 'Software\My Company\Test\foo') then
  39.       if RegValueExists(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestBinary') then
  40.         MessageBox(GetActiveWindow, 'OK', 'OK', MB_OK);
  41.     RegDelValue(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestString');
  42.     RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar');
  43.     RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test\foo');
  44.     RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test');
  45.     RegDelKey(HKEY_CURRENT_USER, 'Software\My Company');
  46.     if RegEnumKeys(HKEY_CURRENT_USER, 'Software\My Company', s) then
  47.       ListBox1.Text := s;
  48.     if RegEnumValues(HKEY_CURRENT_USER, 'Software\My Company', s) then
  49.       ListBox1.Text := s;
  50.     if RegConnect('\\server1', HKEY_LOCAL_MACHINE, RemoteKey) then
  51.     begin
  52.       RegGetString(RemoteKey, 'Software\My Company\Test\foo\bar\TestString', s);
  53.       RegDisconnect(RemoteKey);
  54.     end;
  55.   end;
  56.  
  57. }
  58.  
  59. interface
  60.  
  61. uses Windows;
  62.  
  63. function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;
  64. function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;
  65. function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;
  66. function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): boolean;
  67. function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;
  68. function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  69. function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  70. function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  71. function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;
  72. function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;
  73. function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;
  74. function RegValueExists(RootKey: HKEY; Name: String): boolean;
  75. function RegKeyExists(RootKey: HKEY; Name: String): boolean;
  76. function RegDelValue(RootKey: HKEY; Name: String): boolean;
  77. function RegDelKey(RootKey: HKEY; Name: String): boolean;
  78. function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;
  79. function RegDisconnect(RemoteKey: HKEY): boolean;
  80. function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;
  81. function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;
  82.  
  83. implementation
  84.  
  85. function LastPos(Needle: Char; Haystack: String): integer;
  86. begin
  87.   for Result := Length(Haystack) downto 1 do
  88.     if Haystack[Result] = Needle then
  89.       Break;
  90. end;
  91.  
  92. function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;
  93. begin
  94.   Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) = ERROR_SUCCESS);
  95. end;
  96.  
  97. function RegDisconnect(RemoteKey: HKEY): boolean;
  98. begin
  99.   Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);
  100. end;
  101.  
  102. function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): boolean;
  103. var
  104.   SubKey: String;
  105.   n: integer;
  106.   dispo: DWORD;
  107.   hTemp: HKEY;
  108. begin
  109.   Result := False;
  110.   n := LastPos('\', Name);
  111.   if n > 0 then
  112.   begin
  113.     SubKey := Copy(Name, 1, n - 1);
  114.     if RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil, REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, hTemp, @dispo) = ERROR_SUCCESS then
  115.     begin
  116.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  117.       Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS);
  118.       RegCloseKey(hTemp);
  119.     end;
  120.   end;
  121. end;
  122.  
  123. function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; var PVal: Pointer; var ValSize: Cardinal): boolean;
  124. var
  125.   SubKey: String;
  126.   n: integer;
  127.   MyValType: DWORD;
  128.   hTemp: HKEY;
  129.   Buf: Pointer;
  130.   BufSize: Cardinal;
  131. begin
  132.   Result := False;
  133.   n := LastPos('\', Name);
  134.   if n > 0 then
  135.   begin
  136.     SubKey := Copy(Name, 1, n - 1);
  137.     if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
  138.     begin
  139.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  140.       if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, nil, @BufSize) = ERROR_SUCCESS then
  141.       begin
  142.         GetMem(Buf, BufSize);
  143.         if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS then
  144.         begin
  145.           if ValType = MyValType then
  146.           begin
  147.             PVal := Buf;
  148.             ValSize := BufSize;
  149.             Result := True;
  150.           end else
  151.           begin
  152.             FreeMem(Buf);
  153.           end;
  154.         end else
  155.         begin
  156.           FreeMem(Buf);
  157.         end;
  158.       end;
  159.       RegCloseKey(hTemp);
  160.     end;
  161.   end;
  162. end;
  163.  
  164. function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;
  165. begin
  166.   Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1);
  167. end;
  168.  
  169. function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;
  170. begin
  171.   Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2);
  172. end;
  173.  
  174. function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;
  175. begin
  176.   Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0), Length(Value) + 1);
  177. end;
  178.  
  179. function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): boolean;
  180. begin
  181.   Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));
  182. end;
  183.  
  184. function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;
  185. begin
  186.   Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value));
  187. end;
  188.  
  189. function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  190. var
  191.   Buf: Pointer;
  192.   BufSize: Cardinal;
  193. begin
  194.   Result := False;
  195.   if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then
  196.   begin
  197.     Dec(BufSize);
  198.     SetLength(Value, BufSize);
  199.     if BufSize > 0 then
  200.       CopyMemory(@Value[1], Buf, BufSize);
  201.     FreeMem(Buf);
  202.     Result := True;
  203.   end;
  204. end;
  205.  
  206. function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  207. var
  208.   Buf: Pointer;
  209.   BufSize: Cardinal;
  210. begin
  211.   Result := False;
  212.   if RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then
  213.   begin
  214.     Dec(BufSize);
  215.     SetLength(Value, BufSize);
  216.     if BufSize > 0 then
  217.       CopyMemory(@Value[1], Buf, BufSize);
  218.     FreeMem(Buf);
  219.     Result := True;
  220.   end;
  221. end;
  222.  
  223. function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  224. var
  225.   Buf: Pointer;
  226.   BufSize: Cardinal;
  227. begin
  228.   Result := False;
  229.   if RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then
  230.   begin
  231.     Dec(BufSize);
  232.     SetLength(Value, BufSize);
  233.     if BufSize > 0 then
  234.       CopyMemory(@Value[1], Buf, BufSize);
  235.     FreeMem(Buf);
  236.     Result := True;
  237.   end;
  238. end;
  239.  
  240. function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;
  241. var
  242.   Buf: Pointer;
  243.   BufSize: Cardinal;
  244. begin
  245.   Result := False;
  246.   if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then
  247.   begin
  248.     CopyMemory(@Value, Buf, BufSize);
  249.     FreeMem(Buf);
  250.     Result := True;
  251.   end;
  252. end;
  253.  
  254. function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;
  255. var
  256.   Buf: Pointer;
  257.   BufSize: Cardinal;
  258. begin
  259.   Result := False;
  260.   if RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then
  261.   begin
  262.     SetLength(Value, BufSize);
  263.     CopyMemory(@Value[1], Buf, BufSize);
  264.     FreeMem(Buf);
  265.     Result := True;
  266.   end;
  267. end;
  268.  
  269. function RegValueExists(RootKey: HKEY; Name: String): boolean;
  270. var
  271.   SubKey: String;
  272.   n: integer;
  273.   hTemp: HKEY;
  274. begin
  275.   Result := False;
  276.   n := LastPos('\', Name);
  277.   if n > 0 then
  278.   begin
  279.     SubKey := Copy(Name, 1, n - 1);
  280.     if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
  281.     begin
  282.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  283.       Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) = ERROR_SUCCESS);
  284.       RegCloseKey(hTemp);
  285.     end;
  286.   end;
  287. end;
  288.  
  289. function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;
  290. var
  291.   SubKey: String;
  292.   n: integer;
  293.   hTemp: HKEY;
  294.   ValType: Cardinal;
  295. begin
  296.   Result := False;
  297.   Value := REG_NONE;
  298.   n := LastPos('\', Name);
  299.   if n > 0 then
  300.   begin
  301.     SubKey := Copy(Name, 1, n - 1);
  302.     if (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS) then
  303.     begin
  304.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  305.       Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, @ValType, nil, nil) = ERROR_SUCCESS);
  306.       if Result then
  307.         Value := ValType;
  308.       RegCloseKey(hTemp);
  309.     end;
  310.   end;
  311. end;
  312.  
  313. function RegKeyExists(RootKey: HKEY; Name: String): boolean;
  314. var
  315.   SubKey: String;
  316.   n: integer;
  317.   hTemp: HKEY;
  318. begin
  319.   Result := False;
  320.   n := LastPos('\', Name);
  321.   if n > 0 then
  322.   begin
  323.     SubKey := Copy(Name, 1, n - 1);
  324.     if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
  325.     begin
  326.       Result := True;
  327.       RegCloseKey(hTemp);
  328.     end;
  329.   end;
  330. end;
  331.  
  332. function RegDelValue(RootKey: HKEY; Name: String): boolean;
  333. var
  334.   SubKey: String;
  335.   n: integer;
  336.   hTemp: HKEY;
  337. begin
  338.   Result := False;
  339.   n := LastPos('\', Name);
  340.   if n > 0 then
  341.   begin
  342.     SubKey := Copy(Name, 1, n - 1);
  343.     if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then
  344.     begin
  345.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  346.       Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
  347.       RegCloseKey(hTemp);
  348.     end;
  349.   end;
  350. end;
  351.  
  352. function RegDelKey(RootKey: HKEY; Name: String): boolean;
  353. var
  354.   SubKey: String;
  355.   n: integer;
  356.   hTemp: HKEY;
  357. begin
  358.   Result := False;
  359.   n := LastPos('\', Name);
  360.   if n > 0 then
  361.   begin
  362.     SubKey := Copy(Name, 1, n - 1);
  363.     if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then
  364.     begin
  365.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  366.       Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
  367.       RegCloseKey(hTemp);
  368.     end;
  369.   end;
  370. end;
  371.  
  372. function RegEnum(RootKey: HKEY; Name: String; var ResultList: String; const DoKeys: Boolean): boolean;
  373. var
  374.   i: integer;
  375.   iRes: integer;
  376.   s: String;
  377.   hTemp: HKEY;
  378.   Buf: Pointer;
  379.   BufSize: Cardinal;
  380. begin
  381.   Result := False;
  382.   ResultList := '';
  383.   if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
  384.   begin
  385.     Result := True;
  386.     BufSize := 1024;
  387.     GetMem(buf, BufSize);
  388.     i := 0;
  389.     iRes := ERROR_SUCCESS;
  390.     while iRes = ERROR_SUCCESS do
  391.     begin
  392.       BufSize := 1024;
  393.       if DoKeys then
  394.         iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil, nil, nil, nil)
  395.       else
  396.         iRes := RegEnumValue(hTemp, i, buf, BufSize, nil, nil, nil, nil);
  397.       if iRes = ERROR_SUCCESS then
  398.       begin
  399.         SetLength(s, BufSize);
  400.         CopyMemory(@s[1], buf, BufSize);
  401.         if ResultList = '' then
  402.           ResultList := s
  403.         else
  404.           ResultList := Concat(ResultList, #13#10, s);
  405.         inc(i);
  406.       end;
  407.     end;
  408.     FreeMem(buf);
  409.     RegCloseKey(hTemp);
  410.   end;
  411. end;
  412.  
  413. function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;
  414. begin
  415.   Result := RegEnum(RootKey, Name, ValueList, False);
  416. end;
  417.  
  418. function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;
  419. begin
  420.   Result := RegEnum(RootKey, Name, KeyList, True);
  421. end;
  422.  
  423. end.
  424.