Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2007年09月16日] [更新 2016年09月23日] Delphi サンプルプログラム集
   
880_ショートカットの作成と削除
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
880_CreateShortcut.zip [2,376 KB] 2016年09月23日版(EXE同梱)



  • 2013年05月25日
  • コードを整備して Delphi 2010 以降専用に変更
  • 変数名がディレクトリとフォルダ名の混合だったので,ディレクトリと判断可能な名前に変更
  • 2016年09月23日
  • ショートカットの作成や削除関係の関数類を別ユニットにした
  • ショートカットのアイコンを変更するサンプルを追加




01_ショートカットの作成と削除


[860_自分自身を含むフォルダを削除] は,アプリケーションのアンインストールの際に使用することを想定していますが,逆にアプリケーションのインストールの際に使うかも知れないサンプルコードです.本サンプルでは,デスクトップにこのプログラムのショートカットを作成または削除します.

作成したショートカットを別の場所に移動してしまった場合は削除できません.移動先のディレクトリを指定して検索すれば削除できます.

ショートカットのアイコンは,EXE の場合はアプリケーションアイコンが使われます.その他のファイルは,拡張子に関連付けされたアプリケーションのアイコンが使われます.表示サイズは,表示場所や表示の設定によって自動で決まります.ショートカットとして表示するサイズがそれらのファイルにない場合は,拡大または縮小表示されます.

ショートカットの操作には,IShellLink, IPersistFile インターフェイスを使用しますが,それらを使用するコードは別ユニットにしています.このユニットは本ページのサンプルで共通です.



[備考]
ショートカットの作成場所によっては,SendMessage で,HWND_BROADCAST (トップレベルのウィンドウ全体) に対して WM_SETTINGCHANGE メッセージを送信して更新する必要があります.
WM_SETTINGCHANGE は環境変数の変更等の際にも使われます.


図1
設計時画面
図2
[ショートカット作成] をクリック
  • デスクトップにショートカットができる

リスト1
ショートカットの作成と削除
unit CreateShortcutUnit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plShortcutUtils,
  ShlObj;

{$R *.dfm}

//=============================================================================
//  指定ディレクトリ内にショートカットを作成
//  ここではデスクトップに本プログラムのショートカットを作成
//
//  添付のplShortcutUtilsユニット内の関数類を使用
//  CSIDL_DESKTOP等の定数名の使用にはusesにShlObjが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDir : String;
begin
  //CSIDLの値からフルパスを取得
  //ショートカットを作成する場所
  LDir := GetDirectoryFromCSIDL(CSIDL_DESKTOP);

  if CreateShortCutLink(Application.ExeName, LDir, 'テストリンク') then begin
    //ショートカットの作成場所によっては,以下のコードで更新が必要
    //SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
  end;
end;

//=============================================================================
//  指定ディレクトリ内のショートカットを削除
//  ここではデスクトップ上の,このプログラムのショートカットを削除
//
//  添付のplShortcutUtilsユニット内の関数類を使用
//  CSIDL_DESKTOP等の定数名の使用にはusesにShlObjが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDir : String;
begin
  //CSIDLの値からフルパスを取得
  //削除するショートカットがある場所
  LDir := GetDirectoryFromCSIDL(CSIDL_DESKTOP);

  if DeleteShorCutLink(Application.ExeName, LDir) then begin
    //ショートカットの場所によっては,以下のコードで更新が必要
    //SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0);
  end;
end;

end.


リスト2
ショートカットの作成と削除関係の関数類
本ページのサンプルではこのユニットを使用している
unit plShortcutUtils;

interface

uses
  Windows, SysUtils;

  function GetDirectoryFromCSIDL(AnFolder: Integer): string;
  function CreateShortCutLink(AszFileName: string; ADirectory: string;
    AswFileName: String): Boolean;
  function DeleteShorCutLink(AFindPath, ASearchFolder: String): Boolean;
  function FindFileShortCutLink(AFindPath, ASearchFolder: string): string;
  function GetLinkPathName(ALinkFilePath: string): string;
  function ChangeShortCutIcon(ALinkFilePath, AIconFilePath: string;
    AIconIndex: Integer): Boolean;
  function GetShortCutIconPath(ALinkFilePath: string; var AIconFilePath: string;
    var AIconIndex: Integer): Boolean;

