● Shell32.dllに生息する妙なAPI関数達 ●
Shell32.dll を覗き見して興味を持ったAPI関数をちらほらと動作確認してみた。以下のすべては Windows XP(SP2) または Windows 2003 Server 以降に追加された関数らしい。

以下はひとまず共通で使用するための関数。おなじみのNULL文字までの文字列を取得する関数である。 

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：文字列を Chr$(0)[=vbNullChar] まで取得する
' 引  数：(in)SrcStr … 対象文字列
' 返り値：編集された文字列
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Private Function StrNullCut(ByVal SrcStr As String) As String
    Dim NullCharPos As Long
    NullCharPos = InStr(SrcStr, Chr$(0))
    If NullCharPos = 0 Then
        StrNullCut = SrcStr
        Exit Function
    End If
    StrNullCut = Left$(SrcStr, NullCharPos - 1)
End Function

以下より１つずつ列挙していく。API関数の別名 alias には一応、序数を指定しておいた。Windows Vista 以降で序数が変わっているかもしれないが、それは知ったこっちゃない。もし動かない場合は alias を削除してください。API関数 PathGetShortPath の引数がちょっと変わっているが、非常に合理的である。API関数 PathGetShortPath も同様の作りに出来たと思われるが…はて？ あと Win32DeleteFile の作成者はせっかちなのであろうか？ Kernel32.dll に DeleteFile がいるのにねぇ。

'序数：92   機能：長いファイルパスを短いファイルパスに変換する
Private Declare Sub PathGetShortPath Lib "shell32" Alias "#92" (ByRef pszLongPath As Long) 

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：長いファイルパスを短いファイルパスに変換する
' 引  数：(i)FileName … 長いファイル名(フルパス)
' 返り値：短いファイルパス
'         存在しないファイルが渡された場合は引数で渡されたFileNameの値が返る
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function ConvLongName2ShortName(ByVal FileName As String)
     Call PathGetShortPath(ByVal StrPtr(FileName))
     ConvLongName2ShortName = StrNullCut(FileName)
End Function

'序数：43   拡張子を見て実行ファイル系かどうか判定する
Private Declare Function PathIsExe Lib "shell32" Alias "#43" (ByVal szFile As Long) As Long 

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：拡張子を見て実行ファイル系かどうか判定する
'         実行ファイルとみなされる拡張子：cmd, bat, pif, exe, com, scr 等
' 引  数：(i)FileName … ファイル名
' 返り値：True…実行ファイル系である  False…実行ファイル系でない
' 備  考：引数のファイル名は存在しないファイルでも判定対象となる
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function IsExeSeriesFile(ByVal FileName As String) As Boolean
     IsExeSeriesFile = PathIsExe(ByVal StrPtr(FileName))
End Function

'序数：164   ファイルを削除する
Private Declare Function Win32DeleteFile Lib "shell32" Alias "#164" (ByVal pszFileName As Long) As Long 

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：ファイルを削除する
' 引  数：(i)FileName … ファイル名
' 返り値：正常…True  異常…False
' 備  考：ディレクトリを削除することは出来ない
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function DeleteFile(ByVal FileName As String) As Boolean
    DeleteFile = Win32DeleteFile(StrPtr(FileName))
End Function

'序数：165   ディレクトリを作成する
Private Declare Function SHCreateDirectory Lib "shell32" Alias "#165" (ByVal hWnd As Long, ByVal lpcwPath As Long) As Long 

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：ディレクトリを作成する
' 引  数：(i)hWnd      … 呼び出しウィンドウのハンドル
'         (i)TargetDir … 作成するディレクトリ(フルパス)
' 返り値：正常…True  異常…False
' 備  考：既にディレクトリが存在する場合はFalseを返す
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function CreateDirectory(ByVal hWnd As Long, ByVal TargetDir As String) As Boolean
    'SHCreateDirectory は 正常時は-1、異常時は0を返す
    CreateDirectory = Not CBool(SHCreateDirectory(hWnd, StrPtr(TargetDir)))
End Function

