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

引用的单元文件到下面链接去找：
http://www.delphitop.com/html/wenjian/2976.html

unit Main;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Registry, StdCtrls, ComCtrls, IOUtils, Types;

type

TForm2 = class(TForm)

pgc1: TPageControl;

ts1: TTabSheet;

lst1: TListBox;

btn1: TButton;

ts2: TTabSheet;

btn2: TButton;

lst2: TListBox;

procedure btn1Click(Sender: TObject);

procedure btn2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

function GetShellFolders(strDir: string): string;

function GetTarget(const LinkFile: string): string;

implementation

uses ShlObj, ActiveX, ComObj;

{$R *.dfm}

///

/// 读取可卸载软件信息

///

procedure TForm2.btn1Click(Sender: TObject);

var

reg: TRegistry;

myList: TStringList;

i: integer;

curkey, SName: string;

hasUn: Boolean;

begin

reg := TRegistry.Create;

myList := TStringList.Create;

reg.RootKey := HKEY_LOCAL_MACHINE;

if reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\uninstall', False)

then

Begin

reg.GetKeyNames(myList);

curkey := reg.CurrentPath;

reg.CloseKey;

for i := 0 to myList.Count - 1 do

if reg.OpenKey(curkey + '\' + myList.Strings[i], False) then

Begin

if reg.ValueExists('DisplayName') then

SName := reg.ReadString('DisplayName')

else

SName := myList.Strings[i];

if reg.ValueExists('DisplayVersion') then

SName := SName + ' 版本：' + reg.ReadString('DisplayVersion')

else

SName := myList.Strings[i];

if reg.ValueExists('InstallSource') then

SName := SName + ' 目录：' + reg.ReadString('InstallSource')

else

SName := myList.Strings[i];

if reg.ValueExists('UnInstallString') then

begin

SName := SName + ' 卸载：' + reg.ReadString('UnInstallString');

hasUn := True;

end

else

begin

SName := myList.Strings[i];

hasUn := False;

end;

if hasUn then

lst1.Items.Add(SName);

// ShowMessage(SName);

reg.CloseKey;

end;

function GetShellFolders(strDir: string): string;

const

regPath = '\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders';

var

reg: TRegistry;

strFolders: string;

begin

reg := TRegistry.Create;

try

reg.RootKey := HKEY_CURRENT_USER;

if reg.OpenKey(regPath, False) then

begin

strFolders := reg.ReadString(strDir);

end;

finally

reg.Free;

end;

result := strFolders;

end;

///

/// 读取桌面图标

///

procedure TForm2.btn2Click(Sender: TObject);

var

path, str: string;

files: TStringDynArray;

begin

path := GetShellFolders('Desktop');

files := TDirectory.GetFiles(path, '*.lnk');

for str in files do

lst2.Items.Add(str + ' 目标：' + GetTarget(str));

end;

function GetTarget(const LinkFile: string): string;

const

IID_IPersistFile: TGUID = '{0000010B-0000-0000-C000-000000000046}';

var

intfLink: IShellLink;

IntfPersist: IPersistFile;

pfd: _WIN32_FIND_DATA; //delphi10.4 用 _WIN32_FIND_DATAW

bSuccess: Boolean;

begin

result := '';

intfLink := CreateComObject(CLSID_ShellLink) as IShellLink;

SetString(result, nil, MAX_PATH);

{

Load方法的第二个参数还可以传递STGM_WRITE或STGM_READWRITE，表示对快捷方式信息的访问权限

STGM_READ：只读

STGM_WRITE：只写

STGM_READWRITE：读写

GetPath方法的第三个参数还可以传递SLGP_UNCPRIORITY或SLGP_SHORTPATH，表示返回的目标路径格式

SLGP_UNCPRIORIT：UNC网络路径

SLGP_SHORTPATH ：DOS 8.3格式路径

SLGP_RAWPATH : 长路径

}

bSuccess := (intfLink <> nil) and SUCCEEDED

(intfLink.QueryInterface(IID_IPersistFile, IntfPersist)) and SUCCEEDED

(IntfPersist.Load(PWideChar(WideString(LinkFile)), STGM_READ)) and SUCCEEDED

(intfLink.GetPath(PChar(result), MAX_PATH, pfd, SLGP_RAWPATH));

if not bSuccess then

result := '';

end;

end.

推荐分享