Código: Seleccionar todo

//******************************************************************************
//* UNIT:         UNT_EnumInstalledPrograms
//* AUTOR:        Fakedo0r
//* FECHA:        19.04.2012
//* CORREO:       [email protected]
//* BLOG:         Sub-Soul.blogspot.com
//* USO:          EnumPrograms(' : ');
//******************************************************************************
unit UNT_EnumInstalledPrograms;
//******************************************************************************
//DECLARACIONES DE LIBRERIAS / CLASES
//******************************************************************************
interface

uses
  Winapi.Windows, System.SysUtils, Vcl.Dialogs;
//******************************************************************************
//DECLARACIONES DE FUNCIONES / PROCEDIMIENTOS
//******************************************************************************
function TrimA(sCadena: String): String;
function EnumPrograms(sDelimitador: String): String;
//******************************************************************************
implementation
//******************************************************************************
//<--- ENUMERA LOS PROGRAMAS INSTALADOS JUNTO A SUS UNINSTALL's --->
//******************************************************************************
function EnumPrograms(sDelimitador: String): String;
var
  ihKey:          HKEY;
  ihSubKey:       HKEY;
  dwIndex:        DWORD;
  dwName:         DWORD;
  dwDataSize:     DWORD;
  pszName:        PChar;
  sProName:       String;
  sProPath:       String;
  iRegType:       Integer;
  tLastWriteTime: FileTime;
begin
  dwIndex := 0;
  dwName := 0;
  dwDataSize := 0;
  iRegType := 1;

  if RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\Uninstall', 0, KEY_ENUMERATE_SUB_KEYS, ihKey) = ERROR_SUCCESS then;
  begin
    dwName := 255;
    GetMem(pszName, dwName);

    while RegEnumKeyEx(ihKey, dwIndex, @pszName[0], dwName, nil, nil, nil, @tLastWriteTime) = ERROR_SUCCESS do
    begin
      Inc(dwIndex);
      dwName := 255;

      if RegOpenKeyEx(ihKey, pszName, 0, KEY_QUERY_VALUE, ihSubKey) = ERROR_SUCCESS then
      begin

        if RegQueryValueEx(ihSubKey, 'DisplayName', nil, @iRegType, nil, @dwDataSize) = ERROR_SUCCESS then
        begin
          SetLength(sProName, dwDataSize);
          RegQueryValueEx(ihSubKey, 'DisplayName', nil, @iRegType, PByte(PChar(sProName)), @dwDataSize);

          sProName := TrimA(sProName);

          if RegQueryValueEx(ihSubKey, 'UninstallString', nil, @iRegType, nil, @dwDataSize) = ERROR_SUCCESS then
          begin

            if iRegType = REG_SZ then
            begin
              SetLength(sProPath, dwDataSize);
              RegQueryValueEx(ihSubKey, 'UninstallString', nil, @iRegType, PByte(PChar(sProPath)), @dwDataSize);

              sProPath := TrimA(sProPath);

              Result := Result + sProName + sDelimitador + sProPath + #13#10;
            end;
          end;
        end;
      end;
    end;
  end;
end;
//******************************************************************************
//<--- ELIMINA LOS ESPACIOS DE UNA CADENA --->
//******************************************************************************
function TrimA(sCadena: String): String;
begin
  Result := '';

  if sCadena = '' then Exit;

  while sCadena[1] = ' ' do
  begin
    Delete(sCadena, 1, 1);

    if sCadena = '' then Exit;
  end;

  while sCadena[Length(sCadena)] = ' ' do
  begin
    Delete(sCadena, Length(sCadena), 1);

    if sCadena = '' then Exit;
  end;

  Result := sCadena;
end;
end.