procedure
TForm1
.
createshotcut(sourcefile, shortcutname,
sourceparams:
string
);
var
IUnk: IUnknown;
ShellLink: IShellLink;
ShellFile: IPersistFile;
tmpShortCutName:
string
;
WideStr:
WideString
;
i:
Integer
;
begin
IUnk := CreateComObject(CLSID_ShellLink);
ShellLink := IUnk
as
IShellLink;
ShellFile := IUnk
as
IPersistFile;
ShellLink
.
SetPath(
PChar
(SourceFile));
ShellLink
.
SetArguments(
PChar
(SourceParams));
ShellLink
.
SetWorkingDirectory(
PChar
(ExtractFilePath(SourceFile)));
ShortCutName := ChangeFileExt(ShortCutName,
'.lnk'
);
if
fileexists(ShortCutName)
then
begin
ShortCutName := copy(ShortCutName,
1
,length(ShortCutName)-
4
);
i :=
1
;
repeat
tmpShortCutName := ShortCutName +
'('
+ inttostr(i)+
').lnk'
;
inc(i);
until
not
fileexists(tmpShortCutName);
WideStr := tmpShortCutName;
end
else
WideStr := ShortCutName;
ShellFile
.
Save(PWChar(WideStr),
False
);
end
;
procedure
TForm1
.
sButton2Click(Sender: TObject);
var
WorkTable:
String
;
P:PItemIDList;
C:
array
[
0..1000
]
of
char
;
begin
if
SHGetSpecialFolderLocation(Handle,CSIDL_DESKTOP,p)=NOERROR
then
begin
SHGetPathFromIDList(P,C);
WorkTable:=StrPas(C);
end
;
if
FileExists(WorkTable+'\'+ExtractFileName(Application
.
ExeName))
then
DeleteFile(WorkTable+'\'+ExtractFileName(Application
.
ExeName));
CreateShotCut(sEdit1
.
Text, WorkTable+'\'+ExtractFileName(sEdit2
.
Text), sEdit3
.
Text);
end
;
procedure
TForm1
.
sButton1Click(Sender: TObject);
begin
if
sopendialog1
.
Execute
then
S:=sOpenDialog1
.
FileName;
sedit1
.
Text:=S;
sButton2
.
Enabled:=
True
;
end
;