1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:

uses registry;
procedure TForm1.Button1Click(Sender: TObject);
                    const
                      UNINST_PATH = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall';
                    var
                      Reg      : TRegistry;
                      SubKeys  : TStringList;
                      ListItem : TlistItem;
                      i        : integer; 
                      sDisplayName, sUninstallString: string; 
                    begin 
                     { ListView1.ViewStyle := vsReport; 
                      ListView1.Columns.add; 
                      ListView1.Columns.add; 
                      ListView1.Columns[0].caption := 'DisplayName'; 
                      ListView1.Columns[1].caption := 'UninstallString'; 
                      ListView1.Columns[0].Width := 300; 
                      ListView1.Columns[1].Width := 300;} 
                      Reg := TRegistry.Create; 
                      with Reg do 
                       try
                         with ListView1.items do
                           try 
                             BeginUpdate; 
                             Clear; 
                             RootKey := HKEY_LOCAL_MACHINE; 
                             if OpenKeyReadOnly(UNINST_PATH) then 
                             begin 
                               SubKeys := TStringList.Create; 
                               try 
                                 GetKeyNames(SubKeys); 
                                 CloseKey; 
                                 for i := 0 to subKeys.Count - 1 do 
                                   if OpenKeyReadOnly(Format('%s\%s', [UNINST_PATH, SubKeys[i]])) then 
                                     try 
                                       sDisplayName  := ReadString('DisplayName'); 
                                       sUninstallString := ReadString('UninstallString'); 
                                       if sDisplayName <> '' then 
                                       begin 
                                        ListItem         := add; 
                                        ListItem.Caption := sDisplayName; 
                                        ListItem.subitems.add(sUninstallString); 
                                       end; 
                                      finally 
                                        CloseKey; 
                                      end; 
                               finally 
                                 SubKeys.Free; 
                               end; 
                             end; 
                           finally 
                            ListView1.AlphaSort; 
                            EndUpdate; 
                           end; 
                       finally 
                         closekey; 
                         Free; 
                       end; 
                    end;