{
あほうどりさんの[00094]CreateShortcutのComObjを使ったバージョンです。

// 引数の説明
// szFileName  = ショートカットを作成したいフルパスファイルｨ名
// nFolder = ｼｮｰﾄｶｯﾄの作成場所  CSIDL_DESKTOPDIRECTORY : ﾃﾞｽｸﾄｯﾌﾟ
//                              CSIDL_PROGRAMS         : ｽﾀｰﾄﾒﾆｭｰ
//                              CSIDL_STARTUP          : ｽﾀｰﾄｱｯﾌﾟ
//                              CSIDL_SENDTO           : ｺﾝﾃｷｽﾄﾒﾆｭｰの
//                                                      「送る」
}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  ShellAPI, ShlObj, ActiveX, ComObj;

  procedure CreateShortcut(szFileName: string; nFolder: Integer);
var
  ppmem: IMalloc;
  Directory : array[0..MAX_PATH] of Char;
  szDirectory: string;
  UnknownObject: IUnknown;
  psl: IShellLink;
  ppf: IPersistFile;
  lpi: PItemIDList;
  wFileName : WideString;
begin
  UnknownObject:= CreateComObject(CLSID_ShellLink);
  if not Assigned(UnknownObject) then exit;
  psl:= UnknownObject as IShellLink;
  ppf:= UnknownObject as IPersistFile;
  if not Assigned(psl) or not Assigned(ppf) then exit;
  if FAILED(ShGetMalloc(ppmem)) then exit;
  if FAILED(SHGetSpecialFolderLocation(0, nFolder, lpi)) then exit;
  if not SHGetPathFromIDList(lpi, Directory)then
  begin
    if Assigned(lpi) then ppmem.Free(lpi);
    exit
  end;
  with psl do
  begin
    SetPath(PChar(szFileName));
    SetWorkingDirectory(PChar(ExtractFilePath(szFileName)));
  end;
  szDirectory:= strpas(Directory);
  wFileName:= szDirectory + '\' + ExtractFileName(szFileName)
              + 'へのショートカット.lnk';
  ppf.Save(PWChar(WFileName), False);
  if Assigned(lpi) then ppmem.Free(lpi);
end;

//  ButtonをクリックしてOpenDialogからファイルを選ぶとディスクトップに
//  ショートカットができます。

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    CreateShortcut(OpenDialog1.FileName, CSIDL_DESKTOPDIRECTORY);
end;

end.

{
#あほうどりさん Pidlは開放しましょうね。(^^;
#私も[00053]の中で
#public
#    constructor Create(AOwner: TComponent); override;
#                                            ^^^^^^^^^が抜けてました。
}

でわ〜でわ〜
                                   by ヒシアマゾン
                                   BXC05221@niftyserve.or.jp
                                   ken_fu@mx4.meshnet.or.jp


Original document by ヒシアマゾン    氏 ID:(BXC05221)

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