Board index » delphi » Creating a shortcut on desktop

Creating a shortcut on desktop

How can I create a shortcut on the desktop.
 

Re:Creating a shortcut on desktop


Hi John,

Quote
>How can I create a shortcut on the desktop.

// === [code: Creating a shortcut] ===
  // ======================================
  // ==== from the Jedi Code Library[1] === //
  ======================================

  const
    // IID_IShellLinkA
    IID_IShellLink: TGUID = (
      D1:$000214EE;
      D2:$0000;
      D3:$0000;
      D4:($C0,$00,$00,$00,$00,$00,$00,$46));

  type
    PShortCut = ^TShortCut;
    TShortCut = record
      Arguments: string;
      ShowCmd: Integer;
      WorkingDirectory: string;
      IdList: PItemIDList;
      Target: string;
      Description: string;
      IconLocation: string;
      IconIndex: Integer;
      HotKey: Word;
    end;

  procedure ShortCutFree(var ShortCut: TShortCut);
  begin
    PidlFree(ShortCut.IdList);
  end;

  function ShortCutCreateSystem(
    const ShortCut: TShortCut;
    const Folder: Integer;
    const FileName: string): HRESULT;
  var
    Path: string;
  begin
    Result := E_INVALIDARG;
    SetLength(Path, MAX_PATH);
    if SHGetSpecialFolderPath(0, PChar(Path), Folder, False) then
    begin
      StrResetLength(Path);
      Result :=
        ShortCutCreate(ShortCut, PathAddSeparator(Path) + FileName);
    end;
  end;

  function ShortCutCreate(
    const ShortCut: TShortCut;
    const FileName: string): HRESULT;
  var
    ShellLink: IShellLink;
    PersistFile: IPersistFile;
    LinkName: array [0..MAX_PATH] of WideChar;
  begin
    Result := CoCreateInstance(
      CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
      IID_IShellLink, ShellLink);
    if Succeeded(Result) then
    begin
      ShellLink.SetArguments(PChar(ShortCut.Arguments));
      ShellLink.SetShowCmd(ShortCut.ShowCmd);
      ShellLink.SetWorkingDirectory(PChar(ShortCut.WorkingDirectory));
      ShellLink.SetPath(PChar(ShortCut.Target));
      ShellLink.SetDescription(PChar(ShortCut.Description));
      ShellLink.SetHotkey(ShortCut.HotKey);
      ShellLink.SetIconLocation(
        PChar(ShortCut.IconLocation), ShortCut.IconIndex);
      PersistFile := ShellLink as IPersistFile;
      MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(FileName), -1,
        LinkName, MAX_PATH);
      Result := PersistFile.Save(LinkName, True);
    end;
  end;

  function ShortCutResolve(
    const FileName: string;
    var ShortCut: TShortCut): HRESULT;
  var
    ShellLink: IShellLink;
    PersistFile: IPersistFile;
    LinkName: array [0..MAX_PATH] of WideChar;
    Buffer: string;
    Win32FindData: TWin32FindData;
  begin
    Result := CoCreateInstance(
      CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
      IID_IShellLink, ShellLink);
    if Succeeded(Result) then
    begin
      PersistFile := ShellLink as IPersistFile;
      MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(FileName), -1,
        LinkName, MAX_PATH);
      Result := PersistFile.Load(LinkName, STGM_READ);
      if Succeeded(Result) then
      begin
        Result := ShellLink.Resolve(0, SLR_ANY_MATCH);
        if Succeeded(Result) then
        begin
          SetLength(Buffer, MAX_PATH);
          ShellLink.GetPath(
            PChar(Buffer), MAX_PATH, Win32FindData, SLGP_SHORTPATH);
          ShortCut.Target := PChar(Buffer);
          ShellLink.GetArguments(PChar(Buffer), MAX_PATH);
          ShortCut.Arguments := PChar(Buffer);
          ShellLink.GetShowCmd(ShortCut.ShowCmd);
          ShellLink.GetWorkingDirectory(PChar(Buffer), MAX_PATH);
          ShortCut.WorkingDirectory := PChar(Buffer);
          ShellLink.GetDescription(PChar(Buffer), MAX_PATH);
          ShortCut.Description := PChar(Buffer);
          ShellLink.GetIconLocation(
            PChar(Buffer), MAX_PATH, ShortCut.IconIndex);
          ShortCut.IconLocation := PChar(Buffer);
          ShellLink.GetHotkey(ShortCut.HotKey);
          ShellLink.GetIDList(ShortCut.IdList);
        end;
      end;
    end;
  end;
// === [end of code] ===

Footnotes:
[1] http://project-jedi.org

Cheers,
   Udo
--
Homepage: http://www.nesshoever.de/         [No mails please. Reply here.]
Delphi: W2K.sp2, D4Pro.sp3, D6Pro.sp1

Other Threads