Windows

Code:

uses

Registry;

procedure ReadREG_MULTI_SZ(const CurrentKey: HKey; const Subkey, ValueName: string;

Strings: TStrings);

var

valueType: DWORD;

valueLen: DWORD;

p, buffer: PChar;

key: HKEY;

begin

// Clear TStrings

Strings.Clear;

// open the specified key

if RegOpenKeyEx(CurrentKey,

                 PChar(Subkey),

                 0, KEY_READ, key) = ERROR_SUCCESS then

begin

   // retrieve the type and data for a specified value name

   SetLastError(RegQueryValueEx(key,

                PChar(ValueName),

                nil,

                @valueType,

                nil,

                @valueLen));

   if GetLastError = ERROR_SUCCESS then

     if valueType = REG_MULTI_SZ then

     begin

       GetMem(buffer, valueLen);

       try

         // receive the value's data (in an array).

         RegQueryValueEx(key,

                         PChar(ValueName),

                         nil,

                         nil,

                         PBYTE(buffer),

                         @valueLen);

         // Add values to stringlist

         p := buffer;

         while p^ <> #0 do

         begin

           Strings.Add(p);

           Inc(p, lstrlen(p) + 1)

         end

       finally

         FreeMem(buffer)

       end

     end

     else

       raise ERegistryException.Create('Stringlist expected/ String Liste erwartet...')

   else

     raise ERegistryException.Create('Cannot Read MULTI_SZ Value/'+

       'Kann den MULTI_SZ Wert nicht lesen...');

end;

end;

// Test it:

procedure TForm1.Button1Click(Sender: TObject);

begin

ReadREG_MULTI_SZ(HKEY_CURRENT_USER, 'Software\XYZ', 'Test44', Memo1.Lines);

end;

Code:

{******************************************}

{2. by Ralph Friedman }

{

Question:

I want to read out the binary-value "problems" of the path

HKEY_DYN_DATA\Config Manager\Enum\[add the key of a hardware component] to

detect if a hardware component is troubled and not working right.

But I cannot handle the ReadBinaryData-Method of TRegistry correct.

Everytime I use it, it always returns "4" as content of the buffer.

How do I detect if the content of the binary-key "problems" is

not "00 00 00 00" but something else like "16 00 00 00" or such?

}

