中1息子くんのVBプログラミングに詰まったところを考えてあげた

今おもしろいもの作ってます

じつは今とても良いものを作っています。（未踏ジュニアとは別件で。）

製作はまるまる息子くんがやりましたが、すごく実用的に使えるものなので、今私が利用マニュアルを作っています。
きれいに完成したらまたこちらでもご報告します☆

で今日はそんな中そのシステムのプログラムの一部を一緒に考えてあげて解決した件について！書きます。

かなりの技術力を持っている中１息子くんですが、「まだ私が教えられる部分があるのね！」と嬉しくなったというお話です^^;;
いやいやゆーても私長年仕事でプログラム書いてきたし今もやってるんだからね！と、声を大にして言いたい！

入力文字をマスキングしたInputBoxを作りたい

Visual Studio 2019 の Visual Basicのコードです。VBは私馴染みがあります。

で、やりたいことは「入力文字をマスキングしたInputBoxを作りたい」と。

InputBoxは、VB上で以下のようにさらりと書けます。

Dim inputText As String
inputText = InputBox("ユーザー名を入力してください", "ユーザー名", "memetan", -1, -1)

こう書くと、こんな入力画面（InputBox）が出ます。

ここで息子くん、入力文字を「*」でマスキングした入力画面が作りたいとのこと。
↓ これが作りたい

VB使いの皆さんどうされるでしょうか。

私なら迷わず、InputBox使わずに、「OK」「キャンセル」ボタン、入力するTextBoxを貼り付けたFormを作ります。
TextBoxならマスキング簡単にできるからです。

しかしそこが「こうと決めたらそうやらねば気が済まない」息子くん。
「それは嫌だ。」
ええ、、、、

ネットにInputBoxを拡張するソースコードがあったのでこれを使いたい。と。

【VBA】InputBoxDK（パスワード入力用のマスキング対応InputBox関数） · GitHub

これ、VBAやね。
中身は、Windows APIをゴリゴリに使ってInputBoxをカスタマイズしています。

（同じソースコードがネットの色々なところに転がっているのでどれがオリジナルかわからず上記をリンク使用させていただきました。）

VBA→VB.NETへ

息子くんがVB.NETへコンパイルエラーが出ない程度に修正していましたが、どうしても実行時にエラーになると言うことで見てほしいと。

ちょっと時間かかっちゃいましたが、ちゃんと動くようにできました！ウェーイ！
なのでここで公開します。
「InputBoxEx」って名前のクラスでファイル名は InputBoxEx.vb になります。

Option Explicit On
Imports System.Runtime.InteropServices
Public Delegate Function CallBack(
    ByVal nCode As Integer,
    ByVal wParam As IntPtr,
    ByVal lParam As IntPtr) As Integer

