C# と VB.NET の質問掲示板

ASP.NET、C++/CLI、Java 何でもどうぞ

C# と VB.NET の入門サイト

Re[10]: フォルダーの選択ダイアログ


(過去ログ 167 を表示中)

[トピック内 11 記事 (1 - 11 表示)]  << 0 >>

■96429 / inTopicNo.1)  フォルダーの選択ダイアログ
  
□投稿者/ sony (1回)-(2020/11/22(Sun) 18:39:23)

分類:[.NET 全般] 

VB.NETでフォルダーの選択ダイアログを表示させたいのですが
https://dobon.net/vb/dotnet/form/folderdialog.html

このページの方法だと、
フォルダーパスをコピペで貼り付けることができないため不便です。

そのため、
https://excel-ubara.com/excelvba1/EXCELVBA376.html
https://excel-excel.com/letsmake/make38_step2.html

このページに書かれた方法を使いたいと考えています。
上記のコードはVBAのものなので、VB.NETでも互換性があると思いましたが

With Application.FileDialog(msoFileDialogFolderPicker)

のところでエラーが出てしまいます。
これはVB.NETでは使えないのでしょうか?

他のページを調べると
外部DLLを使うページや
https://thenewsinpu.hatenablog.jp/entry/2018/04/21/230616
https://www.totaltech365.net/entry/ookii-dialogs-folder-browser-dialog

自分でクラスを作るページが見つかりました。
https://qiita.com/otagaisama-1/items/b0804b9d6d37d82950f7


引用返信 編集キー/
■96430 / inTopicNo.2)  Re[1]: フォルダーの選択ダイアログ
□投稿者/ Hongliang (1121回)-(2020/11/22(Sun) 18:50:26)
はい、使えません。
VB.NETとVBAは実際のところ大して互換性はないですよ。
引用返信 編集キー/
■96431 / inTopicNo.3)  Re[2]: フォルダーの選択ダイアログ
□投稿者/ sony (2回)-(2020/11/22(Sun) 19:14:00)
ありがとうございます。
そうでしたか。

代替案として
https://qiita.com/otagaisama-1/items/b0804b9d6d37d82950f7

このページの方法をVBに翻訳して試しているのですが、
ダイアログは表示されるものの、フォルダーを選択してOKボタンを押しても

If Not hr.Equals(0) Then
                Return System.Windows.Forms.DialogResult.Abort
            End If

のところでReturnになってしまい、うまくいきません。
どこを修正すれば良いでしょうか?

以下はコードです。

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

Imports System
Imports System.Runtime.InteropServices

' https://qiita.com/otagaisama-1/items/b0804b9d6d37d82950f7




