1 2 //dont forget to add the units to get this to work :-) 3 uses shlobj,ActiveX,ComObj; 4 5 6 procedure TForm1.Button1Click(Sender: TObject); 7 var 8 sCaption:string; 9 begin 10 //open dialog componet 11 openDialog1.Filter:='exe|*.exe'; //add filter of exe's 12 OpenDialog1.DefaultExt:='*.exe'; //set default to *.exe to view the exe's 13 OpenDialog1.Title:='Select a application'; 14 15 if OpenDialog1.Execute then begin 16 sCaption:= inputbox('Link','Enter the caption of link','NONE'); 17 desktopShortcut(OpenDialog1.FileName,sCaption); 18 end; 19 end; 20 21 22 procedure TForm1.desktopShortcut(sFileName:string; sCaption: widestring); 23 var 24 IObject : IUnknown; 25 ISLink : IShellLink; 26 IPFile : IPersistFile; 27 PIDL : PItemIDList; 28 InFolder : array[0..MAX_PATH] of Char; 29 LinkName : WideString; 30 FLinkName : string; 31 begin 32 33 34 //creates short cut objects 35 IObject := CreateComObject(CLSID_ShellLink); 36 ISLink := IObject as IShellLink; 37 IPFile := IObject as IPersistFile; 38 39 //sets up short cut 40 with ISLink do begin 41 SetPath(pChar(sFileName)); 42 SetWorkingDirectory(pChar(ExtractFilePath(sFileName))); 43 end; 44 45 46 SHGetSpecialFolderLocation 47 (0, CSIDL_DESKTOPDIRECTORY, PIDL); 48 SHGetPathFromIDList 49 (PIDL, InFolder); 50 51 52 //give the caption of the link 53 FlinkName := '\'+ sCaption + '.lnk'; 54 55 LinkName := InFolder + FlinkName; 56 57 //save shortcut to location 58 IPFile.Save(PWChar(LinkName), false); 59 end;