[시스템] 프로그램 제거(Uninstall) 목록 구하기

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Registry, ImgList, ShellAPI;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListView1: TListView;
    ImageList1: TImageList;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function LoadSmallIcon(ImageList: TImageList;  FileName: String; ID: integer): Integer;
var
  S: array[0..255] of char;
  IconHandle: hIcon;
  Index: Word;
  MyIcon: TIcon;
begin
  StrPLCopy(S, FileName, SizeOf(S)-1);
  IconHandle := ExtractIcon(hInstance, S, Id);
  if IconHandle < 2 then
  begin
    Index := Id;
    IconHandle := ExtractAssociatedIcon(hInstance, S, Index);
  end;

  MyIcon := TIcon.Create;
  try
    MyIcon.Handle := IconHandle;
    Result := ImageList.AddIcon(MyIcon);
  finally
    MyIcon.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
  UNINST_PATH = 'Software\Microsoft\Windows\CurrentVersion\Uninstall';
var
  Reg : TRegistry;
  SubKey: TSTringList;
  ListItem: TListItem;
  I : Integer;
  sDisplayName, sUninstallString : String;
begin
  with ListView1 do
  begin
    Columns.Add;
    Columns.Add;
    Columns[0].Caption := '프로그램';
    Columns[1].Caption := '제거 명령';
    Columns[0].Width := 200;
    Columns[1].Width := 500;
  end;

  Reg := TRegistry.Create;
  try
    With ListView1.Items do
      try
        BeginUpdate;
        Clear;
        Reg.RootKey := HKEY_LOCAL_MACHINE;
        if Reg.OpenKeyReadOnly(UNINST_PATH) then
        begin
          SubKey := TStringList.Create;
          try
            Reg.GetKeyNames(SubKey);
            Reg.CloseKey;
            for i := 0 to subKey.Count - 1 do
              if Reg.OpenKeyReadOnly(Format('%s\%s', [UNINST_PATH, SubKey[i]])) then
              begin
                try
                  sDisplayName := Reg.ReadString('DisplayName');
                  sUninstallString := Reg.ReadString('UninstallString');
                  if (sDisplayName) <> '' then
                  begin
                    ListItem := Add;
                    ListItem.Caption := sDisplayName;
                    ListItem.SubItems.Add(sUninstallString);
                    if Reg.ReadString('DisplayIcon') <> '' then
                      ListItem.ImageIndex := LoadSmallIcon(ImageList1, Reg.ReadString('DisplayIcon'), 0)
                    else
                      ListItem.ImageIndex := LoadSmallIcon(ImageList1, Reg.ReadString('UninstallString'), 0);
                  end;
                finally
                  Reg.CloseKey;
                end;
            end;
          finally
            SubKey.Free;
          end;
        end;
      finally
        ListView1.AlphaSort;
        EndUpdate;
      end;
  finally
    Reg.CloseKey;
    reg.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListView1.LargeImages := ImageList1;
  ListView1.SmallImages := ImageList1;
  ListView1.ViewStyle := vsReport;
end;

end.