NonSoft - ソケットAPI(WSAStartup/socket)での通信(TCP/UDP)サンプル(VB6)

ソケットAPI(WSAStartup/socket)での
通信(TCP/UDP)サンプル(VB6)

サンプル(ソース/コード)

＜このサンプルの概要＞
ソケットAPIを使用したTCP/IPとUDP/IPのサンプルソースです。
このサンプルは、VB6のサンプルですがVBAの通信プログラミングでも参考になると思います。

TCP/IPのサンプルはクライアント側のサンプルとサーバー側のサンプルがあります。

このサンプルの仕様は、
ソケット接続、電文送信、電文受信、ソケット切断のみのシンプル構造になっていますので、
ソケットAPIを使用したプログラミングの基本を簡単に理解する事が出来ます。

このサンプルでは次のソケットAPIを使用しています。
1.WSAStartup
2.WSACleanup
3.socket
4.closesocket
5.connect  ※TCP/IPクライアントの時
6.bind     ※UDP/IPの時はbindを使用。
           ※TCP/IPサーバの時はbind、listen、accept、WSAAsyncSelectを使用。
7.sendto   ※UDP/IPの時
8.send     ※TCP/IPの時
9.recv

TCP/IPのサーバー側はソケットAPI以外にウィンドウAPIを使用しています。
※クライアント側からの要求(イベント)を処理するため。
1.GetWindowLong
2.SetWindowLong
3.CallWindowProc

ソケット関係のその他のツールやサンプルソースはこちらです。
このサンプルの通信テストでもこちらのツールを使用しました。
通信サンプルやツール(RS232C TCP/IP UDP/IP)

★フォームモジュール(Form1.frm)

Option Explicit

' ソケット用定数
Private Const SOCKET_ERROR = -1
Private Const AF_INET = 2
Private Const SOCK_STREAM = 1
Private Const SOCK_DGRAM = 2
Private Const INADDR_ANY = 0
Private Const FD_READ = &H1
Private Const FD_ACCEPT = &H8
Private Const FD_CLOSE = &H20

' ソケット初期化用構造体
Private Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * 257
    szSystemStatus As String * 129
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type

' ソケットアドレス(IPおよびポート番号)
Private Type SOCKADDR
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

' ソケット初期化/終了API
Private Declare Function WSAStartup Lib "wsock32.dll" _
    (ByVal wVersionRequired As Long, ByRef lpWSAData As WSADATA) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long

' ソケットオープン/クローズAPI
Private Declare Function socket Lib "wsock32.dll" _
    (ByVal af As Long, ByVal socktype As Long, ByVal protocol As Long) As Long
Private Declare Function closesocket Lib "wsock32.dll" _
    (ByVal s As Long) As Long

' ソケットアドレスAPI
Private Declare Function htons Lib "wsock32.dll" _
    (ByVal hostshort As Long) As Integer
Private Declare Function inet_addr Lib "wsock32.dll" _
    (ByVal cp As String) As Long

' ソケット接続API
Private Declare Function connect Lib "wsock32.dll" _
    (ByVal s As Long, ByRef addr As SOCKADDR, ByVal addrlen As Long) As Long
Private Declare Function bind Lib "wsock32.dll" _
    (ByVal s As Long, ByRef addr As SOCKADDR, ByVal addrlen As Long) As Long
Private Declare Function listen Lib "wsock32.dll" _
    (ByVal s As Long, ByVal backlog As Long) As Long
Private Declare Function accept Lib "wsock32.dll" _
    (ByVal s As Long, ByRef addr As SOCKADDR, ByRef addrlen As Long) As Long
Private Declare Function WSAAsyncSelect Lib "wsock32.dll" _
    (ByVal s As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lngEvent As Long) As Long

' ソケット送信API
Private Declare Function sendto Lib "wsock32.dll" _
    (ByVal s As Long, ByRef buf As Byte, ByVal lngLen As Long, ByVal flags As Long, _
     ByRef addr As SOCKADDR, ByVal addrlen As Long) As Long
Private Declare Function send Lib "wsock32.dll" _
    (ByVal s As Long, ByRef buf As Byte, ByVal lngLenlen As Long, ByVal flags As Long) As Long

' ソケット受信API
Private Declare Function recvfrom Lib "wsock32.dll" _
    (ByVal s As Long, ByRef buf As Byte, ByVal lngLen As Long, ByVal flags As Long, _
     ByRef addr As SOCKADDR, ByVal addrlen As Long) As Long