Public Class FolderSelectDialog

    Public Property Path As String
    Public Property Title As String

    Public Overloads Function ShowDialog() As System.Windows.Forms.DialogResult
        Return Me.ShowDialog(IntPtr.Zero)
    End Function

    Public Overloads Function ShowDialog(ByVal owner As System.Windows.Forms.IWin32Window) As System.Windows.Forms.DialogResult
        Return Me.ShowDialog(owner.Handle)
    End Function

    Public Overloads Function ShowDialog(ByVal owner As IntPtr) As System.Windows.Forms.DialogResult


        Dim dlg = CType(New FileOpenDialogInternal(), IFileOpenDialog)


        Try
            dlg.SetOptions((FOS.FOS_PICKFOLDERS Or FOS.FOS_FORCEFILESYSTEM))
            Dim item As IShellItem = Nothing
            If Not String.IsNullOrEmpty(Me.Path) Then
                Dim idl As IntPtr
                Dim atts As UInteger = 0
                If (NativeMethods.SHILCreateFromPath(Me.Path, idl, atts) = 0) Then
                    If (NativeMethods.SHCreateShellItem(IntPtr.Zero, IntPtr.Zero, idl, item) = 0) Then
                        dlg.SetFolder(item)
                    End If

                End If

            End If

            If Not String.IsNullOrEmpty(Me.Title) Then
                dlg.SetTitle(Me.Title)
            End If

            Dim hr As UInteger = dlg.Show(owner)
            If hr.Equals(NativeMethods.ERROR_CANCELLED) Then
                Return System.Windows.Forms.DialogResult.Cancel
            End If

            If Not hr.Equals(0) Then
                Return System.Windows.Forms.DialogResult.Abort
            End If

            dlg.GetResult(item)
            Dim outputPath As String = ""
            item.GetDisplayName(SIGDN.SIGDN_FILESYSPATH, outputPath)
            Me.Path = outputPath
            Return System.Windows.Forms.DialogResult.OK
        Finally
            Marshal.FinalReleaseComObject(dlg)
        End Try

    End Function

    <ComImport(), Guid("DC1C5A9C-E88A-4dde-A5A1-60F82A20AEF7")>
    Private Class FileOpenDialogInternal
    End Class

    ' not fully defined と記載された宣言は、支障ない範囲で端折ってあります。
    <ComImport(), Guid("42f85136-db7e-439c-85f1-e4075d135fc8"),
         InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
    Private Interface IFileOpenDialog

        <PreserveSig()>
        Function Show(ByVal hwndParent As IntPtr) As UInt32

        Sub SetFileTypes()

        ' not fully defined
        Sub SetFileTypeIndex()

        ' not fully defined
        Sub GetFileTypeIndex()

        ' not fully defined
        Sub Advise()

        ' not fully defined
        Sub Unadvise()

        Sub SetOptions(ByVal fos As FOS)

        Sub GetOptions()

        ' not fully defined
        Sub SetDefaultFolder()

        ' not fully defined
        Sub SetFolder(ByVal psi As IShellItem)

        Sub GetFolder()

        ' not fully defined
        Sub GetCurrentSelection()

        ' not fully defined
        Sub SetFileName()

        ' not fully defined
        Sub GetFileName()

        ' not fully defined
        Sub SetTitle(ByVal pszTitle As String)

        Sub SetOkButtonLabel()

        ' not fully defined
        Sub SetFileNameLabel()

        ' not fully defined
        Sub GetResult(ByRef ppsi As IShellItem)

        Sub AddPlace()

        ' not fully defined
        Sub SetDefaultExtension()

        ' not fully defined
        Sub Close()

        ' not fully defined
        Sub SetClientGuid()

        ' not fully defined
        Sub ClearClientData()

        Sub SetFilter()

        ' not fully defined
        Sub GetResults()

        ' not fully defined
        Sub GetSelectedItems()
    End Interface

    <ComImport(), Guid("43826D1E-E718-42EE-BC55-A1E261C37BFE"),
         InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
    Private Interface IShellItem

        Sub BindToHandler()

        ' not fully defined
        Sub GetParent()

        ' not fully defined
        Sub GetDisplayName(ByVal sigdnName As SIGDN, ByRef ppszName As String)

        Sub GetAttributes()

        ' not fully defined
        Sub Compare()
    End Interface

    Private Enum SIGDN As UInteger
        SIGDN_FILESYSPATH = 2147844096
    End Enum

    <Flags()>
    Private Enum FOS

        FOS_FORCEFILESYSTEM = 64

        FOS_PICKFOLDERS = 32
    End Enum

    Private Class NativeMethods

        Public Declare Function SHILCreateFromPath Lib "shell32.dll" (ByVal pszPath As String, ByRef ppIdl As IntPtr, ByRef rgflnOut As UInteger) As Integer

        Public Declare Function SHCreateShellItem Lib "shell32.dll" (ByVal pidlParent As IntPtr, ByVal psfParent As IntPtr, ByVal pidl As IntPtr, ByRef ppsi As IShellItem) As Integer

        Public Const ERROR_CANCELLED As UInteger = 2147943623
    End Class
End Class


引用返信 編集キー/
■96432 / inTopicNo.4)  Re[3]: フォルダーの選択ダイアログ
□投稿者/ Hongliang (1122回)-(2020/11/22(Sun) 19:53:33)
試してませんが、多分EqualsでUIntegerの値とIntegerの値を比較しようとしてるからでしょう。
整数型同士を比較してる箇所は全部、Equalsの代わりに「=」または「<>」演算子で比較するようにした方がいいと思います。
引用返信 編集キー/
■96433 / inTopicNo.5)  Re[4]: フォルダーの選択ダイアログ
□投稿者/ sony (3回)-(2020/11/22(Sun) 20:00:33)

ありがとうございます。

仰る通り
If Not hr.Equals(0) Then
ではエラーが出なくなりました。

しかし、
item.GetDisplayName(SIGDN.SIGDN_FILESYSPATH, outputPath)
のところで、

System.AccessViolationException はハンドルされませんでした。
Message: 型 'System.AccessViolationException' のハンドルされていない例外が mscorlib.dll で発生しました
追加情報:保護されているメモリに読み取りまたは書き込み操作を行おうとしました。他のメモリが壊れていることが考えられます。

というエラーが発生してしまいます。

どのように修正すればよろしいでしょうか?


引用返信 編集キー/
■96434 / inTopicNo.6)  Re[5]: フォルダーの選択ダイアログ
□投稿者/ Hongliang (1123回)-(2020/11/22(Sun) 20:24:32)
out stringだとCoTaskMemFreeしてくれるけどref stringだとそうでなかった、という記述を見かけたので、VBでByRef As Stringに置き換えるのはメモリ解放の点でよろしくない可能性がありますね。
ByRef ppszName As IntPtr
と定義しておいて、受け取ったIntPtrをMarshal.PtrToStringUniで文字列に変換するようにした方がいいでしょう。
また、受け取ったIntPtrはMarshal.FreeCoTaskMemで解放するようにします。
引用返信 編集キー/
■96435 / inTopicNo.7)  Re[6]: フォルダーの選択ダイアログ
□投稿者/ sony (4回)-(2020/11/22(Sun) 20:43:54)
ありがとうございます。

