この発言に対し以下のコメントが寄せられています

#00110　あほうどり      さん　ソフトからショートカットを作る(修正版)





{
  ソフトウェアからアプリのショートカットを作る手続きです。
  削除も出来ます。
}

// 引数の説明
// pszDir  = ﾃﾞｨﾚｸﾄﾘｨ名
// pszFile = EXEﾌｧｲﾙ名
// pszAppName = ｱﾌﾟﾘｹｰｼｮﾝ名
// nLoca   = ｼｮｰﾄｶｯﾄの作成場所  CSIDL_DESKTOPDIRECTORY : ﾃﾞｽｸﾄｯﾌﾟ
//                              CSIDL_PROGRAMS         : ｽﾀｰﾄﾒﾆｭｰ
//                              CSIDL_STARTUP          : ｽﾀｰﾄｱｯﾌﾟ
//                              CSIDL_SENDTO           : ｺﾝﾃｷｽﾄﾒﾆｭｰの
//                                                      「送る」
// fCreate True=作成 False=削除

=========== Delphi 3 ====================================
  uses に ShellAPI, SHLObj, ActiveX を追加

procedure CreateShortcut(pszDir, pszFile, pszAppName: PChar;
                         nLoca: Integer; fCreate: Boolean);
var
  sz : array[0..MAX_PATH] of Char;
  szPath : array[0..MAX_PATH] of Char;
  hr : HResult;
  psl: IShellLink;
  ppf: IPersistFile;
  psf: IShellFolder;
  pidl: PItemIDList;
  StrRet: TStrRet;
  wsz : PWChar;
begin
  CoInitialize(nil);
  hr := CoCreateInstance(CLSID_ShellLink,
                         nil,
                         CLSCTX_INPROC_SERVER,
                         IShellLink,  // for 3.0 ActiveX  
                         psl);
  if (Succeeded(hr)) then
  begin
    StrCopy(szPath, pszDir);
    psl.SetWorkingDirectory(szPath);
    StrCat(szPath, '\');
    StrCat(szPath, pszFile);
    psl.SetPath(szPath);
    psl.SetDescription(pszAppName);
// 最少化で起動の場合
// psl.SetShowCmd(SW_SHOWMINNOACTIVE);

    hr := psl.QueryInterface(IPersistFile, ppf); // for 3.0 ActiveX
    if (Succeeded(hr)) then
    begin
      SHGetDesktopFolder(psf);
      SHGetSpecialFolderLocation(GetDesktopWindow, nLoca, pidl);
      StrRet.uType := STRRET_CSTR;
      psf.GetDisplayNameOf(pidl, SHGDN_FORPARSING, StrRet);
      StrCopy(sz, StrRet.cStr);

      StrCat(sz, '\');
      StrCat(sz, pszAppName);
      StrCat(sz, '.lnk');
      if fCreate then
      begin
        GetMem(wsz, SizeOf(WideChar) * MAX_PATH + 1);
        MultiByteToWideChar(CP_ACP, 0, sz, -1, wsz, MAX_PATH);
        hr := ppf.Save(wsz, True);
        FreeMem(wsz);
      end;
    end;
  end;
  CoUninitialize;
  if not fCreate then
    DeleteFile(sz);
end;

=========== Delphi 2.0 ====================================
  uses に ShellAPI, SHLObj, Ole2 を追加

procedure CreateShortcut(pszDir, pszFile, pszAppName: PChar;
                         nLoca: Integer; fCreate: Boolean);
var
  sz : array[0..MAX_PATH] of Char;
  szPath : array[0..MAX_PATH] of Char;
  hr : HResult;
  psl: IShellLink;
  ppf: IPersistFile;
  psf: IShellFolder;
  pidl: PItemIDList;
  StrRet: TStrRet;
  wsz : PWChar;
begin
  CoInitialize(nil);
  hr := CoCreateInstance(CLSID_ShellLink,
                         nil,
                         CLSCTX_INPROC_SERVER,
                         IID_IShellLink, // for 2.0 Ole2
                         psl);
  if (Succeeded(hr)) then
  begin
    StrCopy(szPath, pszDir);
    psl.SetWorkingDirectory(szPath);
    StrCat(szPath, '\');
    StrCat(szPath, pszFile);
    psl.SetPath(szPath);
    psl.SetDescription(pszAppName);
// 最少化で起動の場合
// psl.SetShowCmd(SW_SHOWMINNOACTIVE);

    hr := psl.QueryInterface(IID_IPersistFile, ppf); // for 2.0 Ole2
    if (Succeeded(hr)) then
    begin
      SHGetDesktopFolder(psf);
      SHGetSpecialFolderLocation(GetDesktopWindow, nLoca, pidl);
      StrRet.uType := STRRET_CSTR;
      psf.GetDisplayNameOf(pidl, SHGDN_FORPARSING, StrRet);
      StrCopy(sz, StrRet.cStr);

      StrCat(sz, '\');
      StrCat(sz, pszAppName);
      StrCat(sz, '.lnk');
      if fCreate then
      begin
        GetMem(wsz, SizeOf(WideChar) * MAX_PATH + 1);
        MultiByteToWideChar(CP_ACP, 0, sz, -1, wsz, MAX_PATH);
        hr := ppf.Save(wsz, True);
        FreeMem(wsz);
      end;
      psf.Release; // only 2.0
      ppf.Release; // only 2.0
    end;
    psl.Release; // only 2.0
  end;
  CoUninitialize;
  if not fCreate then
    DeleteFile(sz);
end;

                                                           あほうどり

Original document by あほうどり      氏 ID:(GGA00167)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。