implementation

uses
  ShlObj,
  ActiveX,
  ComObj,
  IOUtils,
  Types;

//-----------------------------------------------------------------------------
//  特殊フォルダのフルパスをCSIDL値から取得する関数
//  CSIDLの値からフルパスを取得する方法は他にもある
//
//  CoTaskMemFreeの使用にはusesにActiveXが必要
//  SHXXX名の関数の使用にはusesにShObjが必要
//-----------------------------------------------------------------------------
function GetDirectoryFromCSIDL(AnFolder: Integer): string;
var
  LBuff : array[0..MAX_PATH-1] of Char;
  Lpidl : PItemIDList;
begin
  Lpidl := nil;

  //CSIDL値から項目識別子を取得
  SHGetSpecialFolderLocation(0, AnFolder, Lpidl);
  //項目識別子からパス名を取得
  SHGetPathFromIDList(Lpidl, LBuff);
  Result := LBuff;

  CoTaskMemFree(Lpidl);
end;

//-----------------------------------------------------------------------------
//  指定場所にショートカットを作成
//
//  AszFileName : リンク元のファイルのフルパス名
//  ADirectory  : ショートカットを作成する場所(ディレクトリ名)
//  AswFileName : ショートカットに付ける名前
//                空文字の場合はリンク先のファイル名+'へのショートカット.lnk'
//
//  CreateComObjectの使用にはusesにComObjが必要
//  IShellLinkの使用にはusesにShObjが必要
//  IPersistFileの使用にはusesにActiveXが必要
//-----------------------------------------------------------------------------
function CreateShortCutLink(AszFileName: string; ADirectory: string;
  AswFileName: string): Boolean;
var
  LUnknownObject : IUnknown;
  LIShellLink    : IShellLink;
  LIPersistFile  : IPersistFile;
  LwFileName     : string;
begin
  Result := False;

  //IShellLink,IPersistFileインターフェイスのオブジェクトを生成
  LUnknownObject := CreateComObject(CLSID_SHELLLINK);
  LIShellLink    := LUnknownObject as IShellLink;
  LIPersistFile  := LUnknownObject as IPersistFile;
  if not Assigned(LIShellLink) or not Assigned(LIPersistFile) then exit;

  //リンク元の指定
  LIShellLink.SetPath(PChar(AszFileName));
  LIShellLink.SetWorkingDirectory(PChar(ExtractFilePath(AszFileName)));

  //シュートカットに付ける名前を作成
  if AswFileName <> '' then begin
    //本関数で引数で名前の指定があればそれを使用
    LwFileName := IncludeTrailingPathDelimiter(ADirectory) +
                  AswFileName + '.lnk';
  end else begin
    //名前の指定がなければデフォルトで以下にする
    LwFileName := IncludeTrailingPathDelimiter(ADirectory) +
                  ExtractFileName(AszFileName) + 'へのショートカット.lnk';
  end;
  //リンク作成
  //IPersistFile.Saveメソッドを実行すると結果が反映される
  if LIPersistFile.Save(PChar(LwFileName), False) = S_OK then begin
    Result := True;
  end;
end;

//-----------------------------------------------------------------------------
//  指定場所のショートカットを削除
//  リンク先のフルパスで探して削除する
//  拡張子が.lnkのファイルで検索すると名前が変更されていると見つからないので
//
//  AFindPath     : ショートカットの元ファイル(実行形式ファイルなど)
//  ASearchFolder : このフォルダの中のショートカットを削除
//-----------------------------------------------------------------------------
function DeleteShorCutLink(AFindPath, ASearchFolder: string): Boolean;
var
  LLinkFullPath : string;
begin
  Result := False;

  //リンク元のリンクがASerchFolderにあるか調査
  LLinkFullPath := FindFileShortCutLink(AFindPath, ASearchFolder);
  if LLinkFullPath <> '' then begin
    Result := DeleteFile(LLinkFullPath);
  end;
end;

