フォルダ選択ダイアログのUnicodeフォルダパスの取得について

解決

ウィング 2006-04-11 03:20:57 No: 95012

VB6SP6、WindowsXPで開発を行っています。

SHBrowseForFolderを使用して中国語、タイ語などの
選択したフォルダパスを取得したいのですが、
わかる方いらっしゃいましたら教えてください。

SHBrowseForFolderに関するサンプルはいくつか見つけたのですが、
どれも、Ansi対応みたいで選択した中国語、タイ語のフォルダ名称は
文字化けしてしまいます。

Ailias名をSHBrowseForFolderWに変えればと思い試してみたのですが
やっぱりだめでした。

よろしくお願いいたします。

K.J.K. 2006-04-11 03:29:42 No: 95013

どう試して、「やっぱりだめでした。」のでしょうか?
VB6の文字列の取り扱いについてわかっていれば、W版のAPI関数を
使うのはそこではない、ということに気付くだろうと思います。

ウィング 2006-04-11 04:26:39 No: 95014

回答ありがとうございます。

>どう試して、「やっぱりだめでした。」のでしょうか?
詳しく書いてなくて、すみません。

>VB6の文字列の取り扱いについてわかっていれば、W版のAPI関数を
>使うのはそこではない、ということに気付くだろうと思います。
文字列の取扱いについては、内部ではUniCodeで持っているという
ことぐらいしかわかりません。

下記のソースコードが実際にやってみたコードです。

'標準モジュール***********************************************
'フォルダ選択ダイアログを表示
Private Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderW" (lpbi As BROWSEINFO) As Long
'上記関数で取得したポインタを元にフォルダを取得
Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListW"(ByVal pidl As Long, ByVal pszPath As String) As Long
'SH〜で取得したメモリブロックを開放する
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pidl As Long)

'ブラウザ情報構造体
Private Type BROWSEINFO
    hWndOwner       As Long
    pidlRoot        As Long
    pszDisplayName  As String
    lpszTitle       As String
    ulFlags         As Long
    lpfn            As Long
    lParam          As String
    iImage          As Long
End Type

'*-引数-----------------------------------------------------------
'* vstrCaption              String      IN      タイトル名
'* vlngOwnerHwnd            Long        IN      オーナーウィンドウ
'* vlngRoot                 Long        IN      ルートフォルダ
'* vlngFlags                Long        IN      フィルター
'* vstrDefultFolder         String      IN      デフォルトのフォルダ名
'*-戻り値-----------------------------------------------------------
'* 選択文字列               String              選択したフォルダパス(キャンセル時は空)
'*******************************************************************
Public Function selectFolder(Optional ByVal vstrCaption As String = vbNullString _
                           , Optional ByVal vlngOwnerHwnd As Long = 0 _
                           , Optional ByVal vlngRoot As Long = CGLNG_ROOT_DESKTOP _
                           , Optional ByVal vlngFlags As Long = CGLNG_FLAG_RETURNONLYFSDIRS _
                           , Optional ByVal vstrDefultFolder As String = "") As String
    On Error GoTo ErrorHandler

    Dim typBinfo    As BROWSEINFO   'フォルダ情報構造体
    Dim lngpid      As Long
    Dim strPath     As String

    '親Windowが指定されていなければデスクトップを親Windowにする
    If vlngOwnerHwnd = 0 Then
        vlngOwnerHwnd = GetDesktopWindow()
    End If