Private Declare Function recv Lib "wsock32.dll" _
    (ByVal s As Long, ByRef buf As Byte, ByVal lngLen As Long, ByVal flags As Long) As Long

' ソケットハンドル(TCP/IPサーバー時に使用)
Private lngSck As Long
Private lngCli As Long  ' クライアントからの接続要求はとりあえず一個だけ

' フォーム開始
Private Sub Form_Load()
    lngSck = SOCKET_ERROR
End Sub

' フォーム終了
Private Sub Form_Unload(Cancel As Integer)
    Dim lngRtn As Long
    If lngSck <> SOCKET_ERROR Then
        ' ソケットクローズ
        closesocket (lngSck)
        ' ソケット終了
        WSACleanup
    End If
End Sub

' UDP/IPでの送信/受信
Private Sub Command1_Click()
    Dim lngRtn As Long
    Dim lngSck As Long
    
    ' ソケット初期化
    Dim wsa_data As WSADATA
    lngRtn = WSAStartup(&H101, wsa_data)
    If lngRtn = SOCKET_ERROR Then Exit Sub
    
    ' ソケットオープン
    lngSck = socket(AF_INET, SOCK_DGRAM, 0)
    If lngSck = SOCKET_ERROR Then Exit Sub
    
    ' ソケット受信設定
    Dim my_adr As SOCKADDR
    my_adr.sin_family = AF_INET
    my_adr.sin_port = htons(7777)
    my_adr.sin_addr = inet_addr("127.0.0.1")
    lngRtn = bind(lngSck, my_adr, Len(my_adr))
    If lngRtn = SOCKET_ERROR Then
        closesocket lngSck
        WSACleanup
        Exit Sub
    End If
    
    ' 送信電文作成
    Dim sdat() As Byte
    sdat = StrConv(Chr(2) & "1234あいう" & Chr(3), vbFromUnicode)

    ' ソケット送信
    Dim to_adr As SOCKADDR
    to_adr.sin_family = AF_INET
    to_adr.sin_port = htons(8888)
    to_adr.sin_addr = inet_addr("127.0.0.1")
    lngRtn = sendto(lngSck, sdat(0), UBound(sdat) + 1, 0, to_adr, Len(to_adr))
    If lngRtn = SOCKET_ERROR Then
        closesocket lngSck
        WSACleanup
        Exit Sub
    End If

    ' ソケット受信
    Dim rdat(255) As Byte
    lngRtn = recv(lngSck, rdat(0), UBound(rdat) + 1, 0)
    If lngRtn = SOCKET_ERROR Then
        closesocket lngSck
        WSACleanup
        Exit Sub
    End If
    
    ' 受信電文表示
    Debug.Print StrConv(rdat, vbUnicode)
    
    ' ソケットクローズ
    lngRtn = closesocket(lngSck)
    
    ' ソケット終了
    lngRtn = WSACleanup()
End Sub

' TCP/IPでの送信/受信(クライアント側)
Private Sub Command2_Click()
    Dim lngRtn As Long
    Dim lngSck As Long
    
    ' ソケット初期化
    Dim wsa_data As WSADATA
    lngRtn = WSAStartup(&H101, wsa_data)
    If lngRtn = SOCKET_ERROR Then Exit Sub
    
    ' ソケットオープン
    lngSck = socket(AF_INET, SOCK_STREAM, 0)
    If lngSck = SOCKET_ERROR Then Exit Sub
    
    ' ソケット接続
    Dim to_adr As SOCKADDR
    to_adr.sin_family = AF_INET
    to_adr.sin_port = htons(8888)
    to_adr.sin_addr = inet_addr("127.0.0.1")
    lngRtn = connect(lngSck, to_adr, Len(to_adr))
    If lngRtn = SOCKET_ERROR Then
        closesocket lngSck
        WSACleanup
        Exit Sub
    End If

    ' 送信電文作成
    Dim sdat() As Byte
    sdat = StrConv(Chr(2) & "1234あいう" & Chr(3), vbFromUnicode)

    ' ソケット送信
    lngRtn = send(lngSck, sdat(0), UBound(sdat) + 1, 0)
    If lngRtn = SOCKET_ERROR Then
        closesocket lngSck
        WSACleanup
        Exit Sub
    End If

    ' ソケット受信
    Dim rdat(255) As Byte
    lngRtn = recv(lngSck, rdat(0), UBound(rdat) + 1, 0)
    If lngRtn = SOCKET_ERROR Then
        closesocket lngSck
        WSACleanup
        Exit Sub
    End If
    
    ' 受信電文表示
    Debug.Print StrConv(rdat, vbUnicode)
    
    ' ソケットクローズ
    lngRtn = closesocket(lngSck)
    
    ' ソケット終了
    lngRtn = WSACleanup()
