Start menu genvej

Uses
  ShlObj, ActiveX, Registry,
  ComObj;

procedure FreePidl(pidl: PItemIDList);
var
  allocator: IMalloc;
begin
  if Succeeded(SHGetMalloc(allocator)) then
  begin
    allocator.Free(pidl);
    {$IFDEF VER100}
    allocator.Release;
    {$ENDIF}
  end;
end;

function CreateFolder(aFolderName: string; aLocation: Integer): Boolean;
var
  pIdl: PItemIDList;
  hPath: PChar;
begin
  Result := False;
  if SUCCEEDED(SHGetSpecialFolderLocation(0, aLocation, pidl)) then
  begin
    hPath := StrAlloc(MAX_PATH);
    SHGetPathFromIDList(pIdl, hPath);
    SetLastError(0);
    CreateDirectory(PChar(hPath + '\\' + aFolderName), nil);
    if (GetLastError = 0) or (GetLastError = ERROR_ALREADY_EXISTS) then
      Result := True;
    FreePIDL(pIdl);
    StrDispose(hPath);
  end;
end;

type
  ShortcutType = (_DESKTOP, _QUICKLAUNCH, _SENDTO, _STARTMENU, _OTHERFOLDER);

function CreateShortcut(SourceFileName: string; // the file the shortcut points to
                        Location: ShortcutType; // shortcut location
                        SubFolder,  // subfolder of location
                        WorkingDir, // working directory property of the shortcut
                        Parameters,
                        Description: string): //  description property of the shortcut
                        string;
const
  SHELL_FOLDERS_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\Explorer';
  QUICK_LAUNCH_ROOT = 'Software\MicroSoft\Windows\CurrentVersion\GrpConv';
var
  MyObject: IUnknown;
  MySLink: IShellLink;
  MyPFile: IPersistFile;
  Directory, LinkName: string;
  WFileName: WideString;
  Reg: TRegIniFile;
begin

  MyObject := CreateComObject(CLSID_ShellLink);
  MySLink := MyObject as IShellLink;
  MyPFile := MyObject as IPersistFile;

  MySLink.SetPath(PChar(SourceFileName));
  MySLink.SetArguments(PChar(Parameters));
  MySLink.SetDescription(PChar(Description));

  LinkName := ChangeFileExt(SourceFileName, '.lnk');
  LinkName := ExtractFileName(LinkName);

  // Quicklauch
  if Location = _QUICKLAUNCH then
  begin
    Reg := TRegIniFile.Create(QUICK_LAUNCH_ROOT);
    try
      Directory := Reg.ReadString('MapGroups', 'Quick Launch', '');
    finally
      Reg.Free;
    end;
  end
  else
  // Other locations
  begin
    Reg := TRegIniFile.Create(SHELL_FOLDERS_ROOT);
    try
    case Location of
      _OTHERFOLDER : Directory := SubFolder;
      _DESKTOP    : Directory := Reg.ReadString('Shell Folders', 'Desktop', '');
      _STARTMENU  : Directory := Reg.ReadString('Shell Folders', 'Start Menu', '');
      _SENDTO      : Directory := Reg.ReadString('Shell Folders', 'SendTo', '');
    end;
    finally
      Reg.Free;
    end;
  end;

  if Directory <> '' then
  begin
    if (SubFolder <> '') and (Location <> _OTHERFOLDER) then
      WFileName := Directory + '\' + SubFolder + '\' + LinkName
    else
      WFileName := Directory + '\' + LinkName;


    if WorkingDir = '' then
      MySLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFileName)))
    else
      MySLink.SetWorkingDirectory(PChar(WorkingDir));

    MyPFile.Save(PWChar(WFileName), False);
    Result := WFileName;
  end;
end;

function GetProgramDir: string;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders', False);
    Result := reg.ReadString('Programs');
    reg.CloseKey;
  finally
    reg.Free;
  end;
end;

procedure CreateStartMenuShortCut(Filename,SubFolder,Description: String);
begin
CreateFolder(SubFolder, CSIDL_PROGRAMS);
CreateShortcut(Filename, _OTHERFOLDER, GetProgramDir+'\'+SubFolder,'','',Description);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CreateStartMenuShortCut('c:\hejhej.bmp','hej','hejhej');
end;


Kan nok gøres lettere :-)

hejhej > jeg kan se du har været inde på swiss og slået de 2 eksempler sammen :) Cool nok jeg prøver det lige af!