گرفتن نام تمام برنامه های نصب شده در ويندوز

کد:
procedure TForm1.Button1Click(Sender: TObject);

 

const CLAVE =

  '\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall';

 

var

  reg    : TRegistry;

  Lista  : TStringList;

  Lista2 : TStringList;

  i,n    : integer;

 

begin

 {Create temporal things}

  reg    := TRegistry.Create;

  Lista  := TStringList.Create;

  Lista2 := TStringList.Create;



  {Load all the subkeys}

 with Reg do

 begin

    RootKey := HKEY_LOCAL_MACHINE;

    OpenKey(CLAVE,false);

    GetKeyNames(Lista);

  end;



  {Load all the Value Names}

 for i := 0 to Lista.Count -1 do begin 

    reg.OpenKey(CLAVE + '\' +Lista.Strings[i],false);

    reg.GetValueNames(Lista2);



    {We will show only if there is 'DisplayName'}

    n:=Lista2.IndexOf('DisplayName');

    if (n <> -1) and (Lista2.IndexOf('UninstallString')<>-1) then

 begin

 {DisplayName+UnInstallString}

      Memo1.Lines.Append ( reg.ReadString(Lista2.Strings[n])+'-'+

        reg.ReadString(Lista2.Strings[Lista2.IndexOf('UninstallString')]) );

    end;

  end;

  {Free temporals}

  Lista.Free;

  Lista2.Free;

  reg.CloseKey;

  reg.Destroy;

end