//-----------------------------------------------------------------------------
//  指定したファイルが指定フォルダ内にあるか調査
//
//  AFindPathのファイルのショートカットがASearchFolderフォルダ内にあるかを検索
//  トリンクが作成されているかを検出する
//  ショートカットの名前が変更されている場合も検索可能
//  ショートカットがない場合は空文字,存在すればフルパス名(拡張子は.lnk)を返す
//
//  TStringDynArrayの使用にはusesにTypesが必要
//  TSearchOption, TDirectoryの使用にはusesにIOUtilsが必要
//-----------------------------------------------------------------------------
function FindFileShortCutLink(AFindPath, ASearchFolder: string): string;
var
  LPattern   : string;
  LOption    : TSearchOption;
  LFileNames : TStringDynArray;
  LFileName  : string;
begin
  Result := '';

  //ファイルの検索パターンとディレクトリの列挙モードを設定
  LPattern := '*.LNK';
  LOption  := TSearchOption.soTopDirectoryOnly;

  //ディレクトリ内のファイルのリストを取得
  LFileNames := TDirectory.GetFiles(ASearchFolder, LPattern, LOption);
  for LFileName in LFileNames do begin
    if UpperCase(AFindPath) = UpperCase(GetLinkPathName(LFileName)) then begin
      Result := LFileName;
      break;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  ショートカット(拡張子は.lnk)のリンク先のフルパスを取得
//  リンク先のファイル・フォルダの存在確認はしない
//
//  CreateComObjectの使用にはusesにComObjが必要
//  IShellLinkの使用にはusesにShObjが必要
//  IPersistFileの使用にはusesにActiveXが必要
//-----------------------------------------------------------------------------
function GetLinkPathName(ALinkFilePath: string): string;
var
  LIShellLink   : IShellLink;
  LIPersistFile : IPersistFile;
  LFileData     : TWin32FindData;
  LFilePath     : array [0..MAX_PATH - 1] of Char;
begin
  Result := '';

  //IShellLink,IPersistFileインターフェイスのオブジェクトを生成
  LIShellLink   := CreateComObject(CLSID_ShellLink) as IShellLink;
  LIPersistFile := LIShellLink as IPersistFile;

  if Succeeded(LIPersistFile.Load(PChar(ALinkFilePath), STGM_READ)) then begin
    //初期化
    FillChar(LFilePath, SizeOf(LFilePath), #0);
    //ショートカットファイルのリンク先を取得
    LIShellLink.GetPath(@LFilePath, MAX_PATH, LFileData, SLGP_UNCPRIORITY);
    //関数の戻り値にセット
    Result := LFilePath;
  end;
end;

//-----------------------------------------------------------------------------
//  ショートカットファイル(拡張子は.lnk)のアイコンを変更
//  ファイルの存在確認はしてない
//
//  ALinkFilePath : ショットカットファイルのパス名
//  AIconFilePath : アイコンファイルのパス名
//                  またはアイコンが格納されているEXEやDLLのパス名
//  AIconIndex    : アイコンのインデックス
//                  複数のアイコンが格納されているEXEやDLLの場合に指定する
//
//  CreateComObjectの使用にはusesにComObjが必要
//  IShellLinkの使用にはusesにShObjが必要
//  IPersistFileの使用にはusesにActiveXが必要
//-----------------------------------------------------------------------------
function ChangeShortCutIcon(ALinkFilePath, AIconFilePath: string;
  AIconIndex: Integer): Boolean;
var
  LIShellLink   : IShellLink;
  LIPersistFile : IPersistFile;
begin
  Result := False;

  //IShellLink,IPersistFileインターフェイスのオブジェクトを生成
  LIShellLink   := CreateComObject(CLSID_ShellLink) as IShellLink;
  LIPersistFile := LIShellLink as IPersistFile;

  if Succeeded(LIPersistFile.Load(PChar(ALinkFilePath), STGM_READ)) then begin
    //アイコンを設定
    LIShellLink.SetIconLocation(PChar(AIconFilePath), AIconIndex);
    //IPersistFile.Saveメソッドを実行すると結果が反映される
    if LIPersistFile.Save(Pchar(ALinkFilePath), False) = S_OK then begin
      Result := True;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  ショートカットファイル(拡張子は.lnk)のアイコンのパス名を取得
//  ファイルの存在確認はしてない
//
//  ALinkFilePath      : ショットカットファイルのパス名
//  var AIconFilePath : アイコンファイルのパス名を返す
//                      またはアイコンが格納されているEXEやDLLのパス名を返す
//  var AIconIndex    : EXEまたはDLL内のアイコンのインデックス番号を返す
//
//  CreateComObjectの使用にはusesにComObjが必要
//  IShellLinkの使用にはusesにShObjが必要
//  IPersistFileの使用にはusesにActiveXが必要
//-----------------------------------------------------------------------------
function GetShortCutIconPath(ALinkFilePath: string; var AIconFilePath: string;
  var AIconIndex: Integer): Boolean;
var
  LIShellLink   : IShellLink;
  LIPersistFile : IPersistFile;
  LpIconPath    : array [0..MAX_PATH - 1] of Char;
begin
  Result := False;

  //IShellLink,IPersistFileインターフェイスのオブジェクトを生成
  LIShellLink   := CreateComObject(CLSID_ShellLink) as IShellLink;
  LIPersistFile := LIShellLink as IPersistFile;

  if Succeeded(LIPersistFile.Load(PChar(ALinkFilePath), STGM_READ)) then begin
    //アイコンのパス名とインデックスを取得
    FillChar(LpIconPath, MAX_PATH, #0);
    if LIShellLink.GetIconLocation(LpIconPath, MAX_PATH, AIconIndex) = S_OK then begin
      AIconFilePath := LpIconPath;
      Result := True;
    end;
  end;
end;

end.




02_ログイン時 ( システム起動時 ) に自動実行するプログラム


ショートカットを CSIDL_STARTUP に相当するディレクトリ内に作成すると,現在のユーザがコンピュータにログインした時に,このショートカットのプログラムを自動実行するようになります.ログイン画面を使用しない場合は,システムあるいは OS の起動時に実行されます.

CSIDL_COMMON_STARTUP に相当するディレクトリにショートカットを作成すると,そのコンピュータのどのユーザがログインしても自動で実行されます.



図3
スタートアップに登録される

リスト3
システムの起動時に自動実行するショートカットを作成
//=============================================================================
//  指定ディレクトリにショートカットを作成
//  ここではスタートアップに本プログラムのショートカットを作成
//
//  添付のplShortcutUtilsユニット内の関数類を使用
//  CSIDL_STARTUP等の定数名の使用にはusesにShlObjが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LDir : string;
begin
  //CSIDLの値からフルパスを取得
  //ショートカットを作成する場所
  LDir := GetDirectoryFromCSIDL(CSIDL_STARTUP);

  //ショートカットを作成
  CreateShortCutLink(Application.ExeName, LDir, 'テストリンク');
end;

//=============================================================================
//  指定ディレクトリ内のショートカットを削除
//  ここではスタートアップの,このプログラムのショートカットを削除
//
//  添付のplShortcutUtilsユニット内の関数類を使用
//  CSIDL_STARTUP等の定数名の使用にはusesにShlObjが必要
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LDir : string;
begin
  //CSIDLの値からフルパスを取得
  //削除するショートカットがある場所
  LDir := GetDirectoryFromCSIDL(CSIDL_STARTUP);

  //ショートカットを削除
  DeleteShorCutLink(Application.ExeName, LDir);
end;




03_ショートカットのアイコンを変更


作成済みのショートカットのアイコンだけを変更するサンプルです.

TOpenDialog を使用して,対象のショートカット (拡張は .lnk) とアイコンファイルを選択できるようにしています.DLL 内には複数のアイコンが格納されている場合があります.その場合は,何番目のアイコンを取り出すかを指定します.

新しく設定するアイコンファイルに表示サイズのアイコンがない場合は,拡大または縮小表示されます.デスクトップのショートカットのアイコンのサイズは,デフォルトでは 48 x 48 です.



[備考 1]
本サンプルと次項のサンプルで変更するのは,ショートカットのアイコンだけです.
EXE ファイルの場合は,アプリケーションアイコンを変更すれば,そのショートカットのアイコンも自動的に変わります.

[備考 2]
元のアイコンに戻すには,アイコンファイルのパス名を空白にして関数を実行します.
ショートカットのアイコンは,アイコンファイルが指定されていればそれが優先的に使われます.アイコンファイルの指定がない場合は,リンク元のアイコンが使われます.

したがって,もし,ショートカットの元のアイコンが,何かのファイル内のアイコンを使用していた場合,本サンプルで [元に戻す] を実行しても元に戻らないことがあります.



図4
設計時画面
図5
実行例
  • 上のサンプルで作成したショートカットのアイコンを変更した結果
  • このアイコンは imageres.dll 内の 13 番のアイコン
  • [元に戻す] 時は,[Icon File] の値は使用しない

リスト4
ショートカットのアイコンを変更するサンプル
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, Spin;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    LabeledEdit1: TLabeledEdit;
    LabeledEdit2: TLabeledEdit;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    OpenDialog2: TOpenDialog;
    SpinEdit1: TSpinEdit;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plShortcutUtils,
  ShlObj;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//
//  添付のplShortcutUtilsユニット内の関数類を使用
//  CSIDL_DESKTOP等の定数名の使用にはusesにShlObjが必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LDir : string;
begin
  LabeledEdit1.AutoSelect := False;
  LabeledEdit2.AutoSelect := False;
  ActiveControl := LabeledEdit1;

  //CSIDLの値からデスクトップのフルパスを取得
  //ショートカットがある場所
  LDir := GetDirectoryFromCSIDL(CSIDL_DESKTOP);

  LabeledEdit1.Text := '';
  LabeledEdit2.Text := '';
  SpinEdit1.Value := 0;

  //.lnkファイルの場合,リンク先でなく.lnkファイルそのものを取得するようにする
  //TOpenDialogは.lnkの場合,デフォルトではリンク先のファイル名を取得する
  OpenDialog1.Options    := OpenDialog1.Options + [ofNoDereferenceLinks];
  OpenDialog1.InitialDir := LDir;
  OpenDialog2.InitialDir := ExpandFileName('..\');
end;

//=============================================================================
//  アイコンを変更するショートカット(.lnk)ファイルを選択
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  OpenDialog1.Filter := 'ショーカット (*.lnk)|*.lnk';
  if OpenDialog1.Execute then begin
    LabeledEdit1.Text := OpenDialog1.FileName;
    OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);
  end;
end;

//=============================================================================
//  新しく設定するアイコンのファイルを選択
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  OpenDialog2.Filter := 'アイコンファイル (*.ico)|*.ico|'
                      + 'DLL ファイル (*.dll)|*.dll|'
                      + '実行ファイル (*.exe)|*.exe|'
                      + 'CPL ファイル (*.cpl)|*.cpl';
  if OpenDialog2.Execute then begin
    LabeledEdit2.Text := OpenDialog2.FileName;
    OpenDialog2.InitialDir := ExtractFileDir(OpenDialog2.FileName);
  end;
end;

//=============================================================================
//  ショートカットのアイコンを変更
//
//  添付のplShortcutUtilsユニット内の関数を使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if LabeledEdit1.Text = '' then exit;

  //アイコンを変更
  ChangeShortCutIcon(LabeledEdit1.Text, LabeledEdit2.Text, SpinEdit1.Value);
end;

//=============================================================================
//  ショートカットのアイコンを元に戻す
//
//  添付のplShortcutUtilsユニット内の関数を使用
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LIconPath  : string;
  LIconIndex : Integer;
begin
  if LabeledEdit1.Text = '' then exit;
  LIconPath := LabeledEdit2.Text;

  GetShortCutIconPath(LabeledEdit1.Text, LIconPath, LIconIndex);
  if LIconPath = '' then begin
    MessageBox(Handle, 'アイコンは変更されていません', '情報', MB_OK);
  end else begin
    //アイコンをリンク元のEXEのアプリケーションアイコンにする
    ChangeShortCutIcon(LabeledEdit1.Text, '', SpinEdit1.Value);
  end;
end;

end.




04_ショートカットのアイコンを変更 - [ アイコンの変更 ] ダイアログ


上のサンプルと同じくショートカットのアイコンを変更するサンプルです.[アイコンの変更] ダイアログを表示してアイコンを選択するようにしています.
このダイアログは,ショートカットファイルのプロパティのダイアログで [アイコンの変更] ボタンをクリックした時に現れるダイアログと同じです.


図6
設計時画面
図7
実行例
  • 上のサンプルで変更したアイコンを更に変更した結果
図8
元のアイコンに戻した結果
  • リンク先の EXE のアプリケーションアイコンになる

リスト5
[アイコンの変更] ダイアログを表示して,ショートカットのアイコンを変更
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    LabeledEdit1: TLabeledEdit;
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FFilePath  : string;
    FIconIndex : Integer;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  plShortcutUtils,
  ShlObj,
  ShellAPI;

{$R *.dfm}

  //---------------------------------------------------------------------------
  //  shell32.dllの序数62の名前なし関数を使用するための関数の定義
  //  この関数は非公開API関数
  //
  //  usesにShellAPIが必要.
  //---------------------------------------------------------------------------
  function SH_PickIconDlg(
      Handle       : THandle;
      lpFileName   : PChar;
      var FileSize : DWORD;
      var Index    : Integer):Integer; stdcall; external 'shell32.dll' index 62;


//=============================================================================
//  フォーム生成時の処理
//
//  添付のplShortcutUtilsユニット内の関数類を使用
//  CSIDL_DESKTOP等の定数名の使用にはusesにShlObjが必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
  LDir : string;
begin
  LabeledEdit1.AutoSelect := False;
  ActiveControl := LabeledEdit1;

  //CSIDLの値からデスクトップのフルパスを取得
  //対象のショートカットがある場所
  LDir := GetDirectoryFromCSIDL(CSIDL_DESKTOP);

  LabeledEdit1.Text := '';
  FFilePath := 'c:\Windows\system32\imageres.dll';

  //.lnkファイルの場合,リンク先でなく.lnkファイルそのものを取得するようにする
  //TOpenDialogは.lnkの場合,デフォルトではリンク先のファイル名を取得する
  OpenDialog1.Options    := OpenDialog1.Options + [ofNoDereferenceLinks];
  OpenDialog1.InitialDir := LDir;
end;

//=============================================================================
//  アイコンを変更するショートカット(.lnk)ファイルを選択
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  OpenDialog1.Filter := 'ショーカット (*.lnk)|*.lnk';
  if OpenDialog1.Execute then begin
    LabeledEdit1.Text := OpenDialog1.FileName;
    OpenDialog1.InitialDir := ExtractFileDir(OpenDialog1.FileName);
  end;
end;

//=============================================================================
//  ショートカットのアイコンを変更
//  [アイコンの変更]ダイアログを表示してアイコンを選択
//
//  添付のplShortcutUtilsユニット内の関数を使用
//  ExtractIconの使用にはusesにShellAPIが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LpFilePath : PChar;
  LFileSize  : Cardinal;
  LhIcon     : HICON;
begin
  LFileSize  := MAX_PATH;
  LpFilePath := StrAlloc(LFileSize + 1);
  StrPCopy(LpFilePath, FFilePath);

  try
    //[アイコンの変更]ダイアログを表示
    if SH_PickIconDlg(Handle, LpFilePath, LFileSize, FIconIndex) = 1 then begin
      //アイコンを取出す
      LhIcon := ExtractIcon(hInstance, LpFilePath, FIconIndex);
      //アイコンを変更
      FFilePath := LpFilePath;
      ChangeShortCutIcon(LabeledEdit1.Text, FFilePath, FIconIndex);
      //アイコンハンドルを解放
      DestroyIcon(LhIcon);
    end;
  finally
    StrDispose(LpFilePath);
  end;
end;

//=============================================================================
//  ショートカットのアイコンを元に戻す
//  変更されていなければ何もしない
//
//  添付のplShortcutUtilsユニット内の関数を使用
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  if LabeledEdit1.Text = '' then exit;
  //アイコンを元に戻す
  ChangeShortCutIcon(LabeledEdit1.Text, '', 0); 
end;

end.