• Earn real money by being active: Hello Guest, earn real money by simply being active on the forum — post quality content, get reactions, and help the community. Once you reach the minimum credit amount, you’ll be able to withdraw your balance directly. Learn how it works.

Delphi EnumInstalledPrograms [UNIT] [Fakedo0r]

Status
Not open for further replies.

Expermicid

Leech
User
Joined
Oct 23, 2011
Messages
285
Reputation
0
Reaction score
255
Points
63
Credits
0
‎13 Years of Service‎
95%
Enumera los programas instalados junto a sus Uninstall's.

EJEMPLO

capturargg.jpg


[lenguaje=delphi]//******************************************************************************

//* 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.[/lenguaje]

Saludos

 
Last edited by a moderator:
Status
Not open for further replies.
Back
Top