Delphi编程实现程序快捷方式[原创](2)

MyPFile : IPersistFile; file://用于保存快捷方式的对象
SubDir,Directory,LinkName : string;
WFileName : WideString;
Reg : TRegistry;
begin
Result:=False;
MyObject := CreateCOMObject(CLSID_ShellLink); file://建立快捷方式的COM对象
MySLink := MyObject as IShellLink;
MyPFIle := MyObject as IPersistFile;
MySLink.SetPath(pchar(SourceFileName)); file://设置快捷方式源文件的位置
Reg := TRegistry.Create ;
Reg.RootKey := HKEY_CURRENT_USER;
try
if Reg.OpenKey(REG_SHELLFOLDERS,false) then
begin
if SourceFileName<>'''''''' then
if ShortcutName <>'''''''' then
LinkName := ShortcutName
else
LinkName := ExtractFileName(SourceFileName)
Else file://当源路径是一个空值时，实际它指向“我的电脑”
LinkName := ''''我的电脑'''';

MySLink.SetDescription(pchar(LinkName)); file://设置快捷方式描述
LinkName := ChangeFileExt(LinkName,''''.lnk''''); file://修改扩展名
file://以下通过注册表得到快捷方式的实际建立位置
case ShortcutLocation of
_DESKTOP : Directory := Reg.ReadString(''''Desktop'''');
_STARTMENU : Directory := Reg.ReadString(''''Start Menu'''');
_PROGRAMS: Directory := Reg.ReadString(''''Programs'''');
_STARTUP : Directory := Reg.ReadString(''''Startup'''');
_QUICKLAUNCH:Directory:=Reg.ReadString(''''AppData'''')
''''\Microsoft\Internet Explorer\Quick Launch''''; file://快速启动栏的路径比较特殊
end;
if Directory <> '''''''' then
begin
if SubDirectory <> '''''''' then
begin
SubDir:=Directory ''''\'''' SubDirectory;
WFileName := SubDir ''''\'''' LinkName ;
if not CreateDir(SubDir) then file://创建目录失败
begin
Result:=false;
Exit;
end;
end
else
WFileName := Directory ''''\'''' LinkName;
if MyPFile.Save(PWChar(WFileName),True)<>S_OK then
begin
Result:=False;
Exit;
end
else
Result:=true;
end
else
Result:=False;
end;
finally
Reg.Free ; file://释放空间
end;
end;
3、 编写浏览文件按钮的代码，如下：
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
Edit1.Text := OpenDialog1.FileName ;
end;
4、 同样的步骤编写“退出”按钮的代码：
procedure TForm1.Button3Click(Sender: TObject);
begin
Close;
end;
5、 下面是“创建”按钮的代码，直接调用我们建立的CreateShoutcut()函数来实现：
procedure TForm1.Button2Click(Sender: TObject);
var
SLinkType : ShortcutType;
begin
case ComboBox1.ItemIndex of
0 : SLinkType := _DESKTOP;
1 : SLinkType := _STARTMENU;
2 : SLinkType := _PROGRAMS;
3 : SLinkType := _STARTUP;
4 : SLinkType := _QUICKLAUNCH;
end;
if CreateShortcut(Edit1.Text ,Edit3.Text ,SLinkType, Edit2.Text ) then
Application.MessageBox(pchar(''''快捷方式创建成功!''''),pchar(''''系统消息''''),MB_OK)
else
Application.MessageBox(pchar(''''快捷方式创建失败!''''),pchar(''''系统消息''''),MB_OK);
end;
现在按下F9编译运行这个程序，你就可以试试创建快捷方式的效果了。程序的运行效果如图2：
<P><IMG BORDER="0" SRC="http://www.jyzx.com/bbs/uploadImages/20023134353019903.jpg" WIDTH="408" HEIGHT="290"></P>

当然，你还可以把程序修改后用于你的安装系统，实现个性化的安装程序，那种感觉一定酷毕了！
程序在Windows2000、Delphi6.0下编译通过。

作者：耿百强
地址：中共河南省济源市委党校
邮政编码：454650
联系电话：0391-6666267
E-Mail:dxgbq@sohu.com
OICQ:10562208
写稿日期：2002-3-12

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有