'バッファ設定
strPath = String$(MAX_PATH, vbNullChar)

    'BROWSEINFO 構造体設定
    With typBinfo
        .hWndOwner = vlngOwnerHwnd
        .pszDisplayName = String$(256, vbNullChar)
        .lpszTitle = vstrCaption & vbNullChar
        .ulFlags = vlngFlags
        'デフォルトフォルダが指定されていたらコールバック関数を使用する
        If Len(vstrDefultFolder) > 0 Then
            .lpfn = GetAddressOF(AddressOf BForFolderCallbackProc)
            .lParam = vstrDefultFolder & vbNullChar
        End If
    End With

    ' フォルダー選択ダイアログを表示
    lngpid = SHBrowseForFolder(typBinfo)

    If typBinfo.ulFlags And CGLNG_FLAG_BROWSEFORCOMPUTER Then
        strPath = typBinfo.pszDisplayName
        '不要文字列を削除する
        strPath = Left$(strPath, InStr(strPath, vbNullChar) - 1)

    Else
        'キャンセルが押された場合
        If lngpid = 0 Then
            strPath = vbNullString
        'OKが押された場合
        Else
            'pidよりパスを取得する
            If SHGetPathFromIDList(lngpid, strPath) = 0 Then
                ' SHGetPathFromIDList がエラー
                strPath = vbNullString
            Else
                ' Null切捨て
                strPath = Left$(strPath, _
                    InStr(strPath, vbNullChar) - 1&)
            End If
        End If
    End If

'ITEMIDLIST解放
Call CoTaskMemFree(lngpid)

'戻値
selectFolder = strPath

Exit Function
ErrorHandler:

End Function

' 長文になるためコールバック関数は省かせていただきます。

K.J.K. 2006-04-11 05:21:46 No: 95015

Declareステートメントで宣言された外部関数に渡すときの
(ByVal) ... As Stringは、Cでの表記だと
× LPWSTR
ではなく
○ LPSTR
に変換されるようになっています。

内部保持形式をユニコードにしたままで渡したいのならば、
Declareステートメントを用いるのであれば、
× ByVal ... As String
ではなく
○ ByRef ... As Byte
とした上で、

Dim pIDList As Long
Dim sBuffer As String
Dim abBuffer() As Byte

' この時点でAPI関数から有効なpidlがpIDListに渡されたとする。

ReDim abBuffer(0& To 1023&) As Byte
If 0& <> SHGetPathFromIDList(pIDList, abBuffer(0&)) Then
sBuffer = abBuffer
' ここ以降でvbNullChar以降を切り捨てる処理を行う。
End if

というような手順で進めます。

ひろ 2006-04-11 06:03:00 No: 95016

Unicodeでパス名を扱うときは徹底して Unicodeのままで扱うことが大事です。

・一部の文字でマッピングが１対他になっていて非可逆になっている
・U+00A5 はシフトJISの 0x5c ="\"に変換される

という問題がありますので。

ウィング 2006-04-11 06:56:37 No: 95017

回答ありがとうございます。

K.J.Kさんの言われるとおりにやってみたところ、
できました！！

Stringではなく、Byteを使わないといけないのですね・・。
勝手に変換かかってしまうなんて、知りませんでした。
とても勉強になりました。
ありがとうございました。

>Unicodeでパス名を扱うときは徹底して Unicodeのままで扱うことが大事です。
わかりました。パス名は、Unicodeで扱うように気をつけます。

解決とういうことで、できたソースを書いておきます。
この件に付随する問題があるのですが、それは別で起こします。
(いっぱい質問ばっかりですみませんがよろしくお願いします。)

'上記関数で取得したポインタを元にフォルダを取得
Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListW" (ByVal pidl As Long, ByRef pszPath As Byte) As Long

Dim typBinfo    As BROWSEINFO   'フォルダ情報構造体
Dim lngpid      As Long
Dim strPath     As String
Dim abBuffer()  As Byte

' フォルダー選択ダイアログを表示
lngpid = SHBrowseForFolder(typBinfo)

If typBinfo.ulFlags And CGLNG_FLAG_BROWSEFORCOMPUTER Then
    strPath = typBinfo.pszDisplayName
    '不要文字列を削除する
    strPath = Left$(strPath, InStr(strPath, vbNullChar) - 1)

'フォルダ名やコンピュータ名取得
Else
    'キャンセルが押された場合
    If lngpid = 0 Then
        strPath = vbNullString
    'OKが押された場合
    Else

        ReDim abBuffer(0& To 1023&) As Byte
        If 0& <> SHGetPathFromIDList(lngpid, abBuffer(0&)) Then
            strPath = abBuffer
            ' ここ以降でvbNullChar以降を切り捨てる処理を行う。
            ' Null切捨て
            strPath = Left$(strPath, _
                InStr(strPath, vbNullChar) - 1&)
        End If
    End If
End If