前回、ソケット通信ならSocketクラスを用いて作るのが普遍的。の様な書き方をしたと思いますが、

比較的単純なアプリケーションを作成していて、最大のパフォーマンスを必要としない場合は、TcpClient、TcpListener、およびUdpClientを使用することを検討してください。これらのクラスは、Socket通信のためのより簡単でわかりやすいインターフェイスを提供します。

なのですから、パフォーマンスなんて要らない、非常に複雑なんだから(ホンマかいな?)。という事で。


<注意点>

・動作は同期ブロッキングモードです。

・エラー処理は手抜きです。


お試し環境
  Windows7 64bit Edition
  Visual Basic 2008 AnyCPU対象


/*---- サーバー側 -------------------- お試し結果 --------------------------*/

Waiting for a connection...
Connected!
Received: This is it!<EOF>
Sent: THIS IS IT!<EOF>
Waiting for a connection...

/*----------------------------------------------------------------------------*/

/*---- クライアント側 ---------------- お試し結果 --------------------------*/

Sent: This is it!<EOF>
Received: THIS IS IT!<EOF>

/*----------------------------------------------------------------------------*/


/*---- サーバー側 ------------------  お試しソース -------------------------*/

'Imports System.Net
'Imports System.Net.Sockets
'Imports System.Text

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim server As Net.Sockets.TcpListener ' リスナー側ソケット
        Dim client As Net.Sockets.TcpClient ' クライアント側ソケット
        Dim port As Integer
        Dim i As Integer

        ' バイト列送受信バッファ
        Dim sndBytes(1024) As Byte
        Dim rcvBytes(1024) As Byte
        Dim msg As String

        Dim localAddr As Net.IPAddress ' ローカルIPアドレス
        Dim stream As Net.Sockets.NetworkStream ' クライアント側との送受信ストリーム

        server = Nothing
        Try
            ' リスナーソケット作成
            port = 22000
            localAddr = Net.IPAddress.Parse("127.0.0.1")
            server = New Net.Sockets.TcpListener(localAddr, port)

            ' クライアントからの受信接続要求リッスン開始
            server.Start()

            ' 接続要求受け取り開始
            While True
                Debug.Print("Waiting for a connection... ")

                ' 接続要求許可待ちの間、プログラムは一時停止
                client = server.AcceptTcpClient()
                Debug.Print("Connected!")

                ' クライアントとの送受信ストリーム取得
                stream = client.GetStream()

                ' データを全て受信するまでループ
                i = stream.Read(rcvBytes, 0, rcvBytes.Length)
                While (i <> 0)
                    ' 受信バイト列を文字列に変換
                    msg = System.Text.Encoding.ASCII.GetString(rcvBytes, 0, i)
                    Debug.Print("Received: {0}", msg)

                    ' 受信データ処理
                    msg = msg.ToUpper()
                    sndBytes = System.Text.Encoding.ASCII.GetBytes(msg)

                    ' 応答送信
                    stream.Write(sndBytes, 0, sndBytes.Length)
                    Debug.Print("Sent: {0}", msg)

                    i = stream.Read(rcvBytes, 0, rcvBytes.Length)
                End While

                ' クライアント側ソケット解放
                stream.Close()
                client.Close()
            End While

        Catch ex As Net.Sockets.SocketException
            Debug.Print("SocketException : {0}", ex)
        Finally
            server.Stop()
        End Try

    End Sub

End Class

/*----------------------------------------------------------------------------*/

/*---- クライアント側 --------------  お試しソース -------------------------*/

'Imports System.Net
'Imports System.Net.Sockets
'Imports System.Text

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim client As Net.Sockets.TcpClient ' クライアントソケット
        Dim port As Integer
        Dim stream As Net.Sockets.NetworkStream ' 送受信ストリーム

        Dim sndData(1024) As Byte ' バイト列送信バッファ
        Dim rcvData(1024) As Byte ' バイト列受信バッファ
        Dim rcvLen As Integer
        Dim msg As String

        Dim server As String = "127.0.0.1"
        Dim message As String = "This is it!<EOF>"

        Try
            ' クライアントソケット作成
            port = 22000
            client = New Net.Sockets.TcpClient(server, port)

            ' 送信文字列をバイト配列に変換
            sndData = System.Text.Encoding.ASCII.GetBytes(message)

            ' 送受信ストリームを取得
            stream = client.GetStream()

            ' サーバーにメッセージ送信
            stream.Write(sndData, 0, sndData.Length)
            Debug.Print("Sent: {0}", message)

            ' 応答データ受信
            rcvLen = stream.Read(rcvData, 0, rcvData.Length)
            msg = System.Text.Encoding.ASCII.GetString(rcvData, 0, rcvLen)
            Debug.Print("Received: {0}", msg)

            ' ソケット解放
            stream.Close()
            client.Close()

        Catch ex As ArgumentNullException
            Debug.Print("ArgumentNullException: {0}", ex)
        Catch ex As Net.Sockets.SocketException
            Debug.Print("SocketException: {0}", ex)
        End Try

    End Sub

End Class

/*----------------------------------------------------------------------------*/

/*----------------------------------------------------------------------------*/
/*============================================================================*/

TCP/IPのソケット通信と言ったら、C言語だろうとVisualBasicだろうとソケットを作成するのが基本。と言うか一般的ですよね。

マイクロソフトのドキュメントによれば、

If you are writing a relatively simple application and do not require maximum performance, consider using TcpClient, TcpListener, and UdpClient. These classes provide a simpler and more user-friendly interface to Socket communications.

だそうですから、VBでも尚更、Socketクラスを使わない訳には行きません(ホンマかいな?)。

<注意点>

・動作は同期ブロッキングモードです。

・Listenメソッドの引数は接続要求を保留する上限値を指定します。

・エラー処理は手抜きです。


お試し環境
  Windows7 64bit Edition
  Visual Basic 2008 AnyCPU対象


/*---- サーバー側 -------------------- お試し結果 --------------------------*/

Waiting for a connection...
Text received : This is a test<EOF>
Waiting for a connection...

/*----------------------------------------------------------------------------*/

/*---- クライアント側 ---------------- お試し結果 --------------------------*/

Socket connected to ::1:22000
Echoed test = This is a test<EOF>

/*----------------------------------------------------------------------------*/


/*---- サーバー側 ------------------  お試しソース -------------------------*/

'Imports System.Net
'Imports System.Net.Sockets
'Imports System.Text

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim srvSkt As Net.Sockets.Socket ' サーバー側ソケット
        Dim datSkt As Net.Sockets.Socket ' クライアント側との送受信ソケット
        Dim port As Integer
        Dim rcvLen As Integer
        Dim sndBytes(1024) As Byte ' バイト列の送信バッファ
        Dim rcvBytes(1024) As Byte ' バイト列の受信バッファ
        Dim msg As String

        Dim ipHostInfo As Net.IPHostEntry
        Dim ipAddress As Net.IPAddress ' ローカルIPアドレス
        Dim localEP As Net.IPEndPoint

        port = 22000
        ipHostInfo = Net.Dns.GetHostEntry("localhost")
        ipAddress = ipHostInfo.AddressList(0)
        localEP = New Net.IPEndPoint(ipAddress, port)

        ' ソケット作成
        srvSkt = New Net.Sockets.Socket(ipAddress.AddressFamily, Net.Sockets.SocketType.Stream, Net.Sockets.ProtocolType.Tcp)

        Try
            ' ソケットをローカルエンドポイントに関連付け
            srvSkt.Bind(localEP)
            ' クライアントからの接続要求をリッスン
            srvSkt.Listen(1)

            ' 接続要求受け取り開始
            While True
                Debug.Print("Waiting for a connection...")
                ' 接続要求許可待ちの間、プログラムは一時停止されます
                datSkt = srvSkt.Accept()
                msg = Nothing

                ' クライアントからデータ受信
                While True
                    rcvLen = datSkt.Receive(rcvBytes)
                    msg += System.Text.Encoding.ASCII.GetString(rcvBytes, 0, rcvLen)
                    If msg.IndexOf("<EOF>") > -1 Then
                        Exit While
                    End If
                End While
                ' 受信データを表示
                Debug.Print("Text received : {0}", msg)

                ' クライアントにデータをエコーバック
                sndBytes = System.Text.Encoding.ASCII.GetBytes(msg)
                datSkt.Send(sndBytes)

                ' ソケット解放
                datSkt.Shutdown(Net.Sockets.SocketShutdown.Both)
                datSkt.Close()
            End While

        Catch ex As ArgumentException
            Debug.Print("ArgumentException : {0}", ex.ToString())
        Catch ex As Net.Sockets.SocketException
            Debug.Print("SocketException : {0}", ex.ToString())
        Catch ex As ObjectDisposedException
            Debug.Print("ObjectDisposedException : {0}", ex.ToString())
        Catch ex As Security.SecurityException
            Debug.Print("SecurityException : {0}", ex.ToString())
        Catch ex As InvalidOperationException
            Debug.Print("InvalidOperationException : {0}", ex.ToString())
        Catch ex As Exception
            Debug.Print("Unexpected exception : {0}", ex.ToString())
        End Try

    End Sub

