home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 December / Chip_2002-12_cd1.bin / zkuste / delphi / kompon / d34567 / MINIREG.ZIP / MiniReg.pas
Pascal/Delphi Source File  |  2002-08-30  |  17KB  |  524 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.     To set the default value for a key, end the key name with a '\':
  30.     RegSetString(HKEY_CURRENT_USER, 'Software\My Company\Test\', 'Default Value');
  31.     RegGetString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestString', s);
  32.     RegGetMultiString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestMultiString', s);
  33.     RegGetExpandString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestExpandString', s);
  34.     RegGetAnyString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestMultiString', s, StringType);
  35.     RegSetAnyString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestMultiString', s, StringType);
  36.     RegGetDWORD(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestDword', d);
  37.     RegGetBinary(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestBinary', s);
  38.     SetLength(ba2, Length(s));
  39.     for n := 1 to Length(s) do ba2[n-1] := byte(s[n]);
  40.     Button1.Caption := IntToStr(Length(ba2));
  41.  
  42.     if RegKeyExists(HKEY_CURRENT_USER, 'Software\My Company\Test\foo') then
  43.       if RegValueExists(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestBinary') then
  44.         MessageBox(GetActiveWindow, 'OK', 'OK', MB_OK);
  45.     RegDelValue(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestString');
  46.     RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar');
  47.     RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test\foo');
  48.     RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test');
  49.     RegDelKey(HKEY_CURRENT_USER, 'Software\My Company');
  50.     if RegEnumKeys(HKEY_CURRENT_USER, 'Software\My Company', s) then
  51.       ListBox1.Text := s;
  52.     if RegEnumValues(HKEY_CURRENT_USER, 'Software\My Company', s) then
  53.       ListBox1.Text := s;
  54.     if RegConnect('\\server1', HKEY_LOCAL_MACHINE, RemoteKey) then
  55.     begin
  56.       RegGetString(RemoteKey, 'Software\My Company\Test\foo\bar\TestString', s);
  57.       RegDisconnect(RemoteKey);
  58.     end;
  59.   end;
  60. }
  61.  
  62. interface
  63.  
  64. uses Windows;
  65.  
  66. function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;
  67. function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;
  68. function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;
  69. function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): boolean;
  70. function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;
  71. function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  72. function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  73. function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  74. function RegGetAnyString(RootKey: HKEY; Name: String; Var Value: String; Var ValueType: Cardinal): boolean;
  75. function RegSetAnyString(RootKey: HKEY; Name: String; Value: String; ValueType: Cardinal): boolean;
  76. function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;
  77. function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;
  78. function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;
  79. function RegValueExists(RootKey: HKEY; Name: String): boolean;
  80. function RegKeyExists(RootKey: HKEY; Name: String): boolean;
  81. function RegDelValue(RootKey: HKEY; Name: String): boolean;
  82. function RegDelKey(RootKey: HKEY; Name: String): boolean;
  83. function RegDelKeyEx(RootKey: HKEY; Name: String; WithSubKeys: Boolean = True): boolean;
  84. function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;
  85. function RegDisconnect(RemoteKey: HKEY): boolean;
  86. function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;
  87. function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;
  88.  
  89. implementation
  90.  
  91. function LastPos(Needle: Char; Haystack: String): integer;
  92. begin
  93.   for Result := Length(Haystack) downto 1 do
  94.     if Haystack[Result] = Needle then
  95.       Break;
  96. end;
  97.  
  98. function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;
  99. begin
  100.   Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) = ERROR_SUCCESS);
  101. end;
  102.  
  103. function RegDisconnect(RemoteKey: HKEY): boolean;
  104. begin
  105.   Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);
  106. end;
  107.  
  108. function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): boolean;
  109. var
  110.   SubKey: String;
  111.   n: integer;
  112.   dispo: DWORD;
  113.   hTemp: HKEY;
  114. begin
  115.   Result := False;
  116.   n := LastPos('\', Name);
  117.   if n > 0 then
  118.   begin
  119.     SubKey := Copy(Name, 1, n - 1);
  120.     if RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil, REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, hTemp, @dispo) = ERROR_SUCCESS then
  121.     begin
  122.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  123.       if SubKey = '' then
  124.         Result := (RegSetValueEx(hTemp, nil, 0, ValType, PVal, ValSize) = ERROR_SUCCESS)
  125.       else
  126.         Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS);
  127.       RegCloseKey(hTemp);
  128.     end;
  129.   end;
  130. end;
  131.  
  132. function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; var PVal: Pointer; var ValSize: Cardinal): boolean;
  133. var
  134.   SubKey: String;
  135.   n: integer;
  136.   MyValType: DWORD;
  137.   hTemp: HKEY;
  138.   Buf: Pointer;
  139.   BufSize: Cardinal;
  140.   PKey: PChar;
  141. begin
  142.   Result := False;
  143.   n := LastPos('\', Name);
  144.   if n > 0 then
  145.   begin
  146.     SubKey := Copy(Name, 1, n - 1);
  147.     if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
  148.     begin
  149.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  150.       if SubKey = '' then
  151.         PKey := nil
  152.       else
  153.         PKey := PChar(SubKey);
  154.       if RegQueryValueEx(hTemp, PKey, nil, @MyValType, nil, @BufSize) = ERROR_SUCCESS then
  155.       begin
  156.         GetMem(Buf, BufSize);
  157.         if RegQueryValueEx(hTemp, PKey, nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS then
  158.         begin
  159.           if ValType = MyValType then
  160.           begin
  161.             PVal := Buf;
  162.             ValSize := BufSize;
  163.             Result := True;
  164.           end else
  165.           begin
  166.             FreeMem(Buf);
  167.           end;
  168.         end else
  169.         begin
  170.           FreeMem(Buf);
  171.         end;
  172.       end;
  173.       RegCloseKey(hTemp);
  174.     end;
  175.   end;
  176. end;
  177.  
  178. function RegSetAnyString(RootKey: HKEY; Name: String; Value: String; ValueType: Cardinal): boolean;
  179. begin
  180.   case ValueType of
  181.     REG_SZ, REG_EXPAND_SZ:
  182.       Result := RegSetValue(RootKey, Name, ValueType, PChar(Value + #0), Length(Value) + 1);
  183.     Reg_MULTI_SZ:
  184.       Result := RegSetValue(RootKey, Name, ValueType, PChar(Value + #0#0), Length(Value) + 2);
  185.   else
  186.     Result := False;
  187.   end;
  188. end;
  189.  
  190. function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;
  191. begin
  192.   Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1);
  193. end;
  194.  
  195. function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;
  196. begin
  197.   Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2);
  198. end;
  199.  
  200. function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;
  201. begin
  202.   Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0), Length(Value) + 1);
  203. end;
  204.  
  205. function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): boolean;
  206. begin
  207.   Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));
  208. end;
  209.  
  210. function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;
  211. begin
  212.   Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value));
  213. end;
  214.  
  215. function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  216. var
  217.   Buf: Pointer;
  218.   BufSize: Cardinal;
  219. begin
  220.   Result := False;
  221.   Value := '';
  222.   if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then
  223.   begin
  224.     Dec(BufSize);
  225.     SetLength(Value, BufSize);
  226.     if BufSize > 0 then
  227.       Move(Buf^, Value[1], BufSize);
  228.     FreeMem(Buf);
  229.     Result := True;
  230.   end;
  231. end;
  232.  
  233. function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  234. var
  235.   Buf: Pointer;
  236.   BufSize: Cardinal;
  237. begin
  238.   Result := False;
  239.   Value := '';
  240.   if RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then
  241.   begin
  242.     Dec(BufSize);
  243.     SetLength(Value, BufSize);
  244.     if BufSize > 0 then
  245.       Move(Buf^, Value[1], BufSize);
  246.     FreeMem(Buf);
  247.     Result := True;
  248.   end;
  249. end;
  250.  
  251. function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;
  252. var
  253.   Buf: Pointer;
  254.   BufSize: Cardinal;
  255. begin
  256.   Result := False;
  257.   Value := '';
  258.   if RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then
  259.   begin
  260.     Dec(BufSize);
  261.     SetLength(Value, BufSize);
  262.     if BufSize > 0 then
  263.       Move(Buf^, Value[1], BufSize);
  264.     FreeMem(Buf);
  265.     Result := True;
  266.   end;
  267. end;
  268.  
  269. function RegGetAnyString(RootKey: HKEY; Name: String; Var Value: String; Var ValueType: Cardinal): boolean;
  270. var
  271.   Buf: Pointer;
  272.   BufSize: Cardinal;
  273.   bOK: Boolean;
  274. begin
  275.   Result := False;
  276.   Value := '';
  277.   if RegGetValueType(Rootkey, Name, ValueType) then
  278.   begin
  279.     case ValueType of
  280.       REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ:
  281.         bOK := RegGetValue(RootKey, Name, ValueType, Buf, BufSize);
  282.     else
  283.       bOK := False;
  284.     end;
  285.     if bOK then
  286.     begin
  287.       Dec(BufSize);
  288.       SetLength(Value, BufSize);
  289.       if BufSize > 0 then
  290.         Move(Buf^, Value[1], BufSize);
  291.       FreeMem(Buf);
  292.       Result := True;
  293.     end;
  294.   end;
  295. end;
  296.  
  297. function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;
  298. var
  299.   Buf: Pointer;
  300.   BufSize: Cardinal;
  301. begin
  302.   Result := False;
  303.   Value := 0;
  304.   if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then
  305.   begin
  306.     Value := PDWord(Buf)^;
  307.     FreeMem(Buf);
  308.     Result := True;
  309.   end;
  310. end;
  311.  
  312. function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;
  313. var
  314.   Buf: Pointer;
  315.   BufSize: Cardinal;
  316. begin
  317.   Result := False;
  318.   Value := '';
  319.   if RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then
  320.   begin
  321.     SetLength(Value, BufSize);
  322.     Move(Buf^, Value[1], BufSize);
  323.     FreeMem(Buf);
  324.     Result := True;
  325.   end;
  326. end;
  327.  
  328. function RegValueExists(RootKey: HKEY; Name: String): boolean;
  329. var
  330.   SubKey: String;
  331.   n: integer;
  332.   hTemp: HKEY;
  333. begin
  334.   Result := False;
  335.   n := LastPos('\', Name);
  336.   if n > 0 then
  337.   begin
  338.     SubKey := Copy(Name, 1, n - 1);
  339.     if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
  340.     begin
  341.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  342.       Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) = ERROR_SUCCESS);
  343.       RegCloseKey(hTemp);
  344.     end;
  345.   end;
  346. end;
  347.  
  348. function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;
  349. var
  350.   SubKey: String;
  351.   n: integer;
  352.   hTemp: HKEY;
  353.   ValType: Cardinal;
  354. begin
  355.   Result := False;
  356.   Value := REG_NONE;
  357.   n := LastPos('\', Name);
  358.   if n > 0 then
  359.   begin
  360.     SubKey := Copy(Name, 1, n - 1);
  361.     if (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS) then
  362.     begin
  363.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  364.       if SubKey = '' then
  365.         Result := (RegQueryValueEx(hTemp, nil, nil, @ValType, nil, nil) = ERROR_SUCCESS)
  366.       else
  367.         Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, @ValType, nil, nil) = ERROR_SUCCESS);
  368.       if Result then
  369.         Value := ValType;
  370.       RegCloseKey(hTemp);
  371.     end;
  372.   end;
  373. end;
  374.  
  375. function RegKeyExists(RootKey: HKEY; Name: String): boolean;
  376. var
  377.   hTemp: HKEY;
  378. begin
  379.   Result := False;
  380.   if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
  381.   begin
  382.     Result := True;
  383.     RegCloseKey(hTemp);
  384.   end;
  385. end;
  386.  
  387. function RegDelValue(RootKey: HKEY; Name: String): boolean;
  388. var
  389.   SubKey: String;
  390.   n: integer;
  391.   hTemp: HKEY;
  392. begin
  393.   Result := False;
  394.   n := LastPos('\', Name);
  395.   if n > 0 then
  396.   begin
  397.     SubKey := Copy(Name, 1, n - 1);
  398.     if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then
  399.     begin
  400.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  401.       Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
  402.       RegCloseKey(hTemp);
  403.     end;
  404.   end;
  405. end;
  406.  
  407. function RegDelKey(RootKey: HKEY; Name: String): boolean;
  408. var
  409.   SubKey: String;
  410.   n: integer;
  411.   hTemp: HKEY;
  412. begin
  413.   Result := False;
  414.   n := LastPos('\', Name);
  415.   if n > 0 then
  416.   begin
  417.     SubKey := Copy(Name, 1, n - 1);
  418.     if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then
  419.     begin
  420.       SubKey := Copy(Name, n + 1, Length(Name) - n);
  421.       Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
  422.       RegCloseKey(hTemp);
  423.     end;
  424.   end;
  425. end;
  426.  
  427. function RegDelKeyEx(RootKey: HKEY; Name: String; WithSubKeys: Boolean = True): boolean;
  428. const
  429.   MaxBufSize: Cardinal = 1024;
  430. var
  431.   iRes: integer;
  432.   hTemp: HKEY;
  433.   Buf: String;
  434.   BufSize: Cardinal;
  435. begin
  436.   Result := False;
  437.   // no root keys...
  438.   if pos('\', Name) <> 0 then
  439.   begin
  440.     iRes := RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_ENUMERATE_SUB_KEYS or KEY_WRITE, hTemp);
  441.     if WithSubKeys then
  442.     begin
  443.       while iRes = ERROR_SUCCESS do
  444.       begin
  445.         BufSize := MaxBufSize;
  446.         SetLength(Buf, BufSize);
  447.         iRes := RegEnumKeyEx(hTemp, 0, @Buf[1], BufSize, nil, nil, nil, nil);
  448.         if iRes = ERROR_NO_MORE_ITEMS then
  449.         begin
  450.           RegCloseKey(hTemp);
  451.           Result := (RegDeleteKey(RootKey, PChar(Name)) = ERROR_SUCCESS);
  452.         end else
  453.         begin
  454.           if iRes = ERROR_SUCCESS then
  455.           begin
  456.             SetLength(Buf, BufSize);
  457.             if RegDelKeyEx(RootKey, Concat(Name, '\', Buf), WithSubKeys) then
  458.               iRes := ERROR_SUCCESS
  459.             else
  460.               iRES := ERROR_BADKEY;
  461.           end;
  462.         end;
  463.       end;
  464.     end else
  465.     begin
  466.       RegCloseKey(hTemp);
  467.       Result := (RegDeleteKey(RootKey, PChar(Name)) = ERROR_SUCCESS);
  468.     end;
  469.   end;
  470. end;
  471.  
  472. function RegEnum(RootKey: HKEY; Name: String; var ResultList: String; const DoKeys: Boolean): boolean;
  473. var
  474.   i: integer;
  475.   iRes: integer;
  476.   s: String;
  477.   hTemp: HKEY;
  478.   Buf: Pointer;
  479.   BufSize: Cardinal;
  480. begin
  481.   Result := False;
  482.   ResultList := '';
  483.   if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then
  484.   begin
  485.     Result := True;
  486.     BufSize := 1024;
  487.     GetMem(buf, BufSize);
  488.     i := 0;
  489.     iRes := ERROR_SUCCESS;
  490.     while iRes = ERROR_SUCCESS do
  491.     begin
  492.       BufSize := 1024;
  493.       if DoKeys then
  494.         iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil, nil, nil, nil)
  495.       else
  496.         iRes := RegEnumValue(hTemp, i, buf, BufSize, nil, nil, nil, nil);
  497.       if iRes = ERROR_SUCCESS then
  498.       begin
  499.         SetLength(s, BufSize);
  500.         Move(buf^, s[1], BufSize);
  501.         if ResultList = '' then
  502.           ResultList := s
  503.         else
  504.           ResultList := Concat(ResultList, #13#10, s);
  505.         inc(i);
  506.       end;
  507.     end;
  508.     FreeMem(buf);
  509.     RegCloseKey(hTemp);
  510.   end;
  511. end;
  512.  
  513. function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;
  514. begin
  515.   Result := RegEnum(RootKey, Name, ValueList, False);
  516. end;
  517.  
  518. function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;
  519. begin
  520.   Result := RegEnum(RootKey, Name, KeyList, True);
  521. end;
  522.  
  523. end.
  524.