'序数：680   ログインユーザが管理者グループに属しているかを判定する
'                管理者グループの場合は 1 が返る、それ以外は 0 が返る
Private Declare Function IsUserAnAdmin Lib "shell32" Alias "#680" () As Long 

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：ログインユーザが管理者グループに属しているかを判定する
' 引  数：なし
' 返り値：ログインユーザが管理者グループである場合はTrue、そうでない場合はFalse
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function IsUserInAdminGroup() As Boolean
     IsUserInAdminGroup = CBool(IsUserAnAdmin)
End Function

'序数：171   ファイルパスの使用不可能文字を取り除く
Private Declare Function PathCleanupSpec Lib "shell32" Alias "#171" (ByVal pszDir As Long, ByVal pszSpec As Long) As Long

Public Const PCS_REPLACEDCHARS As Long = &H1 '使用不可能文字を置換した → / があるとこれが返る
Public Const PCS_REMOVEDCHARS As Long = &H2  '使用不可能文字を除去した → \:*?<>| があるとこれが返る
Public Const PCS_SHORTENED As Long = &H4     '返されたパスを切り捨てた
Public Const PCS_PATHTOOLONG As Long = &H8   '長ぇ〜よ
Public Const PCS_FATAL As Long = &H8000000   '致命的エラー

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：ファイル名を洗浄する(ファイルパスではなく、ファイル名)
' 引  数：(i)InFileName  … 汚いファイル名
'         (o)OutFileName … 綺麗なファイル名
' 返り値：上記 PCS_XXX 定数の組み合わせが返る
' 備  考：返り値はシュールすぎてよう分からん
'         ↓とりあえずすべての返り値を出してみた。色々と頑張ってみたが 8(＝長ぇ〜よ) は出なかった
'         Testあいう.txt      → 0 が返る、綺麗にされて TESTあいう.TXT が返る(何故か大文字化される)
'         CMyApp/File         → 1 が返る、綺麗にされて CMyApp-File が返る
'         C:\MyAppFile        → 2 が返る、綺麗にされて CMyAppFile が返る
'         C:\MyApp/File       → 3 が返る、綺麗にされて CMyApp-File が返る
'         MyApp@File.txt      → 4 が返る、綺麗にされて MYAPP@FI.TXT が返る(何故か大文字化される)
'         MyApp/File.txt      → 5 が返る、綺麗にされて MYAPP-FI.TXT が返る(何故か大文字化される)
'         MyApp@:File.txt     → 6 が返る、綺麗にされて MYAPP@FI.TXT が返る(何故か大文字化される)
'         MyApp@:File.txt.exe → 7 が返る、綺麗にされて MYAPP@FI.EXE が返る(何故か大文字化される)
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function CleanUpPath(ByVal InFileName As String, ByRef OutFileName As String) As Long
    CleanUpPath = PathCleanupSpec(StrPtr(InFileName), StrPtr(InFileName))
    OutFileName = StrNullCut(InFileName)
End Function

'序数：63   ファイルを開くコモンダイアログを表示する
Private Declare Function GetFileNameFromBrowse Lib "shell32" Alias "#63" (ByVal hWnd As Long, ByVal pszFilePath As Long, ByVal cchFilePath As Long, ByVal pszWorkingDir As Long, ByVal pszDefExt As Long, ByVal pszFilters As Long, ByVal szTitle As Long) As Long
Private Const MAX_PATH = 260 

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：ファイルを開くためのダイアログボックスを表示し、ファイルのフルパスを返す
' 引  数：(i)hWnd        … 呼び出し側のウインドウハンドル
'         (i)InitialDir  … 初期ディレクトリ指定  (省略可能)
'         (i)Filter      … 拡張子設定のフィルタ  (省略可能)
'         (i)DialogTitle … ダイアログボックスのタイトル  (省略可能)
' 返り値：選択されたファイルのフルパス
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function ShowOpenFileDialogEx(ByVal hWnd As Long, _
                                   Optional ByVal InitialDir As String = "", _
                                   Optional ByVal Filter As String = _
                                     "すべてのファイル (*.*)" & vbNullChar & "*.*" & vbNullChar, _
                                   Optional ByVal DialogTitle As String = "ファイルを開く") As String
    Dim FileName As String
    Dim FuncRet As Long

    '返り値変数初期化
    FileName = String$(MAX_PATH, Chr$(0))

    'コモンダイアログ表示
    FuncRet = GetFileNameFromBrowse(hWnd, StrPtr(FileName), MAX_PATH, _
                                    StrPtr(InitialDir), 0&, StrPtr(Filter), StrPtr(DialogTitle))
    If FuncRet Then
        ShowOpenFileDialogEx = StrNullCut(FileName)
    End If