End Sub

' TCP/IPでの送信/受信(サーバー側)
Private Sub Command3_Click()
    Dim lngRtn As Long
    
    ' ソケット初期化
    Dim wsa_data As WSADATA
    lngRtn = WSAStartup(&H101, wsa_data)
    If lngRtn = SOCKET_ERROR Then Exit Sub
    
    ' ソケットオープン
    lngSck = socket(AF_INET, SOCK_STREAM, 0)
    If lngSck = SOCKET_ERROR Then Exit Sub
    
    ' ソケット接続設定
    Dim my_adr As SOCKADDR
    my_adr.sin_family = AF_INET
    my_adr.sin_port = htons(8888)
    my_adr.sin_addr = INADDR_ANY
    lngRtn = bind(lngSck, my_adr, Len(my_adr))
    If lngRtn = SOCKET_ERROR Then
        closesocket lngSck
        WSACleanup
        Exit Sub
    End If
    
    ' ソケット接続待ち
    lngRtn = listen(lngSck, 2)
    If lngRtn = SOCKET_ERROR Then
        closesocket lngSck
        WSACleanup
        Exit Sub
    End If
    
    ' FORMイベント(メッセージ)を処理する関数の登録
    lngWnP = GetWindowLong(Text1.hWnd, GWL_WNDPROC)
    SetWindowLong Text1.hWnd, GWL_WNDPROC, AddressOf WndProc
    
    ' 接続要求があった時に発生するメッセージの登録
    lngRtn = WSAAsyncSelect(lngSck, Text1.hWnd, 9999, FD_ACCEPT Or FD_READ Or FD_CLOSE)
    If lngRtn = SOCKET_ERROR Then
        closesocket lngSck
        WSACleanup
        Exit Sub
    End If
End Sub

' TCP/IPでの送信/受信(サーバー側)：TCP/IPクライアントからの接続有り
Public Sub MyClientProc(ByVal wParam As Long, ByVal lParam As Long)
    Dim lngRtn As Long
    
    Select Case lParam
    Case FD_ACCEPT
        Debug.Print "Client Accept!!"
        ' ソケット接続許可
        Dim from_adr As SOCKADDR
        Dim from_len As Long: from_len = Len(from_adr)
        lngCli = accept(lngSck, from_adr, from_len)
        If lngCli = SOCKET_ERROR Then
            Exit Sub
        End If
    
        ' 送信電文作成
        Dim sdat() As Byte
        sdat = StrConv(Chr(2) & "1234あいう" & Chr(3), vbFromUnicode)
    
        ' ソケット送信
        lngRtn = send(lngCli, sdat(0), UBound(sdat) + 1, 0)
        If lngRtn = SOCKET_ERROR Then
            closesocket lngCli
            Exit Sub
        End If
    Case FD_READ
        Debug.Print "Client Read!!"
        ' ソケット受信
        Dim rdat(255) As Byte
        lngRtn = recv(lngCli, rdat(0), UBound(rdat) + 1, 0)
        If lngRtn = SOCKET_ERROR Then
            closesocket lngCli
            Exit Sub
        End If
        
        ' 受信電文表示
        Debug.Print StrConv(rdat, vbUnicode)
    Case FD_CLOSE
        Debug.Print "Client Close!!"
        ' ソケットクローズ
        lngRtn = closesocket(lngCli)
    End Select
End Sub

★標準モジュール(Module1.bas)

Option Explicit

' ウィンドウのサブクラス化API
Public Const GWL_WNDPROC = -4
Public Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long

' ウィンドウ関数(デフォルト)
Public lngWnP As Long

' TCP/IPでの送信/受信(サーバー側)：ウィンドウ関数
Public Function WndProc( _
    ByVal hWnd As Long, ByVal msg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    WndProc = 0
    Select Case msg
    Case 9999
        ' クライアントからの要求があった時の処理
        Form1.MyClientProc wParam, lParam
    Case Else
        ' デフォルトメッセージ処理
        WndProc = CallWindowProc(lngWnP, hWnd, msg, wParam, lParam)
    End Select
End Function

トップページ

ダウンロード

サンプルソース

ち～な～み～に～

その他のおすすめソフト