unit MuldeR_Shortcut;
interface
uses
SysUtils, Windows, ShlObj,
ActiveX;
type
TShowMode = (smNormal, smMaximized, smMinimized);
procedure CreateShortcut(ShortcutFile:
String; TargetFile:
String; IconFile:
String;
IconIndex:Integer; WorkingDirectory:
String; ShowMode:TShowMode; Description:
String);
implementation
procedure CreateShortcut(ShortcutFile:
String; TargetFile:
String; IconFile:
String;
IconIndex:Integer; WorkingDirectory:
String; ShowMode:TShowMode; Description:
String);
var
sl:IShellLink;
pf:IPersistFile;
Show:Integer;
Success:Boolean;
Error:Boolean;
begin
Success := False;
case ShowMode
of
smMaximized: Show := SW_SHOWMAXIMIZED;
smMinimized: Show := SW_SHOWMINNOACTIVE;
else
Show := SW_SHOWNORMAL;
end;
CoInitialize(
nil);
try
if CoCreateInstance(CLSID_ShellLink,
nil, CLSCTX_INPROC_SERVER, IShellLink, sl) = S_OK
then
begin
Error := False;
if sl.SetPath(PAnsiChar(TargetFile)) <> S_OK
then Error := True;
if sl.SetIconLocation(PAnsiChar(IconFile), IconIndex) <> S_OK
then Error := True;
if sl.SetWorkingDirectory(PAnsiChar(WorkingDirectory)) <> S_OK
then Error := True;
if sl.SetShowCmd(Show) <> S_OK
then Error := True;
if sl.SetDescription(PAnsiChar(Description)) <> S_OK
then Error := True;
if not Error
then
if sl.QueryInterface(IPersistFile, pf) = S_OK
then
if pf.Save(StringToOleStr(ShortcutFile), True) = S_OK
then
Success := True;
end;
finally
CoUninitialize;
end;
if not Success
then raise Exception.Create('
Faild to create shortcut.');
end;
end.