End Function

'序数：59   システム変更に伴うWindows終了ダイアログを表示する →[参照] Windows終了ダイアログを表示する画像
Private Declare Function RestartDialog Lib "shell32" Alias "#59" (ByVal hParent As Long, ByVal pszPrompt As Long, ByVal dwFlags As Long) As Long 

'RestartDialogの第３引数用列挙体
Public Enum RES_DLG_FLAG
    EWX_LOGOFF = 0        'ログオフ
    EWX_SHUTDOWN = 1      'シャットダウン
    EWX_REBOOT = 2        '再起動
    EWX_FORCE = 4         '緊急用で何が何でも強制終了の場合に使用する
                          'WM_QUERYENDSESSIONとWM_ENDSESSION をシステムに送信しない
    EWX_POWEROFF = 8      'パワーオフ
    EWX_FORCEIFHUNG = 16  'WM_QUERYENDSESSIONとWM_ENDSESSION を送信し、応答が無くても終了する
End Enum


''-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：システム変更に伴うWindows終了ダイアログを表示する
' 引  数：(i)hWnd    … 呼び出し元ウィンドウのハンドル
'         (i)PrptMsg … 表示するメッセージ
'         (i)EnumFlg … フラグの列挙体
' 返り値：ダイアログのボタンのIDが返る(キャンセルされた場合は 7)
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function OpenRestartDialog(ByVal hWnd As long), ByVal PrmptMsg As String, _
                                  Optional ByVal EnumFlg As RES_DLG_FLAG = EWX_SHUTDOWN) As Long
    OpenRestartDialog = RestartDialog(hWnd, StrPtr(PrmptMsg & vbCrLf), EnumFlg)
End Function

'序数：62   アイコンの変更ダイアログを表示する →[参照] アイコンの変更ダイアログ画像
Private Declare Function PickIconDlg Lib "shell32" Alias "#62" (ByVal hWnd As Long, ByVal pszIconPath As Long, ByVal cchIconPath As Long, ByRef piIconIndex As Long) As Long
Private Const MAX_PATH = 260 

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：アイコンの変更ダイアログを表示する
' 引  数：(i)hWnd        … 呼び出し元ウィンドウのハンドル
'         (i/o)FileName  … 選択前または選択後のアイコンを持つファイルの名前
'         (i/o)IconIndex … 選択前または選択後のアイコン位置(0〜)
' 返り値：正常…True  異常またはキャンセルされた…False
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function OpenIconDialog(ByVal hWnd As Long, ByRef FileName As String, ByRef IconIndex As Long) As Boolean
    Dim FuncRet As Long
    Dim FileNameB() As Byte

    '文字列→Byte配列変換
    FileNameB = FileName

    '元の値を保持しつつ、Byte配列を再確保
    ReDim Preserve FileNameB(MAX_PATH - 1) As Byte

    'アイコンの変更ダイアログを表示する
    OpenIconDialog = PickIconDlg(hWnd, VarPtr(FileNameB(0)), MAX_PATH, IconIndex)

    'Byte配列→文字列変換＆NULL文字以降削除
    FileName = StrNullCut(FileNameB)
End Function
[呼び出し方法]
Private Sub Command1_Click()
    Dim FileName As String
    Dim IconIndex As Long
    Dim FuncRet As Boolean

    'アイコンを含むファイルの名前
    FileName = "C:\Windows\System32\shell32.dll"
    'アイコン選択位置
    IconIndex = 10

    'アイコンの変更ダイアログを表示
    FuncRet = OpenIconDialog(frmMain.hWnd, FileName, IconIndex)
    If FuncRet Then
        Debug.Print "? FileName  : " & FileName
        Debug.Print "? IconIndex : " & IconIndex
    Else
        Debug.Print "キャンセルされました"
    End If
End Sub

[関連] コントロールパネルの各プロパティを起動する、コントロールパネルウィンドウを起動する

'序数：161   コントロールパネルを開く
Private Declare Function SHRunControlPanel Lib "shell32" Alias "#161" (ByVal lpcszCmdLine As Long, ByVal hWndMsgParent As Long) As Long

