Author: Tomas Rutkauskas
How do I create a Desktop icon for my application when it runs?
Answer:
Solve 1:
This is a unit to create a link in any folder you want, including the Windows
Desktop:
1 unit ShellLink;
2
3 uses
4 SysUtils, ShlObj, OLE2, Windows, Registry;
5
6 interface
7 procedure OLECheck(OleRetVal: HResult);
8 function GetShellLink: IShellLink;
9 function GetFolderLocation(const FolderType: string): string;
10 function ChangeFileExt(FileName, Ext: string): string;
11 function CreateLink(const AppName, LinkName, Desc, Dest: string): string;
12
13 implementation
14
15 procedure OLECheck(OleRetVal: HResult);
16 {Checks the HResult return value of an OLE function. Raises an exception if value
17 is
18 something other than S_OK. }
19 const
20 OleErrStr = 'OLE function call failed. HResult is $%x. GetLastError is $%x';
21 begin
22 if OleRetVal <> S_OK then
23 raise EShellOleError.CreateFmt(OleErrStr, [OleRetVal, GetLastError]);
24 end;
25
26 function GetShellLink: IShellLink;
27 { Returns reference to ISHellLink object }
28 begin
29 OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
30 IID_IShellLink, Result));
31 end;
32
33 function GetFolderLocation(const FolderType: string): string;
34 { Retrieves from registry path to folder indicated in FolderType }
35 var
36 Reg: TRegistry;
37 begin
38 Reg := TRegistry.Create;
39 try
40 with Reg do
41 begin
42 RootKey := HKEY_CURRENT_USER;
43 if not OpenKey(SFolderKey, False) then
44 { Open key where shell folder information is kept }
45 raise ERegistryException.CreateFmt('Folder key "%s" not found',
46 [SFolderKey]);
47 { Get path for specified folder }
48 Result := ReadString(FolderType);
49 if Result = '' then
50 raise ERegistryException.CreateFmt('"%s" item not found in registry',
51 [FolderType]);
52 CloseKey;
53 end;
54 finally
55 Reg.Free;
56 end;
57 end;
58
59 function ChangeFileExt(FileName, Ext: string): string;
60 var
61 aFn: string;
62 begin
63 aFn := ExtractFileName(FileName);
64 delete(aFn, length(aFn) - 2, 3);
65 aFn := aFn + Ext;
66 Result := aFn;
67 end;
68
69 function CreateLink(const AppName, LinkName, Desc, Dest: string): string;
70 { Creates a shell link for application or document specified in AppName with
71 description Desc. Link will be located in folder specified by Dest, which is one of
72 the string constants shown at the top of this unit. Returns the full path name of
73 the link file. }
74 var
75 SL: IShellLink;
76 PF: IPersistFile;
77 LnkName: string;
78 WStr: array[0..MAX_PATH - 1] of WideChar;
79 begin
80 SL := GetShellLink;
81 try
82 { The IShellLink Interface supports the IPersistFile interface. Get an
83 interface pointer to it. }
84 OleCheck(SL.QueryInterface(IID_IPersistFile, PF));
85 try
86 OleCheck(SL.SetPath(PChar(AppName))); {set link path to proper file}
87 if Desc <> '' then
88 OleCheck(SL.SetDescription(PChar(Desc))); {set description}
89 { create a path location and filename for link file }
90 LnkName := Dest + '\' + linkName;
91 { If you want to create a link to"Desktop", you must call
92 GetFolderLocation('Desktop') }
93 { convert the link file pathname to a PWideChar }
94 StringToWideChar(LnkName, WStr, MAX_PATH);
95 PF.Save(WStr, True); {save link file}
96 finally
97 PF.Release;
98 end;
99 finally
100 SL.Release;
101 end;
102 Result := LnkName;
103 end;
104 initialization
105 OleInitialize(nil);
106 finalization
107 OleUninitialize;
108
109 //Example:
110
111 uses
112 shellLink;
113
114 var
115 lnkName: string;
116 FileToInstall: string;
117 LinkFile: string;
118 comment: string;
119 Dest: string; { destination's folder }
120 begin
121 FileToInstall := 'Example.exe';
122 LinkFile := 'Example.lnk';
123 Comment := 'Link to Example.exe';
124 Dest := GetFolderLocation('Desktop')
125 lnkName := CreateLink(FileToInstall, LinkFile, Comment, Dest);
126 end;
Solve 2:
127 uses
128 Registry, ShlObj, ActiveX, ComObj;
129
130 type
131 ShortcutType = (_DESKTOP, _STARTMENU);
132
133 procedure CreateShortcut(FileName: string; Location: ShortcutType);
134 var
135 MyObject: IUnknown;
136 MySLink: IShellLink;
137 MyPFile: IPersistFile;
138 Directory, LinkName: string;
139 WFileName: WideString;
140 MyReg: TRegIniFile;
141 begin
142 MyObject := CreateComObject(CLSID_ShellLink);
143 MySLink := MyObject as IShellLink;
144 MyPFile := MyObject as IPersistFile;
145 MySLink.SetPath(PChar(FileName));
146 MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer');
147 try
148 LinkName := ChangeFileExt(FileName, '.lnk');
149 LinkName := ExtractFileName(LinkName);
150 if Location = _DESKTOP then
151 begin
152 {Use the next line of code to put the shortcut on your desktop}
153 Directory := MyReg.ReadString('Shell Folders', 'Desktop', '');
154 WFileName := Directory + '\' + LinkName;
155 MyPFile.Save(PWChar(WFileName), False);
156 end;
157 if Location = _STARTMENU then
158 begin
159 {Use the next two lines to put the shortcut on your start menu}
160 Directory := MyReg.ReadString('Shell Folders', 'Start Menu', '');
161 CreateDir(Directory);
162 WFileName := Directory + '\' + LinkName;
163 MyPFile.Save(PWChar(WFileName), False);
164 end;
165 finally
166 MyReg.Free;
167 end;
168 end;
Solve 3:
169
170 { uses ShlObj, ActiveX, ComObj, SysUtils, etc... }
171 { "DestFolder" should be one of the CSIDL_ constants as declared in the ShlObj unit
172 }
173
174 procedure CreateProgramShortcut(DestFolder: Integer; const Applic: string);
175 var
176 SL: IShellLink;
177 PF: IPersistFile;
178 LnkName: WideString;
179 FP: array[0..MAX_PATH * 2] of Char;
180 IDL: PItemIDList;
181 begin
182 CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, SL);
183 PF := SL as IPersistFile;
184 { Make shortcut point to Application.Exename }
185 SL.SetPath(PChar(Applic));
186 { Set input paramters (if any) }
187 { Set default directory to exe-file's location }
188 SL.SetWorkingDirectory(PChar(ExtractFilePath(Applic)));
189 { Use the exe-file's icon }
190 SL.SetIconLocation(PChar(Applic), 0);
191 { Just leaving the following fields empty for now. Could be adjusted if the
192 customer must have these set }
193 SL.SetArguments('');
194 SL.SetDescription('');
195 SL.SetShowCmd(0);
196 SL.SetHotKey(0);
197 { Resolve the path-name of the special folder }
198 if SHGetSpecialFolderLocation(0, DestFolder, IDL) = NOERROR then
199 SHGetPathFromIDList(IDL, FP);
200 { save the file as "Exename.lnk" }
201 LnkName := WideString(FP) + '\' + ExtractFilename(ChangeFileExt(Applic, '.lnk'));
202 PF.Save(PWideChar(LnkName), True);
203 end;
204
205 {Now you can just paste this procedure into your project and then, the only thing
206 to do is to call something like this:}
207
208 { Create a shortcut to current exe on the desktop }
209 CreateProgramShortcut(CSIDL_DESKTOP, ParamStr(0));
210 { Create a shortcut to notepad in the start-menu }
211 CreateProgramShortcut(CSIDL_STARTMENU, 'c:\windwos\notepad.exe');
Solve 4:
Following code originates from a DragDrop demo of Angus Johnson and Anders Melander:
212 uses
213 ActiveX, ShlObj, ComObj;
214
215 {Create a file link}
216
217 function CreateLink(SourceFile, ShortCutName: string): string;
218 var
219 IUnk: IUnknown;
220 ShellLink: IShellLink;
221 IPFile: IPersistFile;
222 tmpShortCutName: string;
223 WideStr: WideString;
224 i: integer;
225 begin
226 IUnk := CreateComObject(CLSID_ShellLink);
227 ShellLink := IUnk as IShellLink;
228 IPFile := IUnk as IPersistFile;
229 with ShellLink do
230 begin
231 SetPath(PChar(SourceFile));
232 SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));
233 end;
234 ShortCutName := ChangeFileExt(ShortCutName, '.lnk');
235 if FileExists(ShortCutName) then
236 begin
237 ShortCutName := Copy(ShortCutName, 1, Length(ShortCutName) - 4);
238 i := 1;
239 repeat
240 tmpShortCutName := ShortCutName + '(' + IntToStr(i) + ').lnk';
241 Inc(i);
242 until
243 not FileExists(tmpShortCutName);
244 Result := tmpShortCutName;
245 end
246 else
247 Result := ShortCutName;
248 WideStr := Result;
249 IPFile.Save(PWChar(WideStr), False);
250 end;
Usage is similar as with CopyFile but instead of actual copying it, it creates a
shortcut to the sourcefile.
CreateLink('c:\apath\afile.ext', 'c:\anotherpath\afile.ext');
Solve 5:
251
252 {Shortcut Component for Delphi 2.0 by Elliott Shevin, Oak Park, Mich. USA
253 April, 1999
254 email: shevine@aol.com
255 version 1.1.
256
257 Includes the following corrections:
258 The Write method doesn't set a hot key if that property is not greater than space.
259 The correct values are used for ShowCmd.
260
261 This component incorporates the shortcut read function of TShellLink by Radek Voltr
262 with shortcut creation code from Jordan Russell, who merits special thanks for
263 reviewing and improving the code.
264
265 This is a freeware component. Use it any way you like, but please report errors and
266 improvements to me, and acknowledge Radek and Jordan.}
267 unit ShortcutLink;
268
269 {$IFNDEF VER80}{$IFNDEF VER90}{$IFNDEF VER93}
270 {$DEFINE Delphi3orHigher}
271 {$ENDIF}{$ENDIF}{$ENDIF}
272
273 interface
274
275 uses
276 Windows, Messages, SysUtils, Classes, Forms,
277 {$IFNDEF Delphi3orHigher}
278 OLE2,
279 {$ELSE}
280 ActiveX, ComObj,
281 {$ENDIF}
282 ShellAPI, ShlObj, CommCtrl, StdCtrls;
283
284 const
285 SLR_NO_UI = $0001;
286 SLR_ANY_MATCH = $0002;
287 SLR_UPDATE = $0004;
288 SLGP_SHORTPATH = $0001;
289 SLGP_UNCPRIORITY = $0002;
290 Error_Message = 'Unable to create .lnk file';
291 {$IFDEF Delphi3orHigher}
292 IID_IPersistFile: TGUID = (D1: $0000010B; D2: $0000; D3: $0000;
293 D4: ($C0, $00, $00, $00, $00, $00, $00, $46));
294 {$ENDIF}
295
296 type
297 EShortcutError = class(Exception);
298 TShowCmd = (scShowMaximized, scShowMinimized, scShowNormal);
299
300 type
301 TShortcutLink = class(TComponent)
302 private
303 { Private declarations }
304 protected
305 { Protected declarations }
306 fShortcutFile, fTarget, fWorkingDir, fDescription, fArguments, fIconLocation:
307 string;
308 fIconNumber, fHotKey: Word;
309 fShowCmd: integer;
310 procedure fSetHotKey(c: string);
311 function fGetHotKey: string;
312 procedure fSetShowCmd(c: TShowCmd);
313 function fGetShowCmd: TShowCmd;
314 function fGetDesktopFolder: string;
315 function fGetProgramsFolder: string;
316 function fGetStartFolder: string;
317 function fGetStartupFolder: string;
318 function fGetSpecialFolder(nFolder: integer): string;
319 public
320 { Public declarations }
321 procedure read;
322 procedure write;
323 property DesktopFolder: string read fGetDesktopFolder;
324 property ProgramsFolder: string read fGetProgramsFolder;
325 property StartFolder: string read fGetStartFolder;
326 property StartupFolder: string read fGetStartupFolder;
327 published
328 { Published declarations }
329 property ShortcutFile: string read fShortcutFile write fShortcutFile;
330 property Target: string read fTarget write fTarget;
331 property WorkingDir: string read fWorkingDir write fWorkingDir;
332 property Description: string read fDescription write fDescription;
333 property Arguments: string read fArguments write fArguments;
334 property IconLocation: string read fIconLocation write fIconLocation;
335 property HotKey: string read fGetHotKey write fSetHotKey;
336 property ShowCmd: TShowCmd read fGetShowCmd write fSetShowCmd default
337 scShowNormal;
338 property IconNumber: Word read fIconNumber write fIconNumber;
339 end;
340
341 procedure register;
342
343 implementation
344
345 procedure register;
346 begin
347 RegisterComponents('Win95', [TShortcutLink]);
348 end;
349
350 {This is the Read method, which reads the link to which fShortcutFile points. It
351 was SetSelfPath in Radek Voltr's TShellLink component, where setting the
352 ShortcutFile property caused the shortcut file to be read immediately.}
353
354 procedure TShortcutLink.read;
355 var
356 X3: PChar;
357 hresx: HResult;
358 Psl: IShellLink;
359 Ppf: IPersistFile;
360 Saver: array[0..Max_Path] of WideChar;
361 X1: array[0..MAX_PATH - 1] of Char;
362 Data: TWin32FindData;
363 I, Y: Integer;
364 W: Word;
365 begin
366 hresx := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
367 {$IFDEF Delphi3orHigher}IID_IShellLinkA
368 {$ELSE}IID_IShellLink
369 {$ENDIF}, psl);
370 if hresx <> 0 then
371 Exit;
372 hresx := psl.QueryInterface(IID_IPersistFile, ppf);
373 if hresx <> 0 then
374 Exit;
375 X3 := StrAlloc(MAX_PATH);
376 StrPCopy(X3, fShortcutFile);
377 MultiByteToWideChar(CP_ACP, 0, X3, -1, Saver, Max_Path);
378 hresx := ppf.Load(Saver, STGM_READ);
379 if hresx <> 0 then
380 begin
381 raise EShortcutError.Create('Unable to open link file');
382 Exit;
383 end;
384 hresx := psl.Resolve(0, SLR_ANY_MATCH);
385 if hresx <> 0 then
386 Exit;
387 hresx := psl.GetWorkingDirectory(@X1, MAX_PATH);
388 if hresx <> 0 then
389 begin
390 raise EShortcutError.Create('Error in getting WorkingDir');
391 Exit;
392 end;
393 fWorkingDir := StrPas(@X1);
394 hresx := psl.GetPath(@X1, MAX_PATH, Data, SLGP_UNCPRIORITY);
395 if hresx <> 0 then
396 begin
397 raise EShortcutError.Create('Error in getting Target');
398 Exit;
399 end;
400 fTarget := StrPas(@X1);
401 hresx := psl.GetIconLocation(@X1, MAX_PATH, I);
402 if hresx <> 0 then
403 begin
404 raise EShortcutError.Create('Error in getting icon data');
405 Exit;
406 end;
407 fIconLocation := StrPas(@X1);
408 fIconNumber := I;
409 hresx := psl.GetDescription(@X1, MAX_PATH);
410 if hresx <> 0 then
411 begin
412 raise EShortcutError.Create('Error in get Description');
413 Exit;
414 end;
415 fDescription := StrPas(@X1);
416 Y := 0;
417 hresx := psl.GetShowCmd(Y);
418 if hresx <> 0 then
419 begin
420 raise EShortcutError.Create('Error in getting ShowCmd');
421 Exit;
422 end;
423 fShowCmd := Y;
424 W := 0;
425 hresx := psl.GetHotKey(W);
426 if hresx <> 0 then
427 begin
428 raise EShortcutError.Create('Error in geting HotKey');
429 Exit;
430 end;
431 fHotKey := W;
432 if fHotKey = 0 then
433 HotKey := ' '
434 else
435 HotKey := chr(fHotKey);
436 hresx := psl.GetArguments(@X1, MAX_PATH);
437 if hresx <> 0 then
438 begin
439 raise EShortcutError.Create('Error in getting Arguments');
440 Exit;
441 end;
442 fArguments := StrPas(@X1);
443 {$IFNDEF Delphi3orHigher}
444 ppf.release;
445 psl.release;
446 {$ENDIF}
447 StrDispose(X3);
448 end;
449
450 {The Write method is adapted from code in Jordan Russell's Inno Setup.}
451
452 procedure TShortcutLink.write;
453 var
454 aISL: IShellLink;
455 aIPF: IPersistFile;
456 {$IFNDEF Delphi3OrHigher}
457 aPidl: PItemIDList;
458 WideFilename: array[0..MAX_PATH - 1] of WideChar;
459 {$ELSE}
460 Obj: IUnknown;
461 WideFilename: WideString;
462 {$ENDIF}
463 begin
464 {Get an IShellLink interface to make the shortcut. The methods differ between
465 Delphi 2 and later releases.}
466
467 {$IFNDEF Delphi3OrHigher}
468 if not SUCCEEDED(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
469 IID_IShellLink, aISL)) then
470 raise EShortcutError.Create(Error_Message);
471 {$ELSE}
472 Obj := CreateComObject(CLSID_ShellLink);
473 aiSL := Obj as IShellLink;
474 {$ENDIF}
475
476 try
477 {Now we have an IShellLink interface, so we can set it up as we like. Set the
478 target.}
479 aISL.SetPath(Pchar(fTarget));
480 {Set the working directory ("Start in")}
481 aISL.SetWorkingDirectory(PChar(fWorkingDir));
482 {Set the command-line params}
483 aISL.SetArguments(Pchar(fArguments));
484 {Set the description}
485 aISL.SetDescription(Pchar(fDescription));
486 {Set the show command}
487 aISL.SetShowCmd(fShowCmd);
488 {Set the hotkey}
489 {Vers. 1.1 avoids this command if fHotKey isn't greater than a space.}
490 if fHotKey > ord(' ') then
491 aISL.SetHotKey(((HOTKEYF_ALT or HOTKEYF_CONTROL) shl 8) or fHotKey);
492 {Set the icon location}
493 aISL.SetIconLocation(Pchar(fIconLocation), fIconNumber);
494 {The shortcut IShellLink is now all set up. We get an IPersistFile interface
495 from it, and use it to save the link. Delphi 2 differs from later releases.}
496
497 {$IFNDEF Delphi3OrHigher}
498 if aISL.QueryInterface(IID_IPersistFile, aIPF) <> S_OK then
499 raise EShortcutError.Create(Error_Message)
500 else
501 MultiByteToWideChar(CP_ACP, 0, PChar(fShortcutFile), -1, WideFilename,
502 MAX_PATH);
503 {$ELSE}
504 aiPF := Obj as IPersistFile;
505 WideFilename := fShortcutFile;
506 {$ENDIF}
507
508 try
509 {$IFNDEF Delphi3OrHigher}
510 if aIPF.Save(WideFilename, True) <> S_OK
511 {$ELSE}
512 if aIPF.Save(PWideChar(WideFilename), True) <> S_OK
513 {$ENDIF} then
514 raise EShortcutError.Create(Error_Message);
515 finally
516 {$IFNDEF Delphi3OrHigher}
517 aIPF.Release; {Only needed for D2--later releases do this implicitly.}
518 {$ENDIF}
519 end;
520
521 finally
522 {$IFNDEF Delphi3OrHigher}
523 aISL.Release; {Only needed for D2--later releases do this implicitly.}
524 {$ENDIF}
525 end;
526 end;
527
528 function TShortcutLink.fGetDesktopFolder: string;
529 begin
530 result := fGetSpecialFolder(CSIDL_DESKTOPDIRECTORY);
531 end;
532
533 function TShortcutLink.fGetProgramsFolder: string;
534 begin
535 result := fGetSpecialFolder(CSIDL_PROGRAMS);
536 end;
537
538 function TShortcutLink.fGetStartFolder: string;
539 begin
540 result := fGetSpecialFolder(CSIDL_STARTMENU);
541 end;
542
543 function TShortcutLink.fGetStartupFolder: string;
544 begin
545 result := fGetSpecialFolder(CSIDL_STARTUP);
546 end;
547
548 function TShortcutLink.fGetSpecialFolder(nFolder: integer): string;
549 var
550 aPidl: PItemIDList;
551 handle: THandle;
552 TC: TComponent;
553 fLinkDir: string;
554 begin
555 {Get the folder location (as a PItemIDList)}
556 TC := self.owner;
557 handle := (TC as TForm).handle;
558 if SUCCEEDED(SHGetSpecialFolderLocation(handle, nFolder, aPidl)) then
559 begin
560 {Get the actual path of the desktop directory from the PItemIDList}
561 SetLength(fLinkDir, MAX_PATH); {SHGetPathFromIDList assumes MAX_PATH buffer}
562 SHGetPathFromIDList(aPidl, PChar(fLinkDir)); {Do it}
563 SetLength(fLinkDir, StrLen(PChar(fLinkDir)));
564 result := fLinkDir;
565 end;
566 end;
567
568 procedure TShortcutLink.fSetHotKey(c: string);
569 var
570 s: string[1];
571 c2: char;
572 begin
573 s := c;
574 if length(c) < 1 then
575 s := ' ';
576 s := uppercase(s);
577 c2 := s[1];
578 if ord(c2) < ord(' ') then
579 c2 := ' ';
580 fHotKey := ord(c2);
581 end;
582
583 function TShortcutLink.fGetHotKey: string;
584 begin
585 if fHotKey = 0 then
586 fHotKey := ord(' ');
587 result := chr(fHotKey);
588 end;
589
590 procedure TShortcutLink.fSetShowCmd(c: TShowCmd);
591 begin
592 case c of
593 scSHOWMAXIMIZED: fShowCmd := SW_Maximize;
594 scSHOWMINIMIZED: fShowCmd := SW_ShowMinNoActive;
595 scSHOWNORMAL: fShowCmd := SW_Restore;
596 end;
597 end;
598
599 function TShortcutLink.fGetShowCmd: TShowCmd;
600 begin
601 case fShowCmd of
602 SW_MAXIMIZE: result := scShowMaximized;
603 SW_SHOWMINNOACTIVE: result := scShowMinimized;
604 SW_RESTORE: result := scShowNormal;
605 else
606 result := scShowNormal;
607 end;
608 end;
609
610 initialization
611 CoInitialize(nil); {Must initialize COM or CoCreateInstance won't work}
612 finalization
613 CoUninitialize; {Symmetric uninitialize}
614
615 end.
Solve 6:
616
617 function CreateShellLink(sEintrag, sExeFile, sParams, sIconFile: string; iIconNr:
618 Integer;
619 const sDescription: string): HRESULT;
620 {create ShellLink, overwrite if already exist}
621 var
622 hrInit: HRESULT;
623 pIShellLink: IShellLink;
624 pIPersistFile: IPersistFile;
625 begin
626 result := E_FAIL;
627 {they should be NIL}
628 Assert((nil = pIShellLink) and (nil = pIPersistFile));
629 {parameter test}
630 Assert((sEintrag <> '') and (sExeFile <> ''));
631 if (sEintrag = '') or (sExeFile = '') then
632 Exit;
633 {action}
634 hrInit := CoInitialize(nil);
635 try
636 result := hrInit;
637 if FAILED(result) then
638 Exit;
639 {Get a pointer to the IShellLink interface}
640 result := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
641 IID_IShellLinkA, pIShellLink);
642 if FAILED(result) then
643 Exit;
644 {Set the path to the shortcut target and the params}
645 pIShellLink.SetPath(PChar(sExeFile));
646 pIShellLink.SetArguments(PChar(sParams));
647 {add description and icon}
648 if sDescription <> '' then
649 pIShellLink.SetDescription(PChar(sDescription));
650 if sIconFile <> '' then
651 pIShellLink.SetIconLocation(PChar(sIconFile), iIconNr);
652 {Query IShellLink for the IPersistFile interface for saving the shortcut in
653 persistent storage}
654 result := pIShellLink.QueryInterface(IID_IPersistFile, pIPersistFile);
655 if FAILED(result) then
656 Exit;
657 {Ensure that the string is OLECHAR
658 Ensure that the new link has the .LNK extension
659 Save the link by calling IPersistFile::Save.}
660 if CompareText(ExtractFileExt(sEintrag), '.lnk') <> 0 then
661 sEintrag := sEintrag + '.lnk';
662 ForceDirectories(ExtractFilePath(sEintrag));
663 result := pIPersistFile.Save(PWideChar(WideString(sEintrag)), True);
664 finally
665 pIShellLink := nil;
666 pIPersistFile := nil;
667 if SUCCEEDED(hrInit) then
668 CoUninitialize;
669 end;
670 end;
Solve 7:
671 uses
672 ComObj, ShlObj, ActiveX;
673
674 procedure CreateShortcut(AFileName: string; ALocation: string);
675 var
676 MyObject: IUnknown;
677 MySLink: IShellLink;
678 MyPFile: IPersistFile;
679 WFileName: WideString;
680 begin
681 MyObject := CreateComObject(CLSID_ShellLink);
682 MySLink := MyObject as IShellLink;
683 MyPFile := MyObject as IPersistFile;
684 MySLink.SetPath(PChar(AFileName));
685 MySLink.SetWorkingDirectory(PChar(ExtractFilePath(AFileName)));
686 WFileName := ALocation;
687 MyPFile.Save(PWChar(WFileName), False);
688 end;
689
690 function GetSpecialFolder(AFolderID: Integer): string;
691 var
692 AInfo: PItemIdList;
693 Buffer: array[0..MAX_PATH] of Char;
694 begin
695 if (SHGetspecialFolderLocation(Application.Handle, AFolderID, aInfo) = NOERROR)
696 and SHGetPathFromIDList(aInfo, Buffer) then
697 Result := StrPas(Buffer);
698 end;
699
700 procedure MakeShortcut;
701 begin
702 CreateShortcut(Application.ExeName, GetSpecialFolder(CSIDL_COMMON_STARTUP)
703 + '\shortcutname.lnk');
704 end;
705
706 procedure DeleteShortCut;
707 DeleteFile(PChar(GetSpecialFolder(CSIDL_COMMON_STARTUP) + '\shortcutname.lnk'));
708 end;
|
