得到已安装的应用程序列表

procedure TForm1.Button1Click(Sender: TObject);

const CLAVE =
  '\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall';

var
  reg    : TRegistry;
  Lista  : TStringList;
  Lista2 : TStringList;
  i,n    : integer;

begin
  {Creamos cosas temporales}
  {Create temporal things}
  reg    := TRegistry.Create;
  Lista  := TStringList.Create;
  Lista2 := TStringList.Create;

  {Cargamos todas las subkeys}
  {Load all the subkeys}
  with Reg do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    OpenKey(CLAVE,false);
    GetKeyNames(Lista);
  end;

  {Cargamos todos los Nombres de valores}
  {Load all the Value Names}
  for i := 0 to Lista.Count -1 do
  begin
    reg.OpenKey(CLAVE + '\' +Lista.Strings[i],false);
    reg.GetValueNames(Lista2);

    {Mostraremos s髄o los que tengan 'DisplayName'}
    {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;
  {Liberamos temporales}
  {Free temporals}
  Lista.Free;
  Lista2.Free;
  reg.CloseKey;
  reg.Destroy;
end;