WILLはネットワークに関するあらゆるソリューションをご提供します。
	株式会社ウィル

概 要

PACKETは、固定長ヘッダーを持つデータ転送方式のサンプルです。固定長ヘッダーにデータ長、データ型などの情報を含めることにより、処理を階層化できるようになります。 PACKETは、ECHOサーバーを利用して、送信を行う部分と受信を行う部分の説明を１つのプログラムで行っています。 また、PACKETは、整数を送受信するテクニックを紹介しています。データ長に32ビット整数、データ型に16ビット整数を用いて送受信しています。

ソースコード

'(C)COPYRIGHT 1998 WILL
Option Explicit
Dim Arrived$
Private Sub Command1_Click()
    On Error GoTo Command1_err1
    'Text1 サーバーのホスト名またはIPアドレス
    'Text2 サーバーのポート番号またはサービス名
    '          7  echo   echoサーバー
    '         25  smtp   smtpサーバー
    '         43  whois  whoisサーバー
    '         79  finger fingerサーバー
    '        110  pop    popサーバー
	 Tcpip1.Connect Text1, Text2, "0"
    Exit Sub

Command1_err1:
    MsgBox Err.Description, vbExclamation, "CONNECT ERROR " & Err.Number
End Sub

Private Sub SendFrame()
    Dim s$, data$, header$, frame$, FrameID%
    
'   Frame Format   |  L  |ID |    X    |
'                  |  4  | 2 |<-- L -->| (bytes)
'
     If (Option1.Value = True) Then         '文字列
        FrameID = 1
        data = StrConv(Text3, vbFromUnicode)
    ElseIf (Option2.Value = True) Then      '整数（１６ビット）
        FrameID = 2
        On Error GoTo SendFrameErr1         'オーバーフローするかもしれない
        data = Tcpip1.htons(CInt(Text3))    'ネットワークオーダーにする
    ElseIf (Option3.Value = True) Then      '整数（３２ビット）
        FrameID = 3
        On Error GoTo SendFrameErr1         'オーバーフローするかもしれない
        data = Tcpip1.htonl(CLng(Text3))    'ネットワークオーダーにする
    Else
        FrameID = 4
        data = ""
    End If
    header = Tcpip1.htonl(LenB(data)) & Tcpip1.htons(FrameID)
    frame = header & data                    'ヘッダーを付けて送信する
    List1.AddItem "SEND " & FrameID & ":" & Text3
    Tcpip1.Send frame
    Exit Sub

SendFrameErr1:
    MsgBox Err.Description, vbExclamation, Err.Number
    Tcpip1.Close
End Sub

Private Sub Form_Load()
     'TCPIP.OCXの著作権表示
     Label3.Caption = Tcpip1.copyright
End Sub

'通信が切断された
Private Sub Tcpip1_Closed()
    List1.AddItem "CLOSED"
End Sub

'サーバーと接続できた
Private Sub Tcpip1_Connected()
    List1.Clear
    List1.AddItem "CONNECTED"
    Arrived = ""
    SendFrame
End Sub

'受信した
Private Sub Tcpip1_Received(data As String)
    Dim d$, L&, N&, F%
    
'   Frame Format   |  L  |ID |    X    |
'                  |  4  | 2 |<-- L -->| (bytes)
    
    Arrived = Arrived & data
    N = LenB(Arrived)
    If (N >= 6) Then                'ヘッダー長（4+2)以上データがあるなら
        L = Tcpip1.ntohl(Arrived)   'データ長
        d = MidB$(Arrived, 5, 2)
        F = Tcpip1.ntohs(d)         'データタイプ
        If (N >= 6 + L) Then        'ヘッダー長＋データ長以上のデータがあるなら
            d = MidB$(Arrived, 7, L) 'データ部を取り出す
            Arrived = MidB$(Arrived, 6 + L + 1) '未処理のデータをArrivedに残す
            Select Case F           'データタイプに応じて処理を分ける
            Case 1                  '文字列
                List1.AddItem "RECV " & F & ":" & StrConv(d, vbUnicode)
            Case 2                  '整数(16ビット）
                List1.AddItem "RECV " & F & ":" & Tcpip1.ntohs(d)
            Case 3                  '整数(32ビット）
                List1.AddItem "RECV " & F & ":" & Tcpip1.ntohl(d)
            Case Else               'その他（普通はエラーとする）
                List1.AddItem "RECV " & F
            End Select
            Tcpip1.Close
        End If
    End If
End Sub

Private Sub Tcpip1_WsError(ByVal Ecode As Long, ByVal Description As String, ByVal Where As String, CancelClose As Boolean)
    List1.AddItem "ERROR(" & Ecode & ")" & Description
End Sub