うまくいきました。

ただ、一つ問題が残っています。

初期フォルダーを設定したいのですが、これがうまくいっていません。
Me.Pathに初期フォルダーを設定しているにも拘わらず
If (NativeMethods.SHILCreateFromPath(Me.Path, idl, atts) = 0) Then

の返り値が0ではないため、
If (NativeMethods.SHCreateShellItem(IntPtr.Zero, IntPtr.Zero, idl, item) = 0) Then
dlg.SetFolder(item)
End If
が実行されず、うまく設定できていないようです。

ここはどのように修正すれば良いでしょうか?
引用返信 編集キー/
■96436 / inTopicNo.8)  Re[7]: フォルダーの選択ダイアログ
□投稿者/ Hongliang (1124回)-(2020/11/22(Sun) 21:20:53)
Declareは既定では文字列をANSIとして扱いますが、SHILCreateFromPathは文字列をPCWSTR、つまりUnicode(UTF-16)で要求しています。
Declare宣言部で以下のようにUnicodeの関数であると明示するか、
Declare Unicode Function ...
引数がUnicodeの文字列であると明示する必要があります。
<MarshalAs(UnmanagedType.LPWStr)> ByVal pszPath As String
リンク先は後者でやってますね。

ちなみに前者をDllImport属性でやる場合は、
DllImport("...", CharSet:=CharSet.Unicode)
という形になります。
引用返信 編集キー/
■96437 / inTopicNo.9)  Re[8]: フォルダーの選択ダイアログ
□投稿者/ sony (6回)-(2020/11/22(Sun) 21:39:11)
ありがとうございます。
うまくいきました。

そういえば良くみると
[MarshalAs(UnmanagedType.LPWStr)] と書かれてありましたね。

ByRef ppszName As IntPtrのところも[MarshalAs(UnmanagedType.LPWStr)] を付けるとうまくいきました。

ところで、上のご回答では
out stringだとCoTaskMemFreeしてくれるけどref stringだとそうでなかったはずなので
受け取ったIntPtrはMarshal.FreeCoTaskMemする必要があると仰っていますが、

idlや itemも、CoTaskMemFreeした方が良いのでしょうか?

もし、そうでないのであれば、
FreeCoTaskMemした方が良い場合としなくても良い場合も教えていただけると幸いです。

引用返信 編集キー/
■96438 / inTopicNo.10)  Re[9]: フォルダーの選択ダイアログ
□投稿者/ Hongliang (1125回)-(2020/11/22(Sun) 22:06:22)
> ByRef ppszName As IntPtrのところも[MarshalAs(UnmanagedType.LPWStr)] を付けるとうまくいきました。
IntPtrには付けるべきではないです。
それはマネージ側がStringまたはStringBuilderであるときに指定するものなので。

> idlや itemも、CoTaskMemFreeした方が良いのでしょうか?
> もし、そうでないのであれば、
> FreeCoTaskMemした方が良い場合としなくても良い場合も教えていただけると幸いです。
解放する必要があるかどうかは、ドキュメントを見るのが一番です。
と言いつつ、SHILCreateFromPathには直接記載がないんですが。
https://docs.microsoft.com/en-us/windows/win32/api/shlobj_core/nf-shlobj_core-shilcreatefrompath
代わりにITEMIDLISTの方に解説があって、
https://docs.microsoft.com/en-us/windows/win32/api/shtypes/ns-shtypes-itemidlist
> PIDLIST_ABSOLUTE: The ITEMIDLIST is absolute and has been allocated, as indicated by its being non-constant. This means that it needs to be deallocated with ILFree when it is no longer needed. Because it is a direct pointer to allocated memory, it is aligned.
必要なくなればILFreeで解放する必要がある、と書かれています。

itemの方は、IShellItem型なのでそもそもIntPtrを要求するCoTaskMemFreeとは型が合わないですよね。
こっちはCOMのオブジェクトなので、解放はCOMの作法に従います。
COM的には、オブジェクトの所有者が、COMオブジェクトのReleaseメソッドの呼び出しをすることで所有権を放棄(参照カウントを減らす)していき、所有者がいなくなった(参照カウントが0になった)時点で解放される仕組みになっています。
.NETにおいては、基本的にはCOMオブジェクトは参照がなくなればGCによって暗黙にReleaseが呼び出され自動的に解放されます。なのであまり気にする必要はありません。
アウトオブプロセスCOMサーバの寿命を制御したい場合などで明示的に参照カウントを減らすには、Marshal.ReleaseComObject/FinalReleaseComObjectを呼び出します。
引用返信 編集キー/
■96439 / inTopicNo.11)  Re[10]: フォルダーの選択ダイアログ
□投稿者/ sony (8回)-(2020/11/22(Sun) 23:04:19)
非常に助かりました
どうもありがとうございます。

解決済み
引用返信 編集キー/


トピック内ページ移動 / << 0 >>

このトピックに書きこむ

過去ログには書き込み不可

管理者用

- Child Tree -