End Class

/*----------------------------------------------------------------------------*/

/*---- クライアント側 --------------  お試しソース -------------------------*/

'Imports System.Net
'Imports System.Net.Sockets
'Imports System.Text

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim clntSkt As Net.Sockets.Socket ' クライアント側ソケット
        Dim port As Integer
        Dim sndLen As Integer
        Dim rcvLen As Integer
        Dim sndBytes(1024) As Byte ' バイト列の送信バッファ
        Dim rcvBytes(1024) As Byte ' バイト列の受信バッファ

        Dim ipHostInfo As Net.IPHostEntry
        Dim ipAddress As Net.IPAddress ' リモートIPアドレス
        Dim remoteEP As Net.IPEndPoint

        port = 22000
        ipHostInfo = Net.Dns.GetHostEntry("localhost")
        ipAddress = ipHostInfo.AddressList(0)
        remoteEP = New Net.IPEndPoint(ipAddress, port)

        ' ソケット作成
        clntSkt = New Net.Sockets.Socket(ipAddress.AddressFamily, Net.Sockets.SocketType.Stream, Net.Sockets.ProtocolType.Tcp)

        Try
            ' ソケットをリモートエンドポイントに接続
            clntSkt.Connect(remoteEP)
            Debug.Print("Socket connected to {0}", clntSkt.RemoteEndPoint.ToString())

            ' 送信文字列をバイト配列に変換
            sndBytes = System.Text.Encoding.ASCII.GetBytes("This is a test<EOF>")

            ' データ送信
            sndLen = clntSkt.Send(sndBytes)

            ' リモートサーバーから応答受信
            rcvLen = clntSkt.Receive(rcvBytes)
            Debug.Print("Echoed test = {0}", System.Text.Encoding.ASCII.GetString(rcvBytes, 0, rcvLen))

            ' ソケット解放
            clntSkt.Shutdown(Net.Sockets.SocketShutdown.Both)
            clntSkt.Close()

        Catch ex As ArgumentException
            Debug.Print("ArgumentException : {0}", ex.ToString())
        Catch ex As Net.Sockets.SocketException
            Debug.Print("SocketException : {0}", ex.ToString())
        Catch ex As ObjectDisposedException
            Debug.Print("ObjectDisposedException : {0}", ex.ToString())
        Catch ex As Security.SecurityException
            Debug.Print("SecurityException : {0}", ex.ToString())
        Catch ex As InvalidOperationException
            Debug.Print("InvalidOperationException : {0}", ex.ToString())
        Catch ex As Exception
            Debug.Print("Unexpected exception : {0}", ex.ToString())
        End Try

    End Sub

End Class

/*----------------------------------------------------------------------------*/

/*----------------------------------------------------------------------------*/
/*============================================================================*/

以前、C言語でTCP/IPのソケット通信の記事「TCP/IPプログラムのいろはは、DOS窓でWinSockAPI」を書きましたので、VisualBasicでも使ってみようかと。だけどその前に、VBにとって重要そうな(私だけ?)エンドポイントについて。

VBでは、ネットワークアドレスとサービスポートの組み合わせを「エンドポイント」と呼びます。

ネットワークアドレスは、ネットワーク上の特定のデバイス(例えば、PCなど)を識別します。ポート番号は、そのデバイス上の特定のサービスの接続先(例えば、メール)を識別します。

TCP/IPは、ネットワークアドレスとサービスポート番号を使用して、一意にサービスを識別し、通信しています。

インターネット検索すると、エンドポイント(EndPoint)の決め方が色々ある様ですので、目に付いたものの内容を確認してみる事に。


<注意点>

・EndPoint確認のネットワーク環境
 (1)無し、自PC内動作 ⇒ 外部接続無し、単独動作
 (2)LAN、LAN内動作 ⇒ 外部接続無し、DHCPが192.168.x.yを配布
 (3)インターネット、外部動作 ⇒ 外部接続有(デュアルスタック)

・どんな相手でも受け入れてしまうAnyアドレス(0.0.0.0)は、利用しない方が宜しいかと。

・エラー処理は手抜きです。


お試し環境
  Windows7 64bit Edition
  Visual Basic 2008 AnyCPU対象


/*-------------------------------- お試し結果 ------------------------------*/

・(1)ネットワーク接続は無し、自PC内動作

①IPv6、ループバック
エンドポイント確認1、接続無し

②IPv6、ループバック
エンドポイント確認2、接続無し

③IPv6、ループバック
エンドポイント確認3、接続無し

④IPv4、ループバック
エンドポイント確認4、接続無し

⑤IPv4、未指定アドレス
エンドポイント確認5、接続無し

⑥IPv4、ループバック
エンドポイント確認6、接続無し

⑦IPv4、ループバック
エンドポイント確認7、接続無し

⑧IPv4、未指定アドレス
エンドポイント確認8、接続無し

⑨例外発生(そのようなホストは不明です)


・(2)ネットワーク接続はLAN、LAN内動作

①IPv6、リンクローカルアドレス
エンドポイント確認1、LAN接続

②IPv6、ループバック
エンドポイント確認2、LAN接続

③IPv6、リンクローカルアドレス
エンドポイント確認3、LAN接続

④IPv4、ループバック
エンドポイント確認4、LAN接続

⑤IPv4、未指定アドレス
エンドポイント確認5、LAN接続

⑥IPv4、プライベートアドレス
エンドポイント確認6、LAN接続

⑦IPv4、ループバック
エンドポイント確認7、LAN接続

⑧IPv4、未指定アドレス
エンドポイント確認8、LAN接続

⑨例外発生(そのようなホストは不明です)


・(3)ネットワーク接続はインターネット、外部動作

①IPv6、リンクローカルアドレス
エンドポイント確認1、インターネット接続

②IPv6、ループバック
エンドポイント確認2、インターネット接続

③IPv6、リンクローカルアドレス
エンドポイント確認3、インターネット接続

④IPv4、ループバック
エンドポイント確認4、インターネット接続

⑤IPv4、未指定アドレス
エンドポイント確認5、インターネット接続

⑥IPv4、グローバルアドレス
エンドポイント確認6、インターネット接続

⑦IPv4、ループバック
エンドポイント確認7、インターネット接続

⑧IPv4、未指定アドレス
エンドポイント確認8、インターネット接続

⑨IPv4、リモートアドレス
エンドポイント確認9、インターネット接続


/*----------------------------------------------------------------------------*/


