Reading registry.dat under Windows with Object Pascal

Leigh Harrison Thu, 04 Sep 2003 13:49:59 -0700

unit hsiNetscapeRegistry;

{Note that this implementation doesn't deal with data types other than strings,
because that was all we needed for our purposes (identifying the location of
the Netscape cert7/8, key3 and secmod files). This could readily be added.}

interface

uses
Windows, Classes, Sysutils;

type
TRegDataType = (
rdtKey,
rdtValue);

PRegEntry = ^TRegEntry;
TRegEntry = record
    dwLocation: DWord;
    dwNamePtr: DWord;
    wNameLen: Word;
    wType: Word;
    dwLeft: DWord;
    dwDown: DWord;
    dwValuePtr: DWord;
    dwValueLen: DWord;
    dwParent: DWord;
end;

PDataRec = ^TDataRec;
TDataRec = record
    Parent: PDataRec;
    DataType: TRegDataType;
    Name: String;
    Value: String;
    Children: TList;
end;

TNSRegistry = class(TObject)
private
    FStream: TFileStream;
    FRootData: PDataRec;
    procedure ReadRegistry(const ARegFile: String);
    procedure ClearData(DataRec: PDataRec);
    function CreateData(dwLoc, dwOwner: DWord; drParent: PDataRec): PDataRec;
    function ReadString(dwPos, dwLen: DWord): String;
    function GetKey(sKey: String; drParent: PDataRec): PDataRec;
public
    constructor Create(const ARegFile: String);
    destructor Destroy; override;
    procedure DumpData(const sFile: String);
    function GetKeyList(const sParent: String): String;
    function GetValueList(const sParent: String): String;
    function ValueExists(const sKey: String): Boolean;
    function ReadValue(const sKey: String): String;
end;

implementation

constructor TNSRegistry.Create(const ARegFile: String);
begin
FRootData := nil;
inherited Create;

if not FileExists(ARegFile) then
Exit;

ReadRegistry(ARegFile);
end;

destructor TNSRegistry.Destroy;
begin
ClearData(FRootData);
inherited Destroy;
end;

procedure TNSRegistry.ReadRegistry(const ARegFile: String);
var
dwLoc: DWord;
begin
FStream := TFileStream.Create(ARegFile, fmOpenRead);

try
    FStream.Seek(12, soFromBeginning);
    FStream.Read(dwLoc, SizeOf(DWord));
    FRootData := CreateData(dwLoc, 0, nil);
finally
    FStream.Free;
end;
end;

procedure TNSRegistry.ClearData(DataRec: PDataRec);
var
intA: Integer;
begin
if assigned(DataRec) then begin
for intA := 0 to DataRec^.Children.Count - 1 do
ClearData(PDataRec(DataRec^.Children[intA]));

Dispose(DataRec);
end;
end;

function TNSRegistry.CreateData(
dwLoc, dwOwner: DWord; drParent: PDataRec): PDataRec;
var
RegEntry: PRegEntry;
begin
Result := nil;

{Pointer integrity checks.}
if (dwLoc < 13) or (dwLoc >= DWord((FStream.Size - SizeOf(TRegEntry)))) then
Exit;

RegEntry := New(PRegEntry);

try
    {Load record containing data locations.}
    FStream.Seek(dwLoc, soFromBeginning);
    FStream.Read(RegEntry^, SizeOf(TRegEntry));

    with RegEntry^ do begin
      {record data integrity checks.}
      if (dwLoc <> dwLocation) or (dwOwner <> dwParent) then
        Exit;

      Result := New(PDataRec);
      Result^.Parent := drParent;
      Result^.Name := ReadString(dwNamePtr, wNameLen);
      Result^.Children := TList.Create;

      if wType = 1 then begin
        Result^.DataType := rdtKey;
        Result^.Value := '';

if dwValuePtr <> 0 then
CreateData(dwValuePtr, dwLocation, Result);

        if dwDown <> 0 then
          CreateData(dwDown, dwLocation, Result);
      end
      else begin
        Result^.DataType := rdtValue;
        Result^.Value := ReadString(dwValuePtr, dwValueLen);
      end;

      if dwLeft <> 0 then
        CreateData(dwLeft, dwOwner, drParent);
    end;

    if assigned(drParent) then
      drParent^.Children.Add(Result);
finally
    Dispose(RegEntry);
end;
end;

function TNSRegistry.ReadString(dwPos, dwLen: DWord): String;
var
sTemp: String;
intA: Integer;
begin
Result := '';
SetLength(sTemp, dwLen);
FStream.Seek(dwPos, soFromBeginning);
FStream.Read(PChar(sTemp)^, dwLen);

for intA := 1 to dwLen do begin
if sTemp[intA] <> #0 then
Result := Result + sTemp[intA];
end;
end;

procedure TNSRegistry.DumpData(const sFile: String);
var
DataList: TStringlist;

{DumpData outputs the database to a text file, indented to illustrate the
relationships between the levels of data. This is for testing only.}