'序数：28、162   ディレクトリに対するpidを取得する
Private Declare Function SHILCreateFromPath Lib "shell32" Alias "#28" (ByVal pcwStr As Long, ByRef PidList As Long, ByRef rgfInOut As Long) As Long
Private Declare Function SHSimpleDListFromPath Lib "shell32" Alias "#162" (ByVal lpszPath As Long) As Long 

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：コントロールパネルを表示する
' 引  数：(i)hWnd    … ウィンドウハンドル
'         (i)OpenCpl … コンパネ文字列(フォーマット：コンパネ名,,タブ位置)
' 返り値：正常：True  異常：False
' 備  考：OpenCpl の指定が無い場合(＝空文字の場合)はコントロールパネルが表示される
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Public Function OpenControlPanel(ByVal hWnd As Long, Optional ByVal OpenCol As String = "") As Boolean
     OpenControlPanel = SHRunControlPanel(StrPtr(OpenCol), hWnd)
End Function

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' 機  能：ディレクトリからpidを取得する
' 引  数：(i)TargetDir … 対象ディレクトリ
' 返り値：ipdが返る   エラー時は 0
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Private Function GetPidFromDir(ByVal TargetDir As String) As Long
    Dim Rgf As Long
    Dim lpTargetPath As Long
    Dim FuncRet As Long

    '文字列の先頭アドレスを取得
    lpTargetPath = StrPtr(TargetDir)

    'ディレクトリに対するpidを取得する
    FuncRet = SHILCreateFromPath(lpTargetPath, GetPidFromDir, Rgf)
    If FuncRet <> 0 Then
        'エラー時の保険(実はどう処理をすれば良いか分からんのだよ)
        GetPidFromDir = SHSimpleDListFromPath(lpTargetPath)
        If GetPidFromDir = 0 Then Exit Function
    End If
End Function
[OpenControlPanel の第２引数に渡す値]
開くウィンドウ第２引数選択させるタブの番号
コントロールパネル""(空文字) 
ユーザー補助のオプションaccess.cpl,,番号0：キーボード、1：サウンド、2：画面、3：マウス、4：全般
プログラムの追加と削除appwiz.cpl,,番号
0：プログラムの変更と削除(H)1：プログラムの追加(N)
2：Windowsコンポーネントの追加と削除(A)    3：プログラムのアクセスと規定の設定(O)
画面のプロパティdesk.cpl-1(?)：テーマ、0：デスクトップ、1：スクリーンセイバー、2：デザイン、3：設定
Windowsファイアウォールfirewall.cplタブ(３つ)はあれど指定できず
ハードウェアの追加ウィザードhdwwiz.cpl 
インターネットのプロパティinetcpl.cpl,,番号0：全般、1：セキュリティ、2：プライバシー、3：コンテンツ、4：接続、5：プログラム、6：詳細設定
地域と言語のオプションintl.cpl,,番号0：地域オプション、1：言語、2：詳細設定
ゲーム コントローラjoy.cpl 
Java コントロールパネルjpicpl32.cplタブ(５つ)はあれど指定できず
マウスのプロパティmain.cpl,,番号0：ボタン、1：ポインタ、2：ポインタ オプション、3：ホイール、4：ハードウェア
サウンドとオーディオデバイスのプロパティmmsys.cpl,,番号0：音量、1：サウンド、2：オーディオ、3：音声、4：ハードウェア
ネットワーク接続ncpa.cpl 
ネットワーク セットアップ ウィザードnetsetup.cpl 
ユーザー アカウントnusrmgr.cpl 
ODBC データソース アドミニストレータodbccp32.cplタブ(７つ)はあれど指定できず
電源オプションのプロパティpowercfg.cplタブ(４つ)はあれど指定できず
システムのプロパティsysdm.cpl,,番号0：全般、1：コンピュータ名、2：ハードウェア、3：詳細設定、4：システムの復元、5：自動更新、6：リモート
所在地情報telephon.cpl 
日付と時刻のプロパティtimedate.cpl,,番号0：日付と時刻、1：タイムゾーン、2：インターネット時刻(実際は指定不能)
Windows セキュリティ センターwscui.cpl 
自動更新wuaucpl.cpl 
戻る