读取软件卸载信息和桌面图标列表

  1 unit Main;
  2 
  3 interface
  4 
  5 uses
  6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7   Dialogs, Registry, StdCtrls, ComCtrls, IOUtils, Types;
  8 
  9 type
 10   TForm2 = class(TForm)
 11     pgc1: TPageControl;
 12     ts1: TTabSheet;
 13     lst1: TListBox;
 14     btn1: TButton;
 15     ts2: TTabSheet;
 16     btn2: TButton;
 17     lst2: TListBox;
 18     procedure btn1Click(Sender: TObject);
 19     procedure btn2Click(Sender: TObject);
 20   private
 21     { Private declarations }
 22   public
 23     { Public declarations }
 24   end;
 25 
 26 var
 27   Form2: TForm2;
 28 
 29 function GetShellFolders(strDir: string): string;
 30 function GetTarget(const LinkFile: string): string;
 31 
 32 implementation
 33 
 34 uses ShlObj, ActiveX, ComObj;
 35 {$R *.dfm}
 36 
 37 /// <summary>
 38 /// 读取可卸载软件信息
 39 /// </summary>
 40 /// <param name="Sender"></param>
 41 procedure TForm2.btn1Click(Sender: TObject);
 42 var
 43   reg: TRegistry;
 44   myList: TStringList;
 45   i: integer;
 46   curkey, SName: string;
 47   hasUn: Boolean;
 48 begin
 49   reg := TRegistry.Create;
 50   myList := TStringList.Create;
 51   reg.RootKey := HKEY_LOCAL_MACHINE;
 52   if reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\uninstall', False)
 53     then
 54   Begin
 55     reg.GetKeyNames(myList);
 56     curkey := reg.CurrentPath;
 57     reg.CloseKey;
 58     for i := 0 to myList.Count - 1 do
 59       if reg.OpenKey(curkey + '\' + myList.Strings[i], False) then
 60       Begin
 61         if reg.ValueExists('DisplayName') then
 62           SName := reg.ReadString('DisplayName')
 63         else
 64           SName := myList.Strings[i];
 65         if reg.ValueExists('DisplayVersion') then
 66           SName := SName + ' 版本：' + reg.ReadString('DisplayVersion')
 67         else
 68           SName := myList.Strings[i];
 69         if reg.ValueExists('InstallSource') then
 70           SName := SName + ' 目录：' + reg.ReadString('InstallSource')
 71         else
 72           SName := myList.Strings[i];
 73         if reg.ValueExists('UnInstallString') then
 74         begin
 75           SName := SName + ' 卸载：' + reg.ReadString('UnInstallString');
 76           hasUn := True;
 77         end
 78         else
 79         begin
 80           SName := myList.Strings[i];
 81           hasUn := False;
 82         end;
 83         if hasUn then
 84           lst1.Items.Add(SName);
 85         // ShowMessage(SName);
 86         reg.CloseKey;
 87       end;
 88   end;
 89 end;
 90 
 91 function GetShellFolders(strDir: string): string;
 92 const
 93   regPath = '\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';
 94 var
 95   reg: TRegistry;
 96   strFolders: string;
 97 begin
 98   reg := TRegistry.Create;
 99   try
100     reg.RootKey := HKEY_CURRENT_USER;
101     if reg.OpenKey(regPath, False) then
102     begin
103       strFolders := reg.ReadString(strDir);
104     end;
105   finally
106     reg.Free;
107   end;
108   result := strFolders;
109 end;
110 
111 /// <summary>
112 /// 读取桌面图标
113 /// </summary>
114 /// <param name="Sender"></param>
115 procedure TForm2.btn2Click(Sender: TObject);
116 var
117   path, str: string;
118   files: TStringDynArray;
119 begin
120   path := GetShellFolders('Desktop');
121   files := TDirectory.GetFiles(path, '*.lnk');
122   for str in files do
123     lst2.Items.Add(str + ' 目标：' + GetTarget(str));
124 end;
125 
126 function GetTarget(const LinkFile: string): string;
127 const
128   IID_IPersistFile: TGUID = '{0000010B-0000-0000-C000-000000000046}';
129 var
130   intfLink: IShellLink;
131   IntfPersist: IPersistFile;
132   pfd: _WIN32_FIND_DATA;
133   bSuccess: Boolean;
134 begin
135   result := '';
136   intfLink := CreateComObject(CLSID_ShellLink) as IShellLink;
137   SetString(result, nil, MAX_PATH);
138   {
139     Load方法的第二个参数还可以传递STGM_WRITE或STGM_READWRITE，表示对快捷方式信息的访问权限
140     STGM_READ：只读
141     STGM_WRITE：只写
142     STGM_READWRITE：读写
143     GetPath方法的第三个参数还可以传递SLGP_UNCPRIORITY或SLGP_SHORTPATH，表示返回的目标路径格式
144     SLGP_UNCPRIORIT：UNC网络路径
145     SLGP_SHORTPATH ：DOS 8.3格式路径
146     SLGP_RAWPATH      : 长路径
147     }
148   bSuccess := (intfLink <> nil) and SUCCEEDED
149     (intfLink.QueryInterface(IID_IPersistFile, IntfPersist)) and SUCCEEDED
150     (IntfPersist.Load(PWideChar(WideString(LinkFile)), STGM_READ)) and SUCCEEDED
151     (intfLink.GetPath(PChar(result), MAX_PATH, pfd, SLGP_RAWPATH));
152   if not bSuccess then
153     result := '';
154 end;
155 
156 end.

 

转载于:https://www.cnblogs.com/toosuo/p/3637531.html