Author: Jonas Bilinkevicius
How to add programs to the Windows start menu
Answer:
Solve 1:
1
2 procedure CreateStartmenuLink(ExeFile, WorkPath, Args, Descr: string);
3 var
4 MyObject: IUnknown;
5 MyLink: IShellLink;
6 MyFile: IPersistFile;
7 ds: WideString;
8 StartMenuDir: string;
9 reg_info: TRegIniFile;
10 reg: TRegistry;
11 s: string;
12 begin
13 reg_Info :=
14 TRegIniFile.Create('Software\Microsoft\Windows\CurrentVersion\Explorer');
15 StartMenuDir := reg_Info.ReadString('Shell Folders', 'Start Menu', '');
16 reg_Info.Free;
17 s := ExtractFilePath(StartMenuDir + '\' + Descr + '.lnk');
18 ForceDirectories(s);
19 if FileExists(StartMenuDir + '\' + Descr + '.lnk') then
20 DeleteFile(StartMenuDir + '\' + Descr + '.lnk');
21 MyObject := CreateComObject(CLSID_ShellLink);
22 MyLink := MyObject as IShellLink;
23 MyFile := MyObject as IPersistFile;
24 MyLink.SetArguments(PChar(Args));
25 MyLink.SetPath(PChar(ExeFile));
26 MyLink.SetWorkingDirectory(PChar(WorkPath));
27 s := ExtractFileName(StartMenuDir + '\' + Descr + '.lnk');
28 s := copy(s, 1, length(s) - 4);
29 MyLink.SetDescription(PChar(s));
30 ds := StartMenuDir + '\' + Descr + '.lnk';
31 MyFile.Save(PWChar(ds), false);
32 reg := TRegistry.Create;
33 reg.RootKey := HKEY_USERS;
34 reg.openkey('.Default\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell
35 Folders'
36 StartMenuDir := reg.ReadString('Start Menu');
37 reg.closekey;
38 reg.free;
39 s := ExtractFilePath(StartMenuDir + '\' + Descr + '.lnk');
40 ForceDirectories(s);
41 if FileExists(StartMenuDir + '\' + Descr + '.lnk') then
42 DeleteFile(StartMenuDir + '\' + Descr + '.lnk');
43 ds := StartMenuDir + '\' + Descr + '.lnk';
44 MyFile.Save(PWChar(ds), false);
45 end;
Solve 2:
46 {uses Windows, ShlObj, ActiveX, ComObj, SysUtils, ...}
47
48 type
49 TShellLinkInfo = record
50 PathName: string;
51 Arguments: string;
52 Description: string;
53 WorkingDirectory: string;
54 IconLocation: string;
55 IconIndex: integer;
56 ShowCmd: integer;
57 HotKey: word;
58 end;
59
60 function GetSpecialFolderPath(Folder: Integer; CanCreate: Boolean):
61 string;
62 var
63 FilePath: array[0..MAX_PATH] of char;
64 begin
65 { Get path of selected location }
66 SHGetSpecialFolderPath(0, FilePath, Folder, CanCreate);
67 Result := FilePath;
68 end;
69
70 function TfrmMain.CreateShellLink(const AppName, Desc: string; Dest: Integer):
71 string;
72 { Creates a shell link for application or document specified in AppName with
73 description Desc.
74 Link will be located in folder specified by Dest. Returns the full path name of the
75 link file }
76 var
77 SL: IShellLink;
78 PF: IPersistFile;
79 LnkName: WideString;
80 SName: string;
81 begin
82 OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink,
83 SL));
84 { The IShellLink implementer must also support the IPersistFile interface.
85 Get an interface pointer to it. }
86 PF := SL as IPersistFile;
87 OleCheck(SL.SetPath(PChar(AppName))); {set link path to proper file}
88 if Desc <> '' then
89 OleCheck(SL.SetDescription(PChar(Desc))); {set description}
90 { create a path location and filename for link file }
91 if Desc <> '' then
92 SName := Desc
93 else
94 SName := ExtractFileName(AppName);
95 LnkName := GetSpecialFolderPath(Dest, True) + '\' + ChangeFileExt(SName, '.lnk');
96 PF.Save(PWideChar(LnkName), True); {save link file}
97 Result := LnkName;
98 end;
99
100 //Usage:
101
102 CreateShellLink('c:\MyProgram.exe', 'GKB Server', CSIDL_STARTUP);
The CSIDL_constants:
CSIDL_BITBUCKET RecycleBin
CSIDL_CONTROLS ControlPanel
CSIDL_DESKTOP Desktop
CSIDL_DRIVES My Computer
CSIDL_FONTS Fonts
CSIDL_NETHOOD Network Neighborhood
CSIDL_NETWORK The virtual version of the above
CSIDL_PERSONAL 'Personal'
CSIDL_PRINTERS printers
CSIDL_PROGRAMS Programs in the Start Menu
CSIDL_RECENT Recent Documents
CSIDL_SENDTO Folder SendTo
CSIDL_STARTMENU The whole Start menu
CSIDL_STARTUP The Autostart Group
CSIDL_TEMPLATES Document templates
Look up SHGetSpecialFolderLocation or "ShlObj.pas" for the additional CSIDL_constants.
|