/*-------------------------------- お試しソース ----------------------------*/

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim remoteEndPoint As Net.IPEndPoint
        Dim msg As String

        Dim port As Integer = 22000

        ' ① EndPoint check1
        Dim ipHostInfo As Net.IPHostEntry = Net.Dns.GetHostEntry(Net.Dns.GetHostName())
        Dim ipAddress As Net.IPAddress = ipHostInfo.AddressList(0)
        Dim localEndPoint As New Net.IPEndPoint(ipAddress, port)

        msg = "ipHostInfo : " & ipHostInfo.ToString & vbCrLf & _
              "ipAddress : " & ipAddress.ToString & vbCrLf & _
              "localEndPoint : " & localEndPoint.ToString
        MsgBox(msg, MsgBoxStyle.Information, "Check local EndPoint1")

        ' ② EndPoint check2
        ipHostInfo = Net.Dns.GetHostEntry("localhost")
        ipAddress = ipHostInfo.AddressList(0)
        localEndPoint = New Net.IPEndPoint(ipAddress, port)

        msg = "ipHostInfo : " & ipHostInfo.ToString & vbCrLf & _
              "ipAddress : " & ipAddress.ToString & vbCrLf & _
              "localEndPoint : " & localEndPoint.ToString
        MsgBox(msg, MsgBoxStyle.Information, "Check local EndPoint2")

        ' ③ EndPoint check3
        ipHostInfo = Net.Dns.GetHostEntry("127.0.0.1")
        ipAddress = ipHostInfo.AddressList(0)
        localEndPoint = New Net.IPEndPoint(ipAddress, port)

        msg = "ipHostInfo : " & ipHostInfo.ToString & vbCrLf & _
              "ipAddress : " & ipAddress.ToString & vbCrLf & _
              "localEndPoint : " & localEndPoint.ToString
        MsgBox(msg, MsgBoxStyle.Information, "Check local EndPoint3")

        ' ④ EndPoint check4
        ipAddress = Net.IPAddress.Parse("127.0.0.1")
        localEndPoint = New Net.IPEndPoint(ipAddress, port)

        msg = "ipAddress : " & ipAddress.ToString & vbCrLf & _
              "localEndPoint : " & localEndPoint.ToString
        MsgBox(msg, MsgBoxStyle.Information, "Check local EndPoint4")

        ' ⑤ EndPoint check5
        localEndPoint = New Net.IPEndPoint(Net.IPAddress.Any, port)

        msg = "localEndPoint : " & localEndPoint.ToString
        MsgBox(msg, MsgBoxStyle.Information, "Check local EndPoint5")

        ' ⑥ EndPoint check6
        ipHostInfo = Net.Dns.Resolve(Net.Dns.GetHostName())
        ipAddress = ipHostInfo.AddressList(0)
        localEndPoint = New Net.IPEndPoint(ipAddress, port)

        msg = "ipHostInfo : " & ipHostInfo.ToString & vbCrLf & _
              "ipAddress : " & ipAddress.ToString & vbCrLf & _
              "localEndPoint : " & localEndPoint.ToString
        MsgBox(msg, MsgBoxStyle.Information, "Check local EndPoint6")

        ' ⑦ EndPoint check7
        ipHostInfo = Net.Dns.Resolve("localhost")
        ipAddress = ipHostInfo.AddressList(0)
        localEndPoint = New Net.IPEndPoint(ipAddress, port)

        msg = "ipHostInfo : " & ipHostInfo.ToString & vbCrLf & _
              "ipAddress : " & ipAddress.ToString & vbCrLf & _
              "localEndPoint : " & localEndPoint.ToString
        MsgBox(msg, MsgBoxStyle.Information, "Check local EndPoint7")

        ' ⑧ EndPoint check8
        ipAddress = Net.Dns.Resolve(Net.IPAddress.Any.ToString()).AddressList(0)
        localEndPoint = New Net.IPEndPoint(ipAddress, port)

        msg = "ipAddress : " & ipAddress.ToString & vbCrLf & _
              "localEndPoint : " & localEndPoint.ToString
        MsgBox(msg, MsgBoxStyle.Information, "Check local EndPoint8")

        ' ⑨ EndPoint check9
        Try
            ipHostInfo = Net.Dns.GetHostEntry("www.nifty.com")
            ipAddress = ipHostInfo.AddressList(0)
            remoteEndPoint = New Net.IPEndPoint(ipAddress, port)

            msg = "ipHostInfo : " & ipHostInfo.ToString & vbCrLf & _
                  "ipAddress : " & ipAddress.ToString & vbCrLf & _
                  "remoteEndPoint : " & remoteEndPoint.ToString
            MsgBox(msg, MsgBoxStyle.Information, "Check remote EndPoint9")

        Catch ex As Net.Sockets.SocketException
            Debug.Print("SocketException : {0}", ex.ToString())
        Catch ex As Exception
            Debug.Print("Unexpected exception : {0}", ex.ToString())
        End Try

    End Sub

End Class

/*----------------------------------------------------------------------------*/

/*----------------------------------------------------------------------------*/
/*============================================================================*/

Windowsでは同一プロセス内に、32ビットプログラムと64ビットプログラムの混在は許されていません。例えば、32ビット動作のプログラムをx86、64ビット動作のプログラムをx64とした場合、

OK:x86のExeとx86のDLL *1、x64のExeとx64のDLL *2 は呼出し可能
NG:x86のExeとx64のDLL、  x64のExeとx86のDLLは呼出し不可

 *1:32ビットOS または Wow64配下で動作
 *2:64ビットOSのみで動作

ですので、ネイティブ動作指向のVisualBasicでは IsWow64Process 関数とは無縁だよなぁ~と思ってしまいましたが、前回、既定値の「AnyCPU」を「x86」に変更した事もあり、使ってみる事に。

マイクロソフトのドキュメントによれば、GetCurrentProcess関数とIsWow64Process関数の構文は、

■ Retrieves a pseudo handle for the current process.

HANDLE GetCurrentProcess();

Return value
The return value is a pseudo handle to the current process.

■ Determines whether the specified process is running under WOW64 or an Intel64 of x64 processor.

BOOL IsWow64Process(HANDLE hProcess, PBOOL Wow64Process);

Return value
If the function succeeds, the return value is a nonzero value.
If the function fails, the return value is zero. To get extended error information, call GetLastError.

なので、戻り値と引数の変数型を Integer と Boolean に置き換えれば、上手くゆく筈?

とは言うものの、一筋縄では行かないのはBOOLでしょうか。

マイクロソフトのドキュメントによれば、

・C/C++では、BOOL は int 型、BOOLEAN は BYTE 型の様です(TRUE または FALSE である必要があります)。

・VBでは、以下様なのだとか。

Boolean 型が数値型に正確に変換されない

Boolean データ型の値は数値として格納されず、格納された値は数値と等価であると見なされません。以前のバージョンとの互換性のために、Visual Basic は変換キーワード (CType 関数、CBool、CInt など) を使用して、Boolean と数値型の間で変換を行います。ただし、その他の言語では、.NET Framework メソッドと同様に、これらの変換が異なる方法で実行されることがあります。

True と False に対して等価の数値に依存するコードを記述することは避けてください。可能な限り、Boolean 変数には、仕様で定められている論理値以外の値を使用しないようにしてください。Boolean 値と数値を混在させる必要がある場合は、選択する変換方法をよく理解してください。

Visual Basic での変換

CType または CBool の変換キーワードを使用して数値データ型を Boolean に変換するとき、0 が False になり、その他のすべての値が True になります。変換キーワードを使用して Boolean 値を数値型に変換するとき、False は 0 になり、True は -1 になります。


<注意点>

・C/C++では、HANDLE は PVOID 型です。(AnyCPU では Integer ではなく IntPtr で)

・VBの Boolean 変数は サイズが2バイトらしいので、偶々、動作している可能性大。

・不測の事態を招かないために、IsWow64Process 関数の戻り値は失敗したかどうか、つまり"0"かどうかをチェックするのが宜しいかと。

