如何在桌面添加快捷方式

[OLDBLACKP]

如何在桌面添加快捷方式

[cym830313]

procedure TForm1.Button1Click(Sender: TObject);
var
tmpObject : IUnknown;
tmpSLink : IShellLink;
tmpPFile : IPersistFile;
PIDL : PItemIDList;
StartupDirectory : array[0..MAX_PATH] of Char;
StartupFilename : String;
LinkFilename : WideString;
begin
StartupFilename := ’c:\windows\notepad.exe’;
tmpObject := CreateComObject(CLSID_ShellLink);
tmpSLink := tmpObject as IShellLink;
tmpPFile := tmpObject as IPersistFile;
tmpSLink.SetPath(pChar(StartupFilename));
tmpSLink.SetWorkingDirectory(pChar(ExtractFilePath(StartupFilename)));
SHGetSpecialFolderLocation(0,CSIDL_DESKTOPDIRECTORY,PIDL);
SHGetPathFromIDList(PIDL,StartupDirectory);
LinkFilename := StartupDirectory + ’\MyNotepad.lnk’;
tmpPFile.Save(pWChar(LinkFilename),FALSE);
end;

• 打赏
• 举报

回复 赞

[ekin]

打包的时候可以选择!

• 打赏
• 举报

回复 赞

[miky]

创建快捷方式;获取系统文件或系统目录
(*//
标题:创建快捷方式;获取系统文件或系统目录

说明:参考Kingron资料中“如何取得某些特殊文件夹路径”

设计:Zswang

日期:2002-01-25

支持:[e-mail]

//*)

///////Begin Source

uses

ShlObj, ActiveX, ComObj;

function GetSpecialFolderDir(mFolder: Integer): string;

{ 返回获取系统文件或系统目录 }

(*

CSIDL_BITBUCKET * 回收站

CSIDL_CONTROLS * 控制面板

CSIDL_DESKTOP * 桌面

CSIDL_DESKTOPDIRECTORY 桌面目录 //如C:

CSIDL_DRIVES * 我的电脑

CSIDL_FONTS 字体 //如C:

CSIDL_NETHOOD 网上邻居目录 //如C:

CSIDL_NETWORK * 网上邻居

CSIDL_PERSONAL 我的文档 //如C:Documents

CSIDL_PRINTERS * 打印机

CSIDL_PROGRAMS 程序组 //如C:Menu

CSIDL_RECENT 最近文档 //如C:

CSIDL_SENDTO 发送到 //如C:

CSIDL_STARTMENU 开始菜单 //如C:Menu

CSIDL_STARTUP 启动 //如C:\u21551启动

CSIDL_TEMPLATES 模版 //如C:

*)

var

vItemIDList: PItemIDList;

vBuffer: array[0..MAX_PATH] of Char;

begin

SHGetSpecialFolderLocation(0, mFolder, vItemIDList);

SHGetPathFromIDList(vItemIDList, vBuffer); //转换成文件系统的路径

Result := vBuffer;

end; { GetSpecialFolderDir }

function CreateShellLink(mPath: string; mWorkingDirectory: string;

mFileName: WideString): Boolean; { 返回创建快捷方式是否成功 }

var

vShellLink: IShellLink;

vPersistFile: IPersistFile;

vUnKnown: IUnKnown;

begin

Result := True;

try

vUnKnown := CreateComObject(CLSID_ShellLink);

vShellLink := vUnKnown as IShellLink;

vPersistFile := vUnKnown as IPersistFile;

vShellLink.SetPath(PChar(mPath));

vShellLink.SetWorkingDirectory(PChar(mWorkingDirectory));

vPersistFile.Save(PWChar(mFileName), False);

except

Result := False;

end;

end; { CreateShellLink }

///////End Source

///////Begin Demo

procedure TForm1.Button1Click(Sender: TObject);

begin

CreateShellLink(ParamStr(0), ExtractFilePath(ParamStr(0)),

GetSpecialFolderDir(CSIDL_DESKTOPDIRECTORY) + ' +

ChangeFileExt(ExtractFileName(ParamStr(0)), '.lnk'));

end;

///////End Demo

• 打赏
• 举报

回复 赞