Search For Registry Keys / Values - Malware Gallery

search-for-registry-keys-values.pas

// ...

uses
 System.SysUtils, Winapi.Windows, Generics.Collections, System.RegularExpressions;

// ...

type
  TRegistryHive = (
    rhClassesRoot,
    rhLocalMachine,
    rhCurrentUser,
    rhUsers,
    rhCurrentConfig
  );

  TRegistryHives = set of TRegistryHive;

  TRegistrySearchForKind = (
    rsfKeyName,
    rsfValueName,
    rsfValueData
  );

  TRegistrySearchForKinds = set of TRegistrySearchForKind;

  TRegistrySearchResult = class
  public
    function ToString() : String; Virtual; Abstract;
  end;

  TRegistryMatchKey = class(TRegistrySearchResult)
  private
    FKeyName : String;
    FKeyPath : String;
  public
    {@C}
    constructor Create(const AKeyName : String; const AKeyPath : String);

    {@M}
    function ToString() : String; override;

    {@G}
    property KeyName : String read FKeyName;
    property KeyPath : String read FKeyPath;
  end;

  TRegistryMatchValueName = class(TRegistrySearchResult)
  private
    FKeyPath   : String;
    FValueName : String;
  public
    {@C}
    constructor Create(const AKeyPath, AValueName : String);

    {@M}
    function ToString() : String; override;

    {@G}
    property KeyPath   : String read FKeyPath;
    property ValueName : String read FValueName;
  end;

  TRegistryMatchValueData = class(TRegistryMatchValueName)
  private
    FValueData : String;
  public
    {@C}
    constructor Create(const AKeyPath, AValueName, AValueData : String); overload;

    {@M}
    function ToString() : String; override;

    {@G}
    property ValueData : String read FValueData;
  end;

(* TRegistryMatchKey *)

constructor TRegistryMatchKey.Create(const AKeyName : String; const AKeyPath : String);
begin
  inherited Create();
  ///

  FKeyName := AKeyName;
  FKeypath := AKeyPath;
end;

function TRegistryMatchKey.ToString() : String;
begin
  result := Format('[Matching Key] Name: `%s` (Location: `%s`)', [FKeyName, FKeyPath]);
end;

(* TRegistryMatchValueName *)

constructor TRegistryMatchValueName.Create(const AKeyPath, AValueName : String);
begin
  inherited Create();
  ///

  FKeyPath := AKeyPath;
  FValueName := AValueName;
end;

function TRegistryMatchValueName.ToString() : String;
begin
  result := Format('[Matching Value Name] Name: `%s` (Location: `%s`)', [
    FValueName,
    FKeyPath
  ]);
end;

(* TRegistryMatchValueData *)

constructor TRegistryMatchValueData.Create(const AKeyPath, AValueName, AValueData : String);
begin
  inherited Create(AKeyPath, AValueName);
  ///

  FValueData := AValueData;
end;

function TRegistryMatchValueData.ToString() : String;
begin
  result := Format('[Matching Value Data] Data: `%s`, Name: `%s` (Location: `%s`)', [
    FValueData,
    FValueName,
    FKeyPath
  ]);
end;

(* Local *)

// ...

function RegistrySearch(
  // --- Parameters Begin ---
  var AResults : TList<TRegistrySearchResult>;
  const ASearchFor : String;
  const ATargetHives : TRegistryHives = []; (* All *)
  const ASearchForKinds : TRegistrySearchForKinds = [] (* All *)
  // --- Parameters End ---
) : Cardinal;

  function IsMatch(const ACandidate : String) : Boolean;
  begin
    result := TRegEx.IsMatch(ACandidate, ASearchFor, [roIgnoreCase]);
  end;

  procedure RecursiveSearch(const AHive : HKEY; AKeyPath : String = '');
  begin
    var AKeys := TList<String>.Create();
    var AValues := TDictionary<String, String>.Create();
    try
      try
        EnumerateRegistryKeys(AHive, AKeyPath, AKeys, AValues);
      except
        Exit(); // Ignore exceptions (Silent)
      end;
      ///

      // Value name + Data
      for var AValueName in AValues.Keys do begin
        var AValueData : String;

        if not AValues.TryGetValue(AValueName, AValueData) then
          continue;
        ///

        // Value name match
        if IsMatch(AValueName) and ((rsfValueName in ASearchForKinds) or (ASearchForKinds = [])) then
          AResults.Add(TRegistryMatchValueName.Create(AKeyPath, AValueName));

        // Value data match
        if IsMatch(AValueData) and ((rsfValueData in ASearchForKinds) or (ASearchForKinds = [])) then
          AResults.Add(TRegistryMatchValueData.Create(AKeyPath, AValueName, AValueData));
      end;

      // Recursion + Key match
      for var AKey in AKeys do begin
        if not String.IsNullOrWhiteSpace(AKeyPath) then
          AKeyPath := IncludeTrailingPathDelimiter(AKeyPath);

        // Key match
        if IsMatch(AKey) and ((rsfKeyName in ASearchForKinds) or (ASearchForKinds = [])) then
          AResults.Add(TRegistryMatchKey.Create(AKey, AKeyPath));

        ///
        RecursiveSearch(AHive, AKeyPath + AKey);
      end;
    finally
      FreeAndNil(AValues);
      FreeAndNil(AKeys);
    end;
  end;

begin
  result := 0;
  ///

  if not Assigned(AResults) then
    AResults := TList<TRegistrySearchResult>.Create();
  ///

  if String.IsNullOrWhiteSpace(ASearchFor) then
    Exit();

  var AHives := TList<HKEY>.Create();
  try
    if (rhClassesRoot in ATargetHives) or (ATargetHives = []) then
      AHives.Add(HKEY_CLASSES_ROOT);

    if (rhLocalMachine in ATargetHives) or (ATargetHives = []) then
      AHives.Add(HKEY_LOCAL_MACHINE);

    if (rhCurrentUser in ATargetHives) or (ATargetHives = []) then
      AHives.Add(HKEY_CURRENT_USER);

    if (rhUsers in ATargetHives) or (ATargetHives = []) then
      AHives.Add(HKEY_USERS);

    if (rhCurrentConfig in ATargetHives) or (ATargetHives = []) then
      AHives.Add(HKEY_CURRENT_CONFIG);

    for var AHive in AHives do
      RecursiveSearch(AHive);

    ///
    result := AResults.Count;
  finally
    FreeAndNil(AHives);
  end;
end;

// ...

begin
  try
    var AResults := TList<TRegistrySearchResult>.Create();
    try
      var AMatchs := RegistrySearch(AResults, 'vmware', [rhCurrentUser]);

      // var AMatchs := RegistrySearch(AResults, 'vmware|jples', [], [rsfKeyName, rsfValueData]);

      if AMatchs = 0 then
        WriteLn('Nothing found so far!')
      else begin
        for var AResult in AResults do
          WriteLn(AResult.ToString());
      end;
    finally
      FreeAndNil(AResults);
    end;
  except
    on e : Exception do
      WriteLn(e.Message);
  end;

// ...