・VisualStudio11と.NET4.5でマイクロソフトがAnyCPUを再定義したそうな
 新たなデフォルトは、「AnyCPU32Bit優先」らしい。(何周遅れ? の気付き)
 ⇒これは動作が可能な場合、32Bitで動作する。という事らしい。


お試し環境
  WindowsXP 32bit Edition、Windows7 64bit Edition
  Visual Basic 2008 対象CPUはx86とAnyCPU


/*-------------------------------- お試し結果 ------------------------------*/

・敢えて、x86版を WindowsXP 32bit Edition で動作させてみる

x86 版 WindowsXP 32bit Edition で動作

・x86版を Windows7 64bit Edition で動作

x86 版 Windows7 64bit Edition で動作

・AnyCPU版を Windows7 64bit Edition で動作

AnyCPU 版 Windows7 64bit Edition で動作

/*----------------------------------------------------------------------------*/


/*-------------------------------- お試しソース ----------------------------*/

Public Class Form1

    Declare Auto Function GetCurrentProcess Lib "kernel32" () As Integer
    Declare Auto Function IsWow64Process Lib "kernel32" (ByVal hprcs As Integer, ByRef w64prcs As Boolean) As Boolean

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim hdl As Integer
        Dim res As Boolean
        Dim biw64 As Boolean
        Dim msg As String

        hdl = GetCurrentProcess
        res = IsWow64Process(hdl, biw64)
        If res <> 0 Then
            msg = "return GetCurrentProcess : " & hdl.ToString & vbCrLf & _
                  "return IsWow64Process : " & res & vbCrLf & _
                  "Wow64Process value : " & biw64

            MsgBox(msg, MsgBoxStyle.Information, "result IsRunningUnderWow64")
        Else
            MsgBox(Err.LastDllError, MsgBoxStyle.AbortRetryIgnore, "IsWow64Process Error Occured")
        End If
    End Sub
End Class

/*----------------------------------------------------------------------------*/

/*----------------------------------------------------------------------------*/
/*============================================================================*/

前回、VBコンパイラが規定値の"任意のCPU"設定だった事もあり、Windows7でもネイティブ(64ビット)動作となってしまいましたので、今一だったなぁ~と。

そこでWindowsXPのVisualBasicは、32ビットでコンパイルする様にIDEの設定を変更してみました。

マイクロソフトのドキュメントによると、

・構成マネージャーを使用して、対象プラットフォームを指定
・プロジェクトのプロパティを使用して、対象CPUを指定

などが有るようですが、構成マージャーには新規作成や編集などの作業が必須の様なので、面倒くさがり屋には不向きです。という事で、プロジェクトのプロパティを使用して、対象CPUを指定してみる事に。

・メニューバーの「プロジェクト」をクリック→プルダウンメニューの「(プロジェクト名)のプロパティ」を選択、または、
ソリューションエクスプローラの「プロジェクト名」を"右"クリック→プルダウンメニューの「プロパティ」を選択して、プロパティのダイアログを表示します。


1.プロジェクトの「プロパティ」画面で、「コンパイル」を選択し、「詳細コンパイルオプション」ボタンをクリック

VBプロジェクトのプロパティ画面


2.「コンパイラの詳細設定」画面で、「ターゲットCPU」の内容を確認

コンパイラの詳細設定画面で内容確認

・32ビットでコンパイル出来る様に、「AnyCPU」を「x86」に変更します


3.「コンパイラの詳細設定」画面で、「ターゲットCPU」の変更内容を確認

コンパイラの詳細設定画面で内容変更


コンパイラの対象CPU指定をx86に変更して Windows7 64Bit 版で動作確認したところ、WOW64配下で動作する事を確認できました。
2つの関数の取得データには、wProcessorArchitecture/lpMaximumApplicationAddress/dwProcessorType に違いがみられました。

・やはりCPU情報を詳しく知りたい場合には、GetNativeSystemInfo 関数の方が優れているようです。


お試し環境
  WindowsXP 32bit Edition、Windows7 64bit Edition
  Visual Basic 2008 対象CPUはx86


/*-------------------------------- お試し結果 ------------------------------*/

・GetSystemInfo 関数の取得データ

WOW64下 GetSystemInfo 関数の取得データ

・GetNativeSystemInfo 関数の取得データ

WOW64下 GetNativeSystemInfo 関数の取得データ

/*----------------------------------------------------------------------------*/


/*-------------------------------- お試しソース ----------------------------*/

前々回の「32ビットOS下のVisualBasicからGetSystemInfo関数を呼び出す」記事のソースと同じです。

/*----------------------------------------------------------------------------*/

/*----------------------------------------------------------------------------*/
/*============================================================================*/

前回は32ビット環境、今回は64ビット環境でVisualBasicからアンマネージド関数を呼び出してみる事に。

マイクロソフトのGetSystemInfo関数のドキュメントに、

To retrieve accurate information for an application running on WOW64, call the GetNativeSystemInfo function.

とあったので、GetNativeSystemInfo関数を呼び出すだけのサンプルを作ってみました。

★凡そ10年前の Windows7 は当然、現役のバリバリ。

それはさて置き、前回作成の32ビット版だと思っていたプログラムが、WOW64下(?)で思いがけない動作結果に。

取得SYSTEM_INFO_32データ

取得SYSTEM_INFO2_32データ


CPUタイプなど、一部不確かなデータを拾ってきてしまいます。試しに Windows7 64Bit 版でもプログラムを作成・実行してみると、同様の結果に。

調べてみると、初期設定(インストール時)のままのIDEでは、Visual Basic は実行対象OSが 32bit/64bit のどちらのバージョンでも、ネイティブ動作するようにコンパイルするようです。

マイクロソフトドキュメント ⇒ 任意のプラットフォーム上で実行されるように、アセンブリをコンパイルします。アプリケーションは、Windowsの32ビットバージョンでは32ビットアプリケーションとして、Windowsの64ビットバージョンでは64ビットアプリケーションとして実行されます。この anycpu フラグが既定値です。


★例え32ビットのOS上でコンパイルしても、上記の動作をするのには驚きだわ! 各.NET開発言語によって作成される中間言語(MSIL)は、CPUや各Windowsプラットフォームに依存しないコードになっていて、実行される際に順次ネイティブコードにコンパイルされます(=JITコンパイラだそうな)。


・と言う訳で、規定値設定のVisualBasicで作成された実行ファイル(exe)は、WOW64配下には入らず64ビットCLR上で動作します。

・なので、以下の3メンバーを ULong に直してやれば構造体サイズには不満は残るけど、それなりの動作結果に。

LPVOID    lpMinimumApplicationAddress;
LPVOID    lpMaximumApplicationAddress;
DWORD_PTR dwActiveProcessorMask;

・自分的には、ムズイ。意識していないと、多分ど壺に嵌るな、きっと。


<注意点>

・Win64 ではC/C++のポインタサイズは8バイト、ポインタ精度変数のサイズも8バイト。つまり、Long 型です。

・DWORD_PTR も Win64 では8バイトで Long 型。LPVOID は IntPtr の方が好ましい?

・Visual Basic のデフォルトの文字セットは、UNICODE です。


お試し環境
  WindowsXP 32bit Edition、Windows7 64bit Edition
  Visual Basic 2008


/*-------------------------------- お試し結果 ------------------------------*/

・GetNativeSystemInfo 関数の取得データ

取得SYSTEM_INFO_64データ


・GetSystemInfo 関数の取得データ

取得SYSTEM_INFO2_64データ

/*----------------------------------------------------------------------------*/


/*-------------------------------- お試しソース ----------------------------*/

Imports System.Runtime.InteropServices