procedure AddToList(DataRec: PDataRec; sIndent: String);
var
    intA: Integer;
begin
    with DataRec^ do begin
      if Value <> '' then
        DataList.Add(Format('%s%s=%s', [sIndent, Name, Value]))
      else
        DataList.Add(sIndent + Name);

for intA := 0 to Children.Count - 1 do
AddToList(PDataRec(Children[intA]), sIndent + ' ');

      if Children.Count > 0 then
        DataList.Add(#13#10);
    end;
end;

begin
DataList := TStringlist.Create;

try
    AddToList(FRootData, '');
    DataList.SaveToFile(sFile);
finally
    DataList.Free;
end;
end;

function TNSRegistry.GetKeyList(const sParent: String): String;
var
DataRec: PDataRec;
intA: Integer;
begin
{Returns all the keys under sParent, CRLF separated so they can be pumped
into a Stringlist's .Text member.}
Result := '';

if Pos('/\', sParent) = 1 then
DataRec := GetKey(Copy(sParent, 3, Length(sParent)), FRootData)
else
DataRec := GetKey(sParent, FRootData);

if DataRec = nil then
Exit;

for intA := 0 to DataRec^.Children.Count - 1 do begin
    if PDataRec(DataRec^.Children[intA])^.DataType = rdtKey then begin
      if Result = '' then
        Result := PDataRec(DataRec^.Children[intA])^.Name
      else
        Result := Result + #13#10 + PDataRec(DataRec^.Children[intA])^.Name;
    end;
end;
end;

function TNSRegistry.GetValueList(const sParent: String): String;
var
DataRec: PDataRec;
intA: Integer;
begin
{Returns all the value names under sParent, CRLF separated so they can be
pumped into a Stringlist's .Text member.}
Result := '';

if Pos('/\', sParent) = 1 then
DataRec := GetKey(Copy(sParent, 3, Length(sParent)), FRootData)
else
DataRec := GetKey(sParent, FRootData);

for intA := 0 to DataRec^.Children.Count - 1 do begin
    if PDataRec(DataRec^.Children[intA])^.DataType = rdtValue then begin
      if Result = '' then
        Result := PDataRec(DataRec^.Children[intA])^.Name
      else
        Result := Result + #13#10 + PDataRec(DataRec^.Children[intA])^.Name;
    end;
end;
end;

function TNSRegistry.ValueExists(const sKey: String): Boolean;
var
intA: Integer;
sTemp: String;
DataRec: PDataRec;
begin
{Returns false if the key doesn't exist or the key has no value.}
Result := False;
intA := Length(sKey);

while sKey[intA] <> '\' do
Dec(intA);

sTemp := Copy(sKey, intA + 1, Length(sKey));

if Pos('/\', sKey) = 1 then
DataRec := GetKey(Copy(sKey, 3, intA - 3), FRootData)
else
DataRec := GetKey(Copy(sKey, 1, intA - 1), FRootData);

if not assigned(DataRec) then
Exit;

{Do a case-insensitive check just in case.}
for intA := 0 to DataRec^.Children.Count - 1 do begin
    if PDataRec(DataRec^.Children[intA])^.DataType = rdtValue then begin
      if Lowercase(sTemp) = Lowercase(PDataRec(DataRec^.Children[intA])^.Name)
      then begin
        Result := True;
        Break;
      end;
    end;
end;
end;

function TNSRegistry.ReadValue(const sKey: String): String;
var
intA: Integer;
sTemp: String;
DataRec: PDataRec;
begin
{Returns the value for the key if it exists, or an empty string if it
doesn't.}
Result := '';
intA := Length(sKey);

while sKey[intA] <> '\' do
Dec(intA);

sTemp := Copy(sKey, intA + 1, Length(sKey));

if Pos('/\', sKey) = 1 then
DataRec := GetKey(Copy(sKey, 3, intA - 3), FRootData)
else
DataRec := GetKey(Copy(sKey, 1, intA - 1), FRootData);

if not assigned(DataRec) then
Exit;

function TNSRegistry.GetKey(sKey: String; drParent: PDataRec): PDataRec;
var
sAtom: String;
intA: Integer;
begin
Result := nil;
intA := Pos('\', sKey);

if intA = 0 then begin
    sAtom := sKey;
    sKey := '';
end
else begin
    sAtom := Copy(sKey, 1, intA - 1);
    sKey := Copy(sKey, intA + 1, Length(sKey));
end;

for intA := 0 to drParent^.Children.Count - 1 do begin
    if Lowercase(PDataRec(drParent^.Children[intA])^.Name) = Lowercase(sAtom)
    then begin
      if sKey = '' then
        Result := PDataRec(drParent^.Children[intA])
      else
        Result := GetKey(sKey, PDataRec(drParent^.Children[intA]));

Break;
end;
end;
end;

end.

Reading registry.dat under Windows with Object Pascal

Reply via email to