Enumera los programas instalados junto a sus Uninstall's.
//******************************************************************************
//* 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.
Saludo.
Como siempre, ENORME. Bonito code ;)