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(ByVal ID%, ByVal X$)
    Dim Frame$

'   Frame Format   |  L  |ID |    X    |
'                  |  4  | 2 |<-- L -->| (bytes)
'

    Frame = Tcpip1.htonl(LenB(X))& Tcpip1.htons(ID) & X
    Tcpip1.Send Frame
End Sub
Private Sub SendData()
    Dim data$, FrameID%
    If (Combo1.ListIndex = 0) Then          '文字列
        FrameID = 1
        data = StrConv(Text3, vbFromUnicode)
    ElseIf (Combo1.ListIndex = 1) Then      '整数（１６ビット）
        FrameID = 2
        On Error GoTo SendDataErr1          'オーバーフローするかもしれない
        data = Tcpip1.htons(CInt(Text3))    'ネットワークオーダーにする
    ElseIf (Combo1.ListIndex = 2) Then      '整数（３２ビット）
        FrameID = 3
        On Error GoTo SendDataErr1          'オーバーフローするかもしれない
        data = Tcpip1.htonl(CLng(Text3))    'ネットワークオーダーにする
    Else
        FrameID = 4
        data = ""
    End If
    
    addlog "SEND " & FrameID & ":" & Text3
    SendFrame FrameID, data                 'ヘッダーを付けて送信する
    Exit Sub

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

Private Sub addlog(ByVal msg$)
    Text4 = Text4 & msg & vbCrLf
End Sub

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

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

'サーバーと接続できた
Private Sub Tcpip1_Connected()
    Text4 = ""
    addlog "CONNECTED"
    Arrived = ""
    SendData
End Sub

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

'送信した
Private Sub Tcpip1_Sent()
    addlog "SENT"
    Tcpip1.Shutdown 1           '送信したら送信口を閉じる
End Sub

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