Public Class InputBoxEx

    Private Delegate Function lpfnDelegate(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long)

    ''API functions to be used
    'Import for the CallNextHookEx function.
    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Public Overloads Shared Function CallNextHookEx _
          (ByVal idHook As Integer, ByVal nCode As Integer,
           ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    End Function

    'Import for the GetModuleHandle function.
    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Public Overloads Shared Function GetModuleHandle _
          (ByVal lpModuleName As String) As Integer
    End Function

    'Import for the SetWindowsHookEx function.
    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Public Overloads Shared Function SetWindowsHookEx _
          (ByVal idHook As Integer, ByVal HookProc As CallBack,
           ByVal hInstance As Integer, ByVal wParam As Integer) As Integer
    End Function

    'Import for the UnhookWindowsHookEx function.
    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Public Overloads Shared Function UnhookWindowsHookEx _
          (ByVal hHook As Integer) As Integer
    End Function

'    'Import for the SendDlgItemMessage function.
'    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
'    Public Overloads Shared Function SendDlgItemMessage _
'          (ByVal hDlg As Integer, ByVal nIDDlgItem As Integer, ByVal wMsg As Integer,
'                                                ByVal wParam As Integer, ByVal lParam As Integer) As Integer
'    End Function

    'Import for the GetClassName function.
    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Public Overloads Shared Function GetClassName _
          (ByVal hwnd As Integer,
            ByVal lpClassName As String,
            ByVal nMaxCount As Integer) As Integer
    End Function

    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Shared Function SendMessage _
          (ByVal hwnd As Integer,
            ByVal wMsg As Integer,
           ByVal wParam As Integer,
           ByVal lParam As Integer) As Integer
    End Function

    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
    Shared Function FindWindowEx _
          (ByVal hWnd1 As Integer,
            ByVal hWnd2 As Integer,
           ByVal lpsz1 As String,
           ByVal lpsz2 As String) As Integer
    End Function

    'Constants to be used in our API functions
    Private Const EM_SETPASSWORDCHAR = &HCC
    Private Const WH_CBT = 5
    Private Const HCBT_ACTIVATE = 5
    Private Const HC_ACTION = 0
    Private Const ES_PASSWORD = &H20

    Private hHook As Integer

    Public Function NewProc(ByVal lngCode As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
        Dim RetVal
        Dim strClassName As String, lngBuffer As Long
        Dim EditHwnd As Integer
        Dim strDlgItemClassName As String

        If lngCode < HC_ACTION Then
            NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
            Exit Function
        End If

        strClassName = Space(256)
        lngBuffer = 255

        If lngCode = HCBT_ACTIVATE Then    'A window has been activated

            ' ①
            RetVal = GetClassName(wParam, strClassName, lngBuffer)

            If Left$(strClassName, RetVal) = "WindowsForms10.Window.8.app.0.141b42a_r10_ad1" Then  'Class name of the Inputbox
                strDlgItemClassName = "WindowsForms10.EDIT.app.0.141b42a_r10_ad1"
            Else If Left$(strClassName, RetVal) = "WindowsForms10.Window.8.app.0.141b42a_r9_ad1" Then  'Class name of the Inputbox
                strDlgItemClassName = "WindowsForms10.EDIT.app.0.141b42a_r9_ad1"
            End If

            If Left$(strClassName, RetVal) = "WindowsForms10.Window.8.app.0.141b42a_r10_ad1" Or _
                Left$(strClassName, RetVal) = "WindowsForms10.Window.8.app.0.141b42a_r9_ad1"  Then 

                'This changes the edit control so that it display the password character *.
                'You can change the Asc("*") as you please.
                'SendDlgItemMessage(wParam, &H2C0C9C, EM_SETPASSWORDCHAR, Asc("*"), &H0)

                ' ② SendDlgItemMessageは効かなかったためFindWindowExでInputBox内の入力テキストボックスを取得してSendMessageを使った
                EditHwnd = FindWindowEx(wParam, 0, strDlgItemClassName , ""）
                SendMessage(EditHwnd, EM_SETPASSWORDCHAR, Asc("*"), 0)
                ' ③ 
                UnhookWindowsHookEx(hHook)
                Exit Function
            End If
        End If

        'This line will ensure that any other hooks that may be in place are
        'called correctly.
        CallNextHookEx(hHook, lngCode, wParam, lParam)

    End Function

    Public Function InputBoxNM(Prompt, Optional Title = "", Optional DefaultText = "", Optional XPos = -1, Optional YPos = -1) As String
        InputBoxNM = InputBox(Prompt, Title, DefaultText, XPos, YPos)
    End Function

    Public Function InputBoxPW(Prompt, Optional Title = "", Optional DefaultText = "", Optional XPos = -1,
                            Optional YPos = -1) As String

        Dim lngModHwnd As Integer, lngThreadID As Integer

        'lngThreadID = GetCurrentThreadId
        lngThreadID = AppDomain.CurrentDomain.GetCurrentThreadId() '* METHOD IS DEPRECATED BUT ONLY METHOD TO RUN THIS.
        lngModHwnd = GetModuleHandle(vbNullString)

        hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

        InputBoxPW = InputBox(Prompt, Title, DefaultText, XPos, YPos)
        UnhookWindowsHookEx(hHook)

    End Function
End Class

下記、私が変更した箇所と説明です。

◆ long は Integer へ
　参考にしたソースでのLongは、VB.NETでのIntegerと同じものになります。32ビットの数値です。
　そのためすべてのLongをIntegerに変換します。
　（昔WindowsAPIをVB.NETで使うためにLong→Integerコンバージョン、よくやってた）

◆ Windows API の宣言

Imports System.Runtime.InteropServices

と書いたうえで

<DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>

とかで定義します。
今回ネットで調べて「へーこうやって書くのか」と思って書きました。こう書かなくてもできます。

◆ InputBoxのウインドウのクラス名
　コード内①のところで、ウインドウに対してGetClassNameでクラス名を取得していて、このクラス名でInputBoxかどうかを判断してInputBoxだったら～っていう処理をしています。
　が、これが、今回のVBでは取得される値が違っていました。

　値についてはspy++で調べるとわかります。
　（VS2019でspy++はオプションでインストールしなければ入らないものだったので今回インストールしました）

　調べた結果、
　InputBoxは「WindowsForms10.Window.8.app.0.141b42a_r10_ad」または「WindowsForms10.Window.8.app.0.141b42a_r9_ad1」でした。
　”r9" か "r10" は実行権限によって異なるみたい？？

◆ InputBoxへのSendDlgItemMessage
　参考元VBAソースではInputBoxに対してSendDlgItemMessage を実行することでマスキング処理を行っていました。
　がしかし！これがうまくいかないんです。
　ここが一番のハマりどころでした。

　結果、これがよい解決策かはわかりませんでしたがコード②のように対処することで正常動作できるようになりました。

　EditHwnd = FindWindowEx(wParam, 0, strDlgItemClassName , ""）
　SendMessage(EditHwnd, EM_SETPASSWORDCHAR, Asc("*"), 0)

　
　InputBoxを親とする要素で、クラス名が「WindowsForms10.EDIT.app.0.141b42a_r10_ad1」または「WindowsForms10.EDIT.app.0.141b42a_r9_ad1」のもの（前に書いたInputBox本体のクラスとは若干値が違うので注意！）を取得して、SendDlgItemMessage ではなく、SendMessageでマスキング設定を行っています。

◆ UnhookWindowsHookEx(hHook)でちゃんと終わる
　③の部分です。
　Exit Function する前に必ずUnhookWindowsHookExで次の「ウインドウフックはしないよ」とちゃんと言ってあげないといけないようです。
　これがないと実行時エラーになります。

さいごに

この情報公開しても嬉しい人いるかなぁ？って感じですが・・・
自己満でもいいよね！

そうそうそれと、はてなブログを有料版のproにしてみました！今さら感ですが！更新頻度もそう高くないくせに！（笑）
見る側の立場で広告多いサイトはちょっと嫌だなぁーとつくづく自分で感じたので^^;

というわけで、ご覧いただきありがとうございました。今後もよろしくお願いします。