{Answer: Here's an example of ReadBinaryData }

procedure TFrmReadBinary.Button1Click(Sender: TObject);

const

CKeyName: string = 'System\Setup';

CValName: string = 'NetcardDlls';

var

keyGood: boolean;

p: integer;

regKey: TRegistry;

tmpStr: string;

vSize: integer;

begin

regKey := TRegistry.Create;

try

   regKey.RootKey := HKEY_LOCAL_MACHINE;

   keyGood  := regKey.OpenKey(CKeyName, False);

   if (keyGood) then

   begin

     vSize := regKey.GetDataSize(CValName);

     if (vSize > 0) then

     begin

       SetLength(tmpStr, vSize);

       regKey.ReadBinaryData(CValName, tmpstr[1], vSize);

       repeat

         p := Pos(#0, tmpStr);

         if p <> 0 then

         begin

           Delete(tmpStr, p, 1);

           Insert(#13#10, tmpStr, p);

         end;

       until p = 0;

       (*StringReplace(tmpStr, #0, #13#10, [rfReplaceAll]); *)

       ListBox1.Items.Text := tmpStr;

     end;

   end;

finally

   regKey.Free;

end;

end;

Code:

{******************************************}

{3. by Michael Winter }

procedure RaiseWin32Error(Code: Cardinal);

var

Error: EWin32Error;

begin

Error := EWin32Error.CreateResFmt(@SWin32Error, [Code,

   SysErrorMessage(Code)]);

Error.ErrorCode := Code;

raise Error;

end;

// Write REG_MULTI_SZ

procedure TForm1.Button1Click(Sender: TObject);

const

Str = 'multiple'#0'strings'#0'in one'#0'registry'#0'value'#0;

var

Reg: TRegistry;

Res: Integer;

begin

Reg := TRegistry.Create;

try

   Reg.RootKey := HKEY_CURRENT_USER;

   if not Reg.OpenKey('\Software\Test\RegMultiSzTest', true) then

     raise Exception.Create('Can''t open key');

   Res := RegSetValueEx(

     Reg.CurrentKey,     // handle of key to set value for

     'TestValue',        // address of value to set

     0,                  // reserved

     REG_MULTI_SZ,       // flag for value type

     PChar(Str),         // address of value data

     Length(Str) + 1);   // size of value data

   if Res <> ERROR_SUCCESS then

     RaiseWin32Error(Res);

finally

   Reg.Free;

end;

end;

// Read REG_MULTI_SZ

procedure TForm1.Button2Click(Sender: TObject);

var

Reg: TRegistry;

DataType: Cardinal;

DataSize: Cardinal;

Res: Integer;

Str: String;

i: Integer;

begin

Reg := TRegistry.Create;

try

   Reg.RootKey := HKEY_CURRENT_USER;

   if not Reg.OpenKeyReadOnly('\Software\Test\RegMultiSzTest') then

     raise Exception.Create('Can''t open key');

  DataSize := 0;

   Res := RegQueryValueEx(

     Reg.CurrentKey,     // handle of key to query

     'TestValue',        // address of name of value to query

     nil,                // reserved

     @DataType,          // address of buffer for value type

     nil,                // address of data buffer

     @DataSize);         // address of data buffer size

   if Res <> ERROR_SUCCESS then

     RaiseWin32Error(Res);

   if DataType <> REG_MULTI_SZ then

     raise Exception.Create('Wrong data type');

   SetLength(Str, DataSize - 1);

   if DataSize > 1 then begin

     Res := RegQueryValueEx(

       Reg.CurrentKey,     // handle of key to query

       'TestValue',        // address of name of value to query

       nil,                // reserved

       @DataType,          // address of buffer for value type

       PByte(Str),         // address of data buffer

       @DataSize);         // address of data buffer size

     if Res <> ERROR_SUCCESS then

       RaiseWin32Error(Res);

   end;

  for i := Length(Str) downto 1 do

     if Str[i] = #0 then

       Str[i] := #13;

   ShowMessage(Str);

finally

   Reg.Free;

end;

end;

Code:

type

{©Drkb v.3(2007): www.drkb.ru}

TExRegistry = class(TRegistry)

public

   function ReadStrings(const ValueName: String): String;

end;

function TExRegistry.ReadStrings(const ValueName: String): String;

var

ValueType : DWORD;

ValueLen  : DWORD;

P, Buffer : PChar;

begin

Result := '';

SetLastError(RegQueryValueEx(CurrentKey, PChar (ValueName), nil,

   @ValueType, nil, @ValueLen));

if GetLastError = ERROR_SUCCESS then

begin

   if ValueType = REG_MULTI_SZ then

   begin

     GetMem(Buffer, ValueLen);

     try

       RegQueryValueEx(CurrentKey, PChar(ValueName), nil, nil, PBYTE(Buffer), @ValueLen);

       P := Buffer;

       while P^ <> #0 do

       begin

         if Result <> '' then

           Result := Result + sLineBreak;

         Result := Result + P;

         Inc(P, lstrlen(P) + 1);

       end;

     finally

       FreeMem (Buffer);

     end;

   end

   else

     raise ERegistryException.Create ('String list expected');

end

else

   raise Exception.Create ('Unable read MULTI_SZ value');

end;

Code:

unit MiniReg;

{

lightweight replacement for TRegistry. Does not use Classes or SysUtils. Intended

for space-limited applets where only the commonly used functions are necessary.

Returns True if Successful, else False.

Written by Ben Hochstrasser (Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.).

This code is GPL.

}

//  Function Examples:

procedure TForm1.Button1Click(Sender: TObject);

var

   ba1, ba2: array of byte;

   n: integer;

   s: String;

   d: Cardinal;

begin

   setlength(ba1, 10);

   for n := 0 to 9 do ba1[n] := byte(n);

   RegSetString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestString', 'TestMe');

   RegSetExpandString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestExpandString',

     '%SystemRoot%\Test');

   RegSetMultiString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestMultiString',

     'String1'#0'String2'#0'String3');

   RegSetDword(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestDword', 7);

   RegSetBinary(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestBinary', ba1);

   RegGetString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestString', s);

   RegGetMultiString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestMultiString', s);

   RegGetExpandString(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestExpandString', s);

   RegGetDWORD(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestDword', d);

   RegGetBinary(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestBinary', s);

   SetLength(ba2, Length(s));

   for n := 1 to Length(s) do ba2[n-1] := byte(s[n]);

   Button1.Caption := IntToStr(Length(ba2));

   if RegKeyExists(HKEY_CURRENT_USER, 'Software\My Company\Test\foo') then

     if RegValueExists(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestBinary') then

       MessageBox(GetActiveWindow, 'OK', 'OK', MB_OK);

   RegDelValue(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar\TestString');

   RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test\foo\bar');

   RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test\foo');

   RegDelKey(HKEY_CURRENT_USER, 'Software\My Company\Test');

   RegDelKey(HKEY_CURRENT_USER, 'Software\My Company');

   if RegEnumKeys(HKEY_CURRENT_USER, 'Software\My Company', s) then

     ListBox1.Text := s;

   if RegEnumValues(HKEY_CURRENT_USER, 'Software\My Company', s) then

     ListBox1.Text := s;

   if RegConnect('\\server1', HKEY_LOCAL_MACHINE, RemoteKey) then

   begin

     RegGetString(RemoteKey, 'Software\My Company\Test\foo\bar\TestString', s);

     RegDisconnect(RemoteKey);

   end;

end;

interface

uses Windows;

function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;

function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;

function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;

function RegSetDWORD(RootKey: HKEY; Name: String; Value: Cardinal): boolean;

function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;

function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;

function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;

function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;

function RegValueExists(RootKey: HKEY; Name: String): boolean;

function RegKeyExists(RootKey: HKEY; Name: String): boolean;

function RegDelValue(RootKey: HKEY; Name: String): boolean;

function RegDelKey(RootKey: HKEY; Name: String): boolean;

function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;

function RegDisconnect(RemoteKey: HKEY): boolean;

function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;

function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;

implementation

function LastPos(Needle: Char; Haystack: String): integer;

begin

for Result := Length(Haystack) downto 1 do

   if Haystack[Result] = Needle then

     Break;

end;

function RegConnect(MachineName: String; RootKey: HKEY; var RemoteKey: HKEY): boolean;

begin

Result := (RegConnectRegistry(PChar(MachineName), RootKey, RemoteKey) = ERROR_SUCCESS);

end;

function RegDisconnect(RemoteKey: HKEY): boolean;

begin

Result := (RegCloseKey(RemoteKey) = ERROR_SUCCESS);

end;

function RegSetValue(RootKey: HKEY; Name: String; ValType: Cardinal; PVal: Pointer; ValSize: Cardinal): boolean;

var

SubKey: String;

n: integer;

dispo: DWORD;

hTemp: HKEY;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

   SubKey := Copy(Name, 1, n - 1);

   if RegCreateKeyEx(RootKey, PChar(SubKey), 0, nil, REG_OPTION_NON_VOLATILE, KEY_WRITE,

     nil, hTemp, @dispo) = ERROR_SUCCESS then

   begin

     SubKey := Copy(Name, n + 1, Length(Name) - n);

     Result := (RegSetValueEx(hTemp, PChar(SubKey), 0, ValType, PVal, ValSize) = ERROR_SUCCESS);

     RegCloseKey(hTemp);

   end;

end;

end;

function RegGetValue(RootKey: HKEY; Name: String; ValType: Cardinal; var PVal: Pointer;

var ValSize: Cardinal): boolean;

var

SubKey: String;

n: integer;

MyValType: DWORD;

hTemp: HKEY;

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

   SubKey := Copy(Name, 1, n - 1);

   if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

   begin

     SubKey := Copy(Name, n + 1, Length(Name) - n);

     if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, nil, @BufSize) = ERROR_SUCCESS then

     begin

       GetMem(Buf, BufSize);

       if RegQueryValueEx(hTemp, PChar(SubKey), nil, @MyValType, Buf, @BufSize) = ERROR_SUCCESS then

       begin

         if ValType = MyValType then

         begin

           PVal := Buf;

           ValSize := BufSize;

           Result := True;

         end else

         begin

           FreeMem(Buf);

         end;

       end else

       begin

         FreeMem(Buf);

       end;

     end;

     RegCloseKey(hTemp);

   end;

end;

end;

function RegSetString(RootKey: HKEY; Name: String; Value: String): boolean;

begin

Result := RegSetValue(RootKey, Name, REG_SZ, PChar(Value + #0), Length(Value) + 1);

end;

function RegSetMultiString(RootKey: HKEY; Name: String; Value: String): boolean;

begin

Result := RegSetValue(RootKey, Name, REG_MULTI_SZ, PChar(Value + #0#0), Length(Value) + 2);

end;

function RegSetExpandString(RootKey: HKEY; Name: String; Value: String): boolean;

begin

Result := RegSetValue(RootKey, Name, REG_EXPAND_SZ, PChar(Value + #0), Length(Value) + 1);

end;

function RegSetDword(RootKey: HKEY; Name: String; Value: Cardinal): boolean;

begin

Result := RegSetValue(RootKey, Name, REG_DWORD, @Value, SizeOf(Cardinal));

end;

function RegSetBinary(RootKey: HKEY; Name: String; Value: Array of Byte): boolean;

begin

Result := RegSetValue(RootKey, Name, REG_BINARY, @Value[Low(Value)], length(Value));

end;

function RegGetString(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

if RegGetValue(RootKey, Name, REG_SZ, Buf, BufSize) then

begin

   Dec(BufSize);

   SetLength(Value, BufSize);

   if BufSize > 0 then

     CopyMemory(@Value[1], Buf, BufSize);

   FreeMem(Buf);

   Result := True;

end;

end;

function RegGetMultiString(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

if RegGetValue(RootKey, Name, REG_MULTI_SZ, Buf, BufSize) then

begin

   Dec(BufSize);

   SetLength(Value, BufSize);

   if BufSize > 0 then

     CopyMemory(@Value[1], Buf, BufSize);

   FreeMem(Buf);

   Result := True;

end;

end;

function RegGetExpandString(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

if RegGetValue(RootKey, Name, REG_EXPAND_SZ, Buf, BufSize) then

begin

   Dec(BufSize);

   SetLength(Value, BufSize);

   if BufSize > 0 then

     CopyMemory(@Value[1], Buf, BufSize);

   FreeMem(Buf);

   Result := True;

end;

end;

function RegGetDWORD(RootKey: HKEY; Name: String; Var Value: Cardinal): boolean;

var

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

if RegGetValue(RootKey, Name, REG_DWORD, Buf, BufSize) then

begin

   CopyMemory(@Value, Buf, BufSize);

   FreeMem(Buf);

   Result := True;

end;

end;

function RegGetBinary(RootKey: HKEY; Name: String; Var Value: String): boolean;

var

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

if RegGetValue(RootKey, Name, REG_BINARY, Buf, BufSize) then

begin

   SetLength(Value, BufSize);

   CopyMemory(@Value[1], Buf, BufSize);

   FreeMem(Buf);

   Result := True;

end;

end;

function RegValueExists(RootKey: HKEY; Name: String): boolean;

var

SubKey: String;

n: integer;

hTemp: HKEY;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

   SubKey := Copy(Name, 1, n - 1);

   if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

   begin

     SubKey := Copy(Name, n + 1, Length(Name) - n);

     Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, nil, nil, nil) = ERROR_SUCCESS);

     RegCloseKey(hTemp);

   end;

end;

end;

function RegGetValueType(RootKey: HKEY; Name: String; var Value: Cardinal): boolean;

var

SubKey: String;

n: integer;

hTemp: HKEY;

ValType: Cardinal;

begin

Result := False;

Value := REG_NONE;

n := LastPos('\', Name);

if n > 0 then

begin

   SubKey := Copy(Name, 1, n - 1);

   if (RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS) then

   begin

     SubKey := Copy(Name, n + 1, Length(Name) - n);

     Result := (RegQueryValueEx(hTemp, PChar(SubKey), nil, @ValType, nil, nil) = ERROR_SUCCESS);

     if Result then

       Value := ValType;

     RegCloseKey(hTemp);

   end;

end;

end;

function RegKeyExists(RootKey: HKEY; Name: String): boolean;

var

SubKey: String;

n: integer;

hTemp: HKEY;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

   SubKey := Copy(Name, 1, n - 1);

   if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

   begin

     Result := True;

     RegCloseKey(hTemp);

   end;

end;

end;

function RegDelValue(RootKey: HKEY; Name: String): boolean;

var

SubKey: String;

n: integer;

hTemp: HKEY;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

   SubKey := Copy(Name, 1, n - 1);

   if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then

   begin

     SubKey := Copy(Name, n + 1, Length(Name) - n);

     Result := (RegDeleteValue(hTemp, PChar(SubKey)) = ERROR_SUCCESS);

     RegCloseKey(hTemp);

   end;

end;

end;

function RegDelKey(RootKey: HKEY; Name: String): boolean;

var

SubKey: String;

n: integer;

hTemp: HKEY;

begin

Result := False;

n := LastPos('\', Name);

if n > 0 then

begin

   SubKey := Copy(Name, 1, n - 1);

   if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then

   begin

     SubKey := Copy(Name, n + 1, Length(Name) - n);

     Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);

     RegCloseKey(hTemp);

   end;

end;

end;

function RegEnum(RootKey: HKEY; Name: String; var ResultList: String; const DoKeys: Boolean): boolean;

var

i: integer;

iRes: integer;

s: String;

hTemp: HKEY;

Buf: Pointer;

BufSize: Cardinal;

begin

Result := False;

ResultList := '';

if RegOpenKeyEx(RootKey, PChar(Name), 0, KEY_READ, hTemp) = ERROR_SUCCESS then

begin

   Result := True;

   BufSize := 1024;

   GetMem(buf, BufSize);

   i := 0;

   iRes := ERROR_SUCCESS;

   while iRes = ERROR_SUCCESS do

   begin

     BufSize := 1024;

     if DoKeys then

       iRes := RegEnumKeyEx(hTemp, i, buf, BufSize, nil, nil, nil, nil)

     else

       iRes := RegEnumValue(hTemp, i, buf, BufSize, nil, nil, nil, nil);

     if iRes = ERROR_SUCCESS then

     begin

       SetLength(s, BufSize);

       CopyMemory(@s[1], buf, BufSize);

       if ResultList = '' then

         ResultList := s

       else

         ResultList := Concat(ResultList, #13#10, s);

       inc(i);

     end;

   end;

   FreeMem(buf);

   RegCloseKey(hTemp);

end;

end;

function RegEnumValues(RootKey: HKEY; Name: String; var ValueList: String): boolean;

begin

Result := RegEnum(RootKey, Name, ValueList, False);

end;

function RegEnumKeys(RootKey: HKEY; Name: String; var KeyList: String): boolean;

begin

Result := RegEnum(RootKey, Name, KeyList, True);

end;

end.

Code:

{ To automatically start a service after its installation use this code }

procedure TMyService.ServiceAfterInstall(Sender: TService);

var

sm: TServiceManager;

begin

sm := TServiceManager.Create;

try

   if sm.Connect then

     if sm.OpenServiceConnection(self.name) then

       sm.StartService;

finally

   sm.Free;

end;

end;