Public Class Form4

    Const PROCESSOR_ARCHITECTURE_INTEL As Integer = 0 ' x86
    Const PROCESSOR_ARCHITECTURE_ARM As Integer = 5 ' ARM
    Const PROCESSOR_ARCHITECTURE_IA64 As Integer = 6 ' Intel Itanium-based
    Const PROCESSOR_ARCHITECTURE_AMD64 As Integer = 9 ' x64(AMD or Intel)
    Const PROCESSOR_ARCHITECTURE_ARM64 As Integer = 12 ' ARM64
    Const PROCESSOR_ARCHITECTURE_UNKNOWN As Integer = &HFFFF ' Unknown architecture

    Const PROCESSOR_INTEL_386 As Integer = 386
    Const PROCESSOR_INTEL_486 As Integer = 486
    Const PROCESSOR_INTEL_PENTIUM As Integer = 586
    Const PROCESSOR_INTEL_IA64 As Integer = 2200
    Const PROCESSOR_AMD_X8664 As Integer = 8664
    ' Const PROCESSOR_ARM As Integer = Reserved

    Structure SYSTEM_INFO
        Dim wProcessorArchitecture As UShort
        Dim wReserved As UShort
        Dim dwPageSize As UInteger
        Dim lpMinimumApplicationAddress As ULong
        Dim lpMaximumApplicationAddress As ULong
        Dim dwActiveProcessorMask As ULong
        Dim dwNumberOfProcessors As UInteger
        Dim dwProcessorType As UInteger
        Dim dwAllocationGranularity As UInteger
        Dim wProcessorLevel As UShort
        Dim wProcessorRevision As UShort
    End Structure

    Structure SYSTEM_INFO2
        Dim wProcessorArchitecture As UShort
        Dim wReserved As UShort
        Dim dwPageSize As UInteger
        Dim lpMinimumApplicationAddress As IntPtr
        Dim lpMaximumApplicationAddress As IntPtr
        Dim dwActiveProcessorMask As ULong
        Dim dwNumberOfProcessors As UInteger
        Dim dwProcessorType As UInteger
        Dim dwAllocationGranularity As UInteger
        Dim wProcessorLevel As UShort
        Dim wProcessorRevision As UShort
    End Structure

    Declare Auto Sub GNSInfo Lib "kernel32.dll" Alias "GetNativeSystemInfo" (ByRef sysInfo As SYSTEM_INFO)
    Declare Auto Sub GSInfo Lib "kernel32.dll" Alias "GetSystemInfo" (ByRef sysInfo As SYSTEM_INFO2)

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim sInfo As SYSTEM_INFO
        Dim sInfo2 As SYSTEM_INFO2
        Dim msg1, msg2 As String

        GNSInfo(sInfo)
        GSInfo(sInfo2)

        msg1 = "wProcessorArchitecture = " & sInfo.wProcessorArchitecture & vbCrLf & _
               "wReserved = " & sInfo.wReserved & vbCrLf & _
               "dwPageSize = " & sInfo.dwPageSize & vbCrLf & _
               "lpMinimumApplicationAddress = " & sInfo.lpMinimumApplicationAddress.ToString("x") & vbCrLf & _
               "lpMaximumApplicationAddress = " & sInfo.lpMaximumApplicationAddress.ToString("x") & vbCrLf & _
               "dwActiveProcessorMask = " & sInfo.dwActiveProcessorMask & vbCrLf & _
               "dwNumberOfProcessors = " & sInfo.dwNumberOfProcessors & vbCrLf & _
               "dwProcessorType = " & sInfo.dwProcessorType & vbCrLf & _
               "dwAllocationGranularity = " & sInfo.dwAllocationGranularity & vbCrLf & _
               "wProcessorLevel = " & sInfo.wProcessorLevel & vbCrLf & _
               "wProcessorRevision = " & sInfo.wProcessorRevision

        msg2 = "wProcessorArchitecture = " & sInfo2.wProcessorArchitecture & vbCrLf & _
               "wReserved = " & sInfo2.wReserved & vbCrLf & _
               "dwPageSize = " & sInfo2.dwPageSize & vbCrLf & _
               "lpMinimumApplicationAddress = " & sInfo2.lpMinimumApplicationAddress.ToString("x") & vbCrLf & _
               "lpMaximumApplicationAddress = " & sInfo2.lpMaximumApplicationAddress.ToString("x") & vbCrLf & _
               "dwActiveProcessorMask = " & sInfo2.dwActiveProcessorMask & vbCrLf & _
               "dwNumberOfProcessors = " & sInfo2.dwNumberOfProcessors & vbCrLf & _
               "dwProcessorType = " & sInfo2.dwProcessorType & vbCrLf & _
               "dwAllocationGranularity = " & sInfo2.dwAllocationGranularity & vbCrLf & _
               "wProcessorLevel = " & sInfo2.wProcessorLevel & vbCrLf & _
               "wProcessorRevision = " & sInfo2.wProcessorRevision

        MessageBox.Show(msg1, "SYSTEM_INFO arg data")
        MessageBox.Show(msg2, "SYSTEM_INFO2 arg data")

        Select Case sInfo.wProcessorArchitecture
            Case PROCESSOR_ARCHITECTURE_INTEL
                MessageBox.Show("32ビット", "OSのタイプ")
            Case PROCESSOR_ARCHITECTURE_ARM
            Case PROCESSOR_ARCHITECTURE_IA64
            Case PROCESSOR_ARCHITECTURE_AMD64
                MessageBox.Show("64ビット", "OSのタイプ", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Case PROCESSOR_ARCHITECTURE_ARM64
            Case PROCESSOR_ARCHITECTURE_UNKNOWN
        End Select

        Select Case sInfo.dwProcessorType
            Case PROCESSOR_INTEL_386
            Case PROCESSOR_INTEL_486
            Case PROCESSOR_INTEL_PENTIUM
                MessageBox.Show("Pentium4", "CPUのタイプ")
            Case PROCESSOR_INTEL_IA64
            Case PROCESSOR_AMD_X8664
                MessageBox.Show("AMD Ryzen?" & vbCrLf & "な訳ありません", "CPUのタイプ", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Select

        MessageBox.Show(sInfo.dwNumberOfProcessors & " Core", "プロセッサ数", MessageBoxButtons.OK, MessageBoxIcon.Information)

    End Sub
End Class

/*----------------------------------------------------------------------------*/

/*----------------------------------------------------------------------------*/
/*============================================================================*/

VisualBasicとDLLに実装されたアンマネージド関数との間で、構造体データの受け渡しを試して見ようと、GetSystemInfo関数を呼び出すだけのサンプルを作ってみました(GetNativeSystemInfo関数も同様)。

マイクロソフトのドキュメントによれば、SYSTEM_INFOの構文は、

typedef struct _SYSTEM_INFO {
    union {
        DWORD dwOemId;
        struct {
            WORD wProcessorArchitecture;
            WORD wReserved;
        } DUMMYSTRUCTNAME;
    } DUMMYUNIONNAME;
    DWORD     dwPageSize;
    LPVOID    lpMinimumApplicationAddress;
    LPVOID    lpMaximumApplicationAddress;
    DWORD_PTR dwActiveProcessorMask;
    DWORD     dwNumberOfProcessors;
    DWORD     dwProcessorType;
    DWORD     dwAllocationGranularity;
    WORD      wProcessorLevel;
    WORD      wProcessorRevision;
} SYSTEM_INFO, *LPSYSTEM_INFO;

なので、構造体メンバーの変数型を UShort と UInteger に置き換えれば、上手くゆく筈?


★それにしても、凡そ20年前の WindowsXP と ペンティアム4、現役バリバリで良く頑張っているなぁ。


<注意点>

・Win32 ではC/C++のポインタサイズは4バイト、ポインタ精度変数のサイズも4バイト。つまり、Integer 型です。

・DWORD_PTR は Win32/Win64 でサイズが変化する事に留意。LPVOID は IntPtr の方が好ましい?

・Visual Basic のデフォルトの文字セットは、UNICODE です。


お試し環境
  WindowsXP 32bit Edition
  Visual Basic 2008


/*-------------------------------- お試し結果 ------------------------------*/

・GetSystemInfo 関数の取得データ

取得SYSTEM_INFOデータ


・GetNativeSystemInfo 関数の取得データ

取得SYSTEM_INFO2データ

/*----------------------------------------------------------------------------*/


/*-------------------------------- お試しソース ----------------------------*/

Imports System.Runtime.InteropServices

Public Class Form1

    Const PROCESSOR_ARCHITECTURE_INTEL As Integer = 0 ' x86
    Const PROCESSOR_ARCHITECTURE_ARM As Integer = 5 ' ARM
    Const PROCESSOR_ARCHITECTURE_IA64 As Integer = 6 ' Intel Itanium-based
    Const PROCESSOR_ARCHITECTURE_AMD64 As Integer = 9 ' x64(AMD or Intel)
    Const PROCESSOR_ARCHITECTURE_ARM64 As Integer = 12 ' ARM64
    Const PROCESSOR_ARCHITECTURE_UNKNOWN As Integer = &HFFFF ' Unknown architecture

    Const PROCESSOR_INTEL_386 As Integer = 386
    Const PROCESSOR_INTEL_486 As Integer = 486
    Const PROCESSOR_INTEL_PENTIUM As Integer = 586
    Const PROCESSOR_INTEL_IA64 As Integer = 2200
    Const PROCESSOR_AMD_X8664 As Integer = 8664
    ' Const PROCESSOR_ARM As Integer = Reserved

    Structure SYSTEM_INFO
        Dim wProcessorArchitecture As UShort
        Dim wReserved As UShort
        Dim dwPageSize As UInteger
        Dim lpMinimumApplicationAddress As UInteger ' LPVOID
        Dim lpMaximumApplicationAddress As UInteger ' LPVOID
        Dim dwActiveProcessorMask As UInteger ' DWORD_PTR
        Dim dwNumberOfProcessors As UInteger
        Dim dwProcessorType As UInteger
        Dim dwAllocationGranularity As UInteger
        Dim wProcessorLevel As UShort
        Dim wProcessorRevision As UShort
    End Structure

    Structure SYSTEM_INFO2
        Dim wProcessorArchitecture As UShort
        Dim wReserved As UShort
        Dim dwPageSize As UInteger
        Dim lpMinimumApplicationAddress As IntPtr
        Dim lpMaximumApplicationAddress As IntPtr
        Dim dwActiveProcessorMask As UInteger ' DWOD_PTR
        Dim dwNumberOfProcessors As UInteger
        Dim dwProcessorType As UInteger
        Dim dwAllocationGranularity As UInteger
        Dim wProcessorLevel As UShort
        Dim wProcessorRevision As UShort
    End Structure

    Declare Auto Sub GetSystemInfo Lib "kernel32.dll" (ByRef sysInfo As SYSTEM_INFO)
    Declare Auto Sub GetNativeSystemInfo Lib "kernel32.dll" (ByRef sysInfo As SYSTEM_INFO2)

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim sInfo As SYSTEM_INFO
        Dim sInfo2 As SYSTEM_INFO2
        Dim msg1, msg2 As String

        GetSystemInfo(sInfo)
        GetNativeSystemInfo(sInfo2)

        msg1 = "wProcessorArchitecture = " & sInfo.wProcessorArchitecture & vbCrLf & _
               "wReserved = " & sInfo.wReserved & vbCrLf & _
               "dwPageSize = " & sInfo.dwPageSize & vbCrLf & _
               "lpMinimumApplicationAddress = " & sInfo.lpMinimumApplicationAddress.ToString("x") & vbCrLf & _
               "lpMaximumApplicationAddress = " & sInfo.lpMaximumApplicationAddress.ToString("x") & vbCrLf & _
               "dwActiveProcessorMask = " & sInfo.dwActiveProcessorMask & vbCrLf & _
               "dwNumberOfProcessors = " & sInfo.dwNumberOfProcessors & vbCrLf & _
               "dwProcessorType = " & sInfo.dwProcessorType & vbCrLf & _
               "dwAllocationGranularity = " & sInfo.dwAllocationGranularity & vbCrLf & _
               "wProcessorLevel = " & sInfo.wProcessorLevel & vbCrLf & _
               "wProcessorRevision = " & sInfo.wProcessorRevision

        msg2 = "wProcessorArchitecture = " & sInfo2.wProcessorArchitecture & vbCrLf & _
               "wReserved = " & sInfo2.wReserved & vbCrLf & _
               "dwPageSize = " & sInfo2.dwPageSize & vbCrLf & _
               "lpMinimumApplicationAddress = " & sInfo2.lpMinimumApplicationAddress.ToString("x") & vbCrLf & _
               "lpMaximumApplicationAddress = " & sInfo2.lpMaximumApplicationAddress.ToString("x") & vbCrLf & _
               "dwActiveProcessorMask = " & sInfo2.dwActiveProcessorMask & vbCrLf & _
               "dwNumberOfProcessors = " & sInfo2.dwNumberOfProcessors & vbCrLf & _
               "dwProcessorType = " & sInfo2.dwProcessorType & vbCrLf & _
               "dwAllocationGranularity = " & sInfo2.dwAllocationGranularity & vbCrLf & _
               "wProcessorLevel = " & sInfo2.wProcessorLevel & vbCrLf & _
               "wProcessorRevision = " & sInfo2.wProcessorRevision

        MessageBox.Show(msg1, "sInfo members data")
        MessageBox.Show(msg2, "sInfo2 members data")

        Select Case sInfo.wProcessorArchitecture
            Case PROCESSOR_ARCHITECTURE_INTEL
                MessageBox.Show("32ビット です", "OSのバージョンは", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Case PROCESSOR_ARCHITECTURE_ARM
            Case PROCESSOR_ARCHITECTURE_IA64
            Case PROCESSOR_ARCHITECTURE_AMD64
                MessageBox.Show("64ビット です", "OSのバージョンは", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Case PROCESSOR_ARCHITECTURE_ARM64
            Case PROCESSOR_ARCHITECTURE_UNKNOWN
        End Select

        Select Case sInfo.dwProcessorType
            Case PROCESSOR_INTEL_386
            Case PROCESSOR_INTEL_486
            Case PROCESSOR_INTEL_PENTIUM
                MessageBox.Show("Pentium4 です", "CPUのタイプは", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Case PROCESSOR_INTEL_IA64
            Case PROCESSOR_AMD_X8664
                MessageBox.Show("AMD Ryzen9 です", "CPUのタイプは", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End Select
    End Sub
End Class

/*----------------------------------------------------------------------------*/

/*----------------------------------------------------------------------------*/
/*============================================================================*/

CPUがx64だと言っても、まだまだx86の呼出し規則が優勢と言うかWOW64の方が全盛の内に、x86呼出し規則を浚ってみました。

C・C++間や他言語からのDLL内関数呼出しを行う場合、大事なのはCリンケージと __stdcall です。

特に指定しない限り、C++コンパイラはC++リンケージであるC++のタイプセーフな名前付け規約(名前装飾)と、C++の呼出し規則を使用します。

Cコンパイラは既定で、Cの呼出し規則とCリンケージを使います。

★C・C++間でDLL内の関数を利用するには、Cリンケージである extern "C" を指定して関数を宣言し、コンパイラがC++の関数名を装飾するのを禁止する必要があります。

★他言語からDLL内の関数を利用するには、__stdcall 呼出し規則を使用する必要があります。


<注意点>

・C++が装飾名を必須とするのは、オーバーロードされた関数、クラスや名前空間のメンバー、コンストラクターやデストラクター、などなどを一意に特定する必要がある事に起因します。

・__stdcall で修飾さる名前には、関数名の前にアンダースコア '_' が、後にアットマーク '@' が、更にその後に引数リストのバイト数が付けられます。例えば、int __stdcall func(int a, double b) 関数は、_func@12 と名前修飾されます。


【Visual C/C++ コンパイラの呼出し規則】

Visual C/C++ コンパイラの呼出し規則一覧
規約 *1コンパイラ
オプション
スタック
一掃
引数渡しCリンケージ
修飾形式 *2
補足
__cdecl /Gd
x86 のみ
呼出し元 右から左の順で
スタックに積まれる
_fname C/C++標準
__clrcall なし N/A 左から右の順で
CLR式スタックに収容
N/A .NET専用
__stdcall /Gz
x86 のみ
呼出し先 右から左の順で
スタックに積まれる
_fname@num Win32API呼出し
他言語アプリからの
関数呼び出し
__fastcall /Gr
x86 のみ
呼出し先 レジスタで渡され
残りは右から左の順で
スタックに積まれる
@fname@num 通常、高速呼出し
__thiscall なし 呼出し先 右から左の順でスタック
に積まれ this ポインタは
ECX レジスタに格納
N/A C++メンバー関数
__vectorcall /Gv
x86, x64
呼出し先 レジスタで渡され
残りは右から左の順で
スタックに積まれる
fname@@num __fastcall より多くの
レジスタで渡すか
既定の x64 呼出し *3
を使う

 *1:Visual C/C++ コンパイラでサポートされている呼び出し規約
 *2:fname は関数名、num は引数リストのバイト数を表す
 *3:x64ABIの既定では4レジスタ高速呼出しの呼び出し規則が使用される

前回に続いて、DLLに実装されたアンマネージド関数をマネージドコードから呼び出すことが出来る「プラットフォーム呼出し(PInvoke)」を使って、VBからWin32APIを呼び出してみます。

取り敢えず、DllImport 属性を使用して MessageBox を呼び出すだけのサンプルを作ってみました。

DllImport 属性でDLL内の名前を指定する事によって、引数と戻り値の相互運用マーシャリングも行われます。

ExactSpelling 項目は CharSet 項目の設定内容に影響を与えます。ExactSpelling を省略すると ExactSpelling:=False として扱われるよです。

ExactSpelling:=False の場合、CharSet の Auto、Ansi、Unicode 設定は柔軟に作用しますが、ExactSpelling:=True の場合は厳格に適用されます。

CharSet と EntryPoint と ExactSpelling 項目間の設定内容に不一致などがあると、メッセージボックス内で文字化けが起きたり、例外が発生したりします。


<注意点>

・DllImport はクラスのインスタンスを必要とするメソッドは使用できません。呼出しで共有(静的)メソッドを参照している場合にのみ、Windows API を呼び出せます。

・Visual Basic のデフォルトの文字セットは、UNICODE です。


お試し環境
  WindowsXP 32bit Edition、Windows7 64bit Edition
  Visual Basic 2008


/*-------------------------------- お試し結果 ------------------------------*/

・<DllImport("user32.dll", ... CharSet:=CharSet.Auto, EntryPoint:="MessageBox", ExactSpelling:=False, ...)> _ の場合

auto&false メッセージボックス表示


・<DllImport("user32.dll", ... CharSet:=CharSet.Ansi, EntryPoint:="MessageBox", ExactSpelling:=False, ...)> _ の場合

ansi&false メッセージボックス表示


・<DllImport("user32.dll", ... CharSet:=CharSet.Unicode, EntryPoint:="MessageBox", ExactSpelling:=False, ...)> _ の場合

unicode&false メッセージボックス表示


・<DllImport("user32.dll", ... CharSet:=CharSet.Auto, EntryPoint:="MessageBox", ExactSpelling:=True, ...)> _ の場合

auto&true-1 例外エラー表示


・<DllImport("user32.dll", ... CharSet:=CharSet.Ansi, EntryPoint:="MessageBox", ExactSpelling:=True, ...)> _ の場合

ansi&true-1 例外エラー表示


・<DllImport("user32.dll", ... CharSet:=CharSet.Unicode, EntryPoint:="MessageBox", ExactSpelling:=True, ...)> _ の場合

unicode&true-1 例外エラー表示


・<DllImport("user32.dll", ... CharSet:=CharSet.Auto, EntryPoint:="MessageBoxA", ExactSpelling:=False, ...)> _
・<DllImport("user32.dll", ... CharSet:=CharSet.Auto, EntryPoint:="MessageBoxA", ExactSpelling:=True, ...)> _ の場合

auto&false, true メッセージボックス文字化け表示


・<DllImport("user32.dll", ... CharSet:=CharSet.Ansi, EntryPoint:="MessageBoxW", ExactSpelling:=False, ...)> _
・<DllImport("user32.dll", ... CharSet:=CharSet.Ansi, EntryPoint:="MessageBoxW", ExactSpelling:=True, ...)> _ の場合

ansi&false, true メッセージボックス文字化け表示


・<DllImport("user32.dll", ... CharSet:=CharSet.Unicode, EntryPoint:="MessageBoxA", ExactSpelling:=False, ...)> _
・<DllImport("user32.dll", ... CharSet:=CharSet.Unicode, EntryPoint:="MessageBoxA", ExactSpelling:=True, ...)> _ の場合

unicode&false, true メッセージボックス文字化け表示


・<DllImport("user32.dll", ... CharSet:=CharSet.Auto, EntryPoint:="MessageBoxW", ExactSpelling:=True, ...)> _ の場合

auto&true-2 メッセージボックス表示


・<DllImport("user32.dll", ... CharSet:=CharSet.Ansi, EntryPoint:="MessageBoxA", ExactSpelling:=True, ...)> _ の場合

ansi&true-2 メッセージボックス表示


・<DllImport("user32.dll", ... CharSet:=CharSet.Unicode, EntryPoint:="MessageBoxW", ExactSpelling:=True, ...)> _ の場合

unicode&true-2 メッセージボックス表示


/*----------------------------------------------------------------------------*/


/*-------------------------------- お試しソース ----------------------------*/

Imports System.Runtime.InteropServices

Public Class Form1

    Const MB_ICONQUESTION As Integer = &H20
    Const MB_YESNO As Integer = &H4
    Const ID_YES As Integer = 6
    Const ID_NO As Integer = 7

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        ' Stores the return value.
        Dim RetVal As Integer

        Try
            RetVal = MBox5(0, "DllImport-exactspelling & unmanaged Windows API Test", "MBox5 charset auto", MB_ICONQUESTION Or MB_YESNO)

            ' Check the return value.
            If RetVal = ID_YES Then
                MsgBox("choice Yes", , "MBox5")
            Else
                MsgBox("choice No", , "MBox5")
            End If

        Catch ex As EntryPointNotFoundException
            MessageBox.Show(ex.Message, "MBox5の例外エラーを捕捉しました")
        Catch ex As Exception
            MessageBox.Show(ex.Message, "その他の例外エラーを捕捉しました")
        End Try

        Try
            RetVal = MBox6(0, "DllImport-exactspelling & unmanaged Windows API Test", "MBox6 charset ansi", MB_ICONQUESTION Or MB_YESNO)

            ' Check the return value.
            If RetVal = ID_YES Then
                MsgBox("choice Yes", , "MBox6")
            Else
                MsgBox("choice No", , "MBox6")
            End If

        Catch ex As EntryPointNotFoundException
            MessageBox.Show(ErrorToString(), "MBox6の例外エラーを捕捉しました")
        Catch ex As Exception
            MessageBox.Show(ErrorToString(), "その他の例外エラーを捕捉しました")
        End Try

        Try
            RetVal = MBox7(0, "DllImport-exactspelling & unmanaged Windows API Test", "MBox7 charset unicode", MB_ICONQUESTION Or MB_YESNO)

            ' Check the return value.
            If RetVal = ID_YES Then
                MsgBox("choice Yes", , "MBox7")
            Else
                MsgBox("choice No", , "MBox7")
            End If

        Catch ex As EntryPointNotFoundException
            MessageBox.Show(ex.Message, "MBox7の例外エラーを捕捉しました")
        Catch ex As Exception
            MessageBox.Show(ex.Message, "その他の例外エラーを捕捉しました")
        End Try

    End Sub

    <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Auto, EntryPoint:="MessageBoxW", ExactSpelling:=True, SetLastError:=True)> _
    Public Shared Function MBox5(ByVal hWnd As Integer, ByVal text As String, ByVal caption As String, ByVal type As Integer) As Integer
    End Function

    <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Ansi, EntryPoint:="MessageBoxA", ExactSpelling:=True, SetLastError:=True)> _
    Public Shared Function MBox6(ByVal hWnd As Integer, ByVal text As String, ByVal caption As String, ByVal type As Integer) As Integer
    End Function

    <DllImport("user32.dll", CallingConvention:=CallingConvention.StdCall, CharSet:=CharSet.Unicode, EntryPoint:="MessageBoxW", ExactSpelling:=True, SetLastError:=True)> _
    Public Shared Function MBox7(ByVal hWnd As Integer, ByVal text As String, ByVal caption As String, ByVal type As Integer) As Integer
    End Function

End Class

/*----------------------------------------------------------------------------*/

/*----------------------------------------------------------------------------*/
/*============================================================================*/

Visual Basic.NET が登場してから早20年。.NETが提供する豊富な機能を利用する事で、Windows API を使用しなくても機能を実装することが出来るようになった、と登場時に言われてから久しいので今更ですが、VBからWin32APIを呼び出してみる事に。

Windows API は、WindowsOSの一部機能であるDLL(ダイナミック・リンク・ライブラリ)ですが、アンマネージド関数であるため、慎重さが必要です。

マイクロソフトのドキュメントによれば、

Windows API を使用する利点は、既に記述され、使用されるのを待っている便利な関数が多数含まれているため、開発時間を節約できる事です。欠点として、Windows API は処理が容易でなく、問題が発生した時に困難な状況に陥る事があります。

Windows API にマネージド・コードは使用されておらず、組み込みのタイプ・ライブラリはありません。また、使用するデータ型は Visual Studio で使用するものとは異なります。Windows API および .NET Framework との相互運用性は、プラットフォーム呼び出し(PInvoke)を使用して実現されます。Visual Basic で PInvoke を使用するには、Declare ステートメントを使用するか、DllImport 属性を「空のプロシージャ」に適用します。

Windows API 呼び出しは、過去においては Visual Basic プログラミングの重要な部分でしたが、Visual Basic .NET ではほとんど必要ありません。可能な限り、Windows API 呼び出しではなく .NET Framework のマネージド関数を使用してタスクを実行するようにして下さい。

の様です。

取り敢えず、Declare ステートメントを使用して MessageBox を呼び出すだけのサンプルを作ってみました。

文字セット修飾子が Auto の場合、関数名に自動的にWを補ってくれるようです。Ansi や Unicode の場合は、関数名にAまたはWが付加されている事を要求します。

Ansi 修飾子は全ての文字列を ANSI 値に、Unicode 修飾子は全ての文字列を UNICODE 値に、自動的にマーシャリングが行われます。

指定した文字型と関数のエントリポイントに不一致などがあると、メッセージボックス内で文字化けが起きたり、例外が発生したりします。


<注意点>

・Declare 宣言の文字セット修飾子の規定値(デフォルト)は、ANSI です。

・Declare 宣言時に Shared 修飾子は使用できませんが、暗黙的に Shared になります。

・Visual Basic のデフォルトの文字セットは、UNICODE です。


お試し環境
  WindowsXP 32bit Edition、Windows7 64bit Edition
  Visual Basic 2008


/*-------------------------------- お試し結果 ------------------------------*/

・Declare Auto Function MBox1 Lib "user32.dll" Alias "MessageBox" (arg1, ...) As Integer の場合

auto-1メッセージボックス表示


・Declare Ansi Function MBox2 Lib "user32.dll" Alias "MessageBox" (arg1, ...) As Integer の場合

ansi-1例外エラー表示


・Declare Unicode Function MBox3 Lib "user32.dll" Alias "MessageBox" (arg1, ...) As Integer の場合

unicode-1例外エラー表示


・Declare Auto Function MBox1 Lib "user32.dll" Alias "MessageBoxA" (arg1, ...) As Integer の場合

auto-2メッセージボックス文字化け表示


・Declare Ansi Function MBox2 Lib "user32.dll" Alias "MessageBoxW" (arg1, ...) As Integer の場合

ansi-2メッセージボックス文字化け表示


・Declare Unicode Function MBox3 Lib "user32.dll" Alias "MessageBoxA" (arg1, ...) As Integer の場合

unicode-2メッセージボックス文字化け表示


・Declare Auto Function MBox1 Lib "user32.dll" Alias "MessageBoxW" (arg1, ...) As Integer の場合

auto-3メッセージボックス表示


・Declare Ansi Function MBox2 Lib "user32.dll" Alias "MessageBoxA" (arg1, ...) As Integer の場合

ansi-3メッセージボックス表示


・Declare Unicode Function MBox3 Lib "user32.dll" Alias "MessageBoxW" (arg1, ...) As Integer の場合

unicode-3メッセージボックス表示


/*----------------------------------------------------------------------------*/


/*-------------------------------- お試しソース ----------------------------*/

Public Class Form1

    Const MB_ICONQUESTION As Integer = &H20
    Const MB_YESNO As Integer = &H4
    Const ID_YES As Integer = 6
    Const ID_NO As Integer = 7

    Declare Auto Function MBox1 Lib "user32.dll" Alias "MessageBox" (ByVal hWnd As Integer, ByVal text As String, ByVal caption As String, ByVal type As Integer) As Integer
    Declare Ansi Function MBox2 Lib "user32.dll" Alias "MessageBoxA" (ByVal hWnd As Integer, ByVal text As String, ByVal caption As String, ByVal type As Integer) As Integer
    Declare Unicode Function MBox3 Lib "user32.dll" Alias "MessageBoxW" (ByVal hWnd As Integer, ByVal text As String, ByVal caption As String, ByVal type As Integer) As Integer

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        ' Stores the return value.
        Dim RetVal As Integer

        RetVal = MBox1(0, "Declare-charsetmodifier & unmanaged Windows API Test", "MBox1 charset auto", MB_ICONQUESTION Or MB_YESNO)

        ' Check the return value.
        If RetVal = ID_YES Then
            MsgBox("choice Yes", , "MBox1")
        Else
            MsgBox("choice No", , "MBox1")
        End If

        Try
            RetVal = MBox2(0, "Declare-charsetmodifier & unmanaged Windows API Test", "MBox2 charset ansi", MB_ICONQUESTION Or MB_YESNO)

            ' Check the return value.
            If RetVal = ID_YES Then
                MsgBox("choice Yes", , "MBox2")
            Else
                MsgBox("choice No", , "MBox2")
            End If

        Catch ex As EntryPointNotFoundException
            MessageBox.Show(ex.Message, "MBox2の例外エラーを捕捉しました")
        Catch ex As Exception
            MessageBox.Show(ex.Message, "その他の例外エラーを捕捉しました")
        End Try

        Try
            RetVal = MBox3(0, "Declare-charsetmodifier & unmanaged Windows API Test", "MBox3 charset unicode", MB_ICONQUESTION Or MB_YESNO)

            ' Check the return value.
            If RetVal = ID_YES Then
                MsgBox("choice Yes", , "MBox3")
            Else
                MsgBox("choice No", , "MBox3")
            End If

        Catch ex As EntryPointNotFoundException
            MessageBox.Show(Err.Description(), "MBox3の例外エラーを捕捉しました")
        Catch ex As Exception
            MessageBox.Show(Err.Description(), "その他の例外エラーを捕捉しました")
        End Try

    End Sub
End Class

/*----------------------------------------------------------------------------*/

/*----------------------------------------------------------------------------*/
/*============================================================================*/

最近のコンテンツはインデックスページで見られます。過去に書かれたものはアーカイブのページで見られます。

タグクラウド

ウェブページ

NOP法人 アジアチャイルドサポート 最も大切なボランティアは、自分自身が一生懸命に生きること