System Delphi

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
// TStrings leeren
Strings.Clear;
// open the specified key
// CurrentKey Schlüssel öffnen
if RegOpenKeyEx(CurrentKey,
PChar(Subkey),
0, KEY_READ, key) = ERROR_SUCCESS then
begin
// retrieve the type and data for a specified value name
// Den Typ und Wert des Eintrags Ermitteln.
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).
// Ein Array von Null-terminierten Strings
// wird zurückgegeben
RegQueryValueEx(key,
PChar(ValueName),
nil,
nil,
PBYTE(buffer),
@valueLen);
// Add values to stringlist
// Werte in String Liste einfügen
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, Testen:
procedure TForm1.Button1Click(Sender: TObject);
begin
ReadREG_MULTI_SZ(HKEY_CURRENT_USER, 'Software\XYZ', 'Test44', Memo1.Lines);
end;
{******************************************}
{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;
{******************************************}
{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;