unit Shortcut;

interface

uses
  Windows, Forms, SysUtils, FileCtrl, ShlObj, ActiveX, ComObj, Registry;

    function ShortcutCtrl( path, group, title: string;
                            func, place, user: char ): boolean;

implementation

//======================================================================
//  機能：ショートカットの作成／削除
//======================================================================
function ShortcutCtrl(
    path : string;          {ﾌｧｲﾙのﾌﾙﾊﾟｽ}
    group: string;          {登録ｸﾞﾙｰﾌﾟ名}
    title: string;          {登録名称}
    func : char;            {処理区分(C:作成,D:削除)}
    place: char;            {ｼｮｰﾄｶｯﾄの場所 (M:ﾌﾟﾛｸﾞﾗﾑﾒﾆｭｰ, D:ﾃﾞｽｸﾄｯﾌﾟ,
                                            S:ｽﾀｰﾄｱｯﾌﾟ, Q:ｸｲｯｸ起動)}
    user : char             {対象ﾕｰｻﾞｰ(U:現ﾕｰｻﾞｰのみ,A:全ﾕｰｻﾞｰ)}
                            {(注意)全ﾕｰｻﾞｰを指定時､管理者権限が無いと実行不可}
): boolean;
var
        ppmem: IMalloc;
        Directory : array[0..MAX_PATH] of Char;
        szDirectory: string;
        UnknownObject: IUnknown;
        psl: IShellLink;
        ppf: IPersistFile;
        lpi: PItemIDList;
        wFileName : WideString;
        nFolder: integer;
        VerInfo: TOSVersionInfo;
begin
    Result := FALSE;
    //OS種別を判定し、Win95系なら強制的に現ﾕｰｻﾞｰのみに変更
    VerInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );
    GetVersionEx( VerInfo );
    if VerInfo.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS then user:='U';

    case place of
        'M': begin          {ｼｮｰﾄｶｯﾄの場所=ﾌﾟﾛｸﾞﾗﾑﾒﾆｭｰ}
            if user='U' then nFolder := CSIDL_PROGRAMS
                        else nFolder := CSIDL_COMMON_PROGRAMS;
        end;
        'D': begin          {ｼｮｰﾄｶｯﾄの場所=ﾃﾞｽｸﾄｯﾌﾟ}
            if user='U' then nFolder := CSIDL_DESKTOPDIRECTORY
                        else nFolder := CSIDL_COMMON_DESKTOPDIRECTORY;
        end;
        'S': begin          {ｼｮｰﾄｶｯﾄの場所=ｽﾀｰﾄｱｯﾌﾟ}
            if user='U' then nFolder := CSIDL_STARTUP
                        else nFolder := CSIDL_COMMON_STARTUP;
        end;
        'Q': begin          {ｼｮｰﾄｶｯﾄの場所=ｸｲｯｸ起動}
            nFolder := CSIDL_APPDATA;
        end;
        else Exit;
    end;
    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;
    if place='Q' then begin         {ｼｮｰﾄｶｯﾄの場所=ｸｲｯｸ起動}
        StrPCopy( Directory, StrPas(Directory)
                        + '\Microsoft\Internet Explorer\Quick Launch' );
    end;

    with psl do begin
        SetPath(PChar(path));
        SetWorkingDirectory(PChar(ExtractFilePath(path)));
    end;

    if func='C' then begin      {作成時}
        if place='M' then begin     {ｼｮｰﾄｶｯﾄの場所=ﾌﾟﾛｸﾞﾗﾑﾒﾆｭｰ}
            // プログラムメニューに指定グループを作成
            StrPCopy( Directory, StrPas(Directory)+'\'+group );
            if DirectoryExists(Directory)=FALSE then
                ForceDirectories( Directory );
        end;
        szDirectory := strpas(Directory);
        wFileName := szDirectory +'\'+ title + '.lnk';
        ppf.Save( PWChar(WFileName), False );
    end
    else begin                  {削除時}
        if place='M' then begin     {ｼｮｰﾄｶｯﾄの場所=ﾌﾟﾛｸﾞﾗﾑﾒﾆｭｰ}
            // プログラムメニューに指定グループが有れば
            StrPCopy( Directory, StrPas(Directory)+'\'+group );
            if DirectoryExists(Directory) then begin
                szDirectory := strpas(Directory);
                wFileName := szDirectory +'\'+ title + '.lnk';
                DeleteFile( wFileName );
                RemoveDirectory( Directory );
            end;
        end
        else begin
            szDirectory := strpas(Directory);
            wFileName := szDirectory +'\'+ title + '.lnk';
            DeleteFile( wFileName );
        end;
    end;

    if Assigned(lpi) then ppmem.Free(lpi);
    Result := TRUE;
end;

end.

(上記コードをShortcut.pasとして保存する)


<< 使用例 >>

uses Shortcut;

procedure TForm1.Button1Click(Sender: TObject);
begin
    if TButton(Sender).Caption='作成' then begin
        //プログラムメニューに現ユーザーで作成
        ShortcutCtrl( ParamStr(0),'ぐるーぷ','なまえ','C','M','U' );
        //デスクトップに全ユーザーで作成
        ShortcutCtrl( ParamStr(0),'','なまえ','C','D','A' );
    end
    else begin
        //削除する時
        ShortcutCtrl( ParamStr(0),'ぐるーぷ','なまえ','D','M','U' );
        ShortcutCtrl( ParamStr(0),'','なまえ','D','D','A' );
    end;
end;

(補足)
・グループは「ABC\DEF」の様に階層指定が可能です。
・ショートカットの削除後、グループ内が空になればグループの削除も行います。
  但し階層指定時は最下層のフォルダーしか削除されません。


C++Builderから利用する場合は、下記の手順により可能です。
1.上記サンプルをShortcut.pasとして保存し、プロジェクトに追加する
2.#include "Shortcut.hpp"を追加する
3.作成する時は下記の様にコール
    ShortcutCtrl( ParamStr(0),"ぐるーぷ","なまえ",'C','M','U' );
    ShortcutCtrl( ParamStr(0),"","なまえ",'C','D','A' );
4.削除する時は下記の様にコール
    ShortcutCtrl( ParamStr(0),"ぐるーぷ","なまえ",'D','M','U' );
    ShortcutCtrl( ParamStr(0),"","なまえ",'D','D','A' );