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