1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:

{-----------------------------------------------------------------------------
  Procedure : BuildLink - 2003-05-18 08:03:32
  modified  : 2003-05-18
  Author    : Michael Puff
  Purpose   : Creates the link
  Arguments : ExeFile, LinkFile, Description: String
  Result    : Boolean
-----------------------------------------------------------------------------}

function BuildLink(ExeFile, LinkFile, Description: string): Integer;
var
  wLinkFile         : WideString;
  PersistFile       : IPersistFile;
  Link              : IShellLink;
begin
  result := 3;
  wLinkFile := LinkFile;
  if CoCreateInstance(CLSID_SHellLink, nil, CLSCTX_INPROC_SERVER, IShellLink,
    Link) = S_OK then
  begin
{$I-}
    MkDir(GetSpecialFolder(CSIDL_PROGRAMS) + '\' + ParamStr(2));
    if IOResult <> 0 then
    begin
      result := 2;
      exit
    end;
{$I+}
    PersistFile := Link as IPersistFile;
    Link.SetDescription(pointer(Description));
    Link.SetArguments(pointer(ExeFile));
    Link.SetWorkingDirectory(pointer(CutFilename(ExeFile)));
    Link.SetPath(pointer(ExeFile));
    if PersistFile.Save(PWideChar(wLinkFile), TRUE) = S_OK then
      result := -1
    else
      result := 3;
  end;
end;