VERSION 5.00
Begin VB.Form frmChat 
   BorderStyle     =   1  '固定(実線)
   Caption         =   "Chat"
   ClientHeight    =   8475
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6750
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8475
   ScaleWidth      =   6750
   StartUpPosition =   3  'Windows の既定値
   Begin VB.CommandButton cmdExit 
      Caption         =   "Exit"
      Height          =   375
      Left            =   5040
      TabIndex        =   12
      Top             =   7920
      Width           =   1455
   End
   Begin VB.Frame Frame3 
      Caption         =   "Receive Data"
      Height          =   3375
      Left            =   120
      TabIndex        =   16
      Top             =   4440
      Width           =   6495
      Begin VB.CommandButton cmdClear 
         Caption         =   "Clear"
         Height          =   375
         Left            =   4800
         TabIndex        =   11
         Top             =   2880
         Width           =   1455
      End
      Begin VB.TextBox txtReceiveData 
         Height          =   1455
         Left            =   240
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         ScrollBars      =   3  '両方
         TabIndex        =   10
         TabStop         =   0   'False
         Top             =   1320
         Width           =   6015
      End
      Begin VB.Label Label4 
         Caption         =   "Response:"
         Height          =   200
         Left            =   240
         TabIndex        =   19
         Top             =   360
         Width           =   1335
      End
      Begin VB.Label Label5 
         Caption         =   "History:"
         Height          =   255
         Left            =   240
         TabIndex        =   18
         Top             =   1080
         Width           =   1335
      End
      Begin VB.Label lblResponse 
         BackStyle       =   0  '透明
         BorderStyle     =   1  '実線
         Height          =   375
         Left            =   240
         TabIndex        =   17
         Top             =   600
         Width           =   6015
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "Send Data"
      Height          =   2415
      Left            =   120
      TabIndex        =   14
      Top             =   1920
      Width           =   6495
      Begin VB.CheckBox chkEchoMode 
         Caption         =   "Echo Mode"
         Enabled         =   0   'False
         Height          =   255
         Left            =   5040
         TabIndex        =   7
         Top             =   360
         Value           =   1  'ﾁｪｯｸ
         Width           =   1215
      End
      Begin VB.TextBox txtSendData 
         Height          =   1095
         Left            =   240
         MultiLine       =   -1  'True
         TabIndex        =   8
         Top             =   720
         Width           =   6015
      End
      Begin VB.CommandButton cmdSend 
         Caption         =   "Send"
         Enabled         =   0   'False
         Height          =   375
         Left            =   4920
         TabIndex        =   9
         Top             =   1920
         Width           =   1335
      End
      Begin VB.Label Label3 
         Caption         =   "Data:"
         Height          =   255
         Left            =   240
         TabIndex        =   15
         Top             =   480
         Width           =   1335
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Connect"
      Height          =   1695
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   6495
      Begin VB.TextBox txtTimeout 
         Height          =   270
         Left            =   1320
         TabIndex        =   4
         Text            =   "500"
         Top             =   1320
         Width           =   3285
      End
      Begin VB.TextBox txtEthOpt 
         Height          =   270
         Left            =   1320
         TabIndex        =   3
         Text            =   "0:5"
         Top             =   960
         Width           =   3285
      End
      Begin VB.TextBox txtPacOpt 
         Height          =   270
         Left            =   1320
         TabIndex        =   2
         Text            =   "12:0:0"
         Top             =   600
         Width           =   3285
      End
      Begin VB.CommandButton cmdConnect 
         Caption         =   "Connect"
         Height          =   375
         Left            =   4830
         TabIndex        =   5
         Top             =   240
         Width           =   1455
      End
      Begin VB.CommandButton cmdDisconnect 
         Caption         =   "Disconnect"
         Enabled         =   0   'False
         Height          =   375
         Left            =   4830
         TabIndex        =   6
         Top             =   720
         Width           =   1455
      End
      Begin VB.ComboBox cmbConn 
         Height          =   300
         ItemData        =   "Chat.frx":0000
         Left            =   1320
         List            =   "Chat.frx":000A
         TabIndex        =   1
         Top             =   240
         Width           =   3285
      End
      Begin VB.Label Label7 
         Alignment       =   1  '右揃え
         Caption         =   "TimeOut :"
         Height          =   255
         Left            =   240
         TabIndex        =   22
         Top             =   1320
         Width           =   975
      End
      Begin VB.Label Label6 
         Alignment       =   1  '右揃え
         Caption         =   "EtherOpt :"
         Height          =   255
         Left            =   240
         TabIndex        =   21
         Top             =   960
         Width           =   975
      End
      Begin VB.Label Label1 
         Alignment       =   1  '右揃え
         Caption         =   "PacketOpt :"
         Height          =   255
         Left            =   240
         TabIndex        =   20
         Top             =   600
         Width           =   975
      End
      Begin VB.Label Label2 
         Alignment       =   1  '右揃え
         Caption         =   "Conn :"
         Height          =   255
         Left            =   240
         TabIndex        =   13
         Top             =   240
         Width           =   975
      End
   End
End
Attribute VB_Name = "frmChat"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private caoEng As CaoEngine
Private caoWS As CaoWorkspace
Private WithEvents caoCtrl As CaoController
Attribute caoCtrl.VB_VarHelpID = -1
Private caoMess As CaoMessage

Private bSrverMode As Boolean
Private bUniTrans As Boolean
Private bBinary As Boolean


Private Sub chkEchoMode_Click()
    
    If chkEchoMode.Value = 1 Then
        cmdSend.Enabled = False
    Else
        cmdSend.Enabled = True
    End If
        
End Sub

' ----------------------------------------------------
' 接続処理
Private Sub cmdConnect_Click()
    
    On Error GoTo ResetCao
    Set caoWS = caoEng.Workspaces(0)
    
    On Error GoTo ErrProc
    
    Dim strOption As String
    strOption = "Conn=" & cmbConn.Text
    strOption = strOption & ",PacketOpt=" & txtPacOpt.Text
    strOption = strOption & ",EtherOpt=" & txtEthOpt.Text
    strOption = strOption & ",TimeOut=" & txtTimeout.Text
    
    Set caoCtrl = caoWS.AddController("StreamTest", "CaoProv.DNWA.STREAM", "", strOption)
    
    ' 通信モードの取得
    Dim strConn As String
    
    Dim OptionArray() As String
    Dim vntTemp As Variant
    Dim arrayTemp() As String
    Dim strDevice As String
    
    bSrverMode = False
    
    ' デバイス種別のチェック
    arrayTemp = Split(cmbConn.Text, ":")
    If UBound(arrayTemp) <> -1 Then
        strDevice = arrayTemp(0)
    End If
    
    arrayTemp = Split(txtPacOpt.Text, ":")
    If UBound(arrayTemp) <> -1 Then
        ' Unicode変換のチェック
        If Val(arrayTemp(0)) And &H4 Then
            bUniTrans = True
        Else
            bUniTrans = False
        End If
    
        ' バイナリモードのチェック
        If Val(arrayTemp(0)) And &H8 Then
            bBinary = False
        Else
            bBinary = True
        End If
    End If
    
    ' サーバモードのチェック
    arrayTemp = Split(txtEthOpt.Text, ":")
    If UBound(arrayTemp) <> -1 Then
        If Val(arrayTemp(0)) = 1 Or Val(arrayTemp(0)) = 3 Then
            bSrverMode = True
        End If
    End If
    
       
    ' 画面の設定
    cmdConnect.Enabled = False
    cmdDisconnect.Enabled = True
    cmbConn.Enabled = False
    txtPacOpt.Enabled = False
    txtEthOpt.Enabled = False
    txtTimeout.Enabled = False
        
    ' EchoModeチェックボックスの設定
    If strDevice = "eth" And bSrverMode = True Then
        bSrverMode = True
        chkEchoMode.Enabled = True
        cmdSend.Enabled = False         ' サーバモードではSendボタンはメッセージを受信してから使用可にする
    Else
        bSrverMode = False
        chkEchoMode.Enabled = False
        cmdSend.Enabled = True
    End If
        
    Exit Sub
    
ErrProc:
    MsgBox Err.Number & vbCrLf & Err.Description
    Exit Sub
    
ResetCao:
    Set caoEng = Nothing
    Set caoWS = Nothing
    Set caoCtrl = Nothing
    Set caoMess = Nothing
    Set caoEng = New CaoEngine
    Set caoWS = caoEng.Workspaces(0)
    Resume Next
End Sub

' ----------------------------------------------------
' 切断処理
Private Sub cmdDisconnect_Click()

    If (caoCtrl Is Nothing) Then Exit Sub
    
    On Error GoTo ResetCao
    caoWS.Controllers.Remove caoCtrl.Index
    On Error GoTo 0
    
    Set caoCtrl = Nothing
    Set caoMess = Nothing
    
    ' 画面の設定
    cmdConnect.Enabled = True
    cmdDisconnect.Enabled = False
    cmbConn.Enabled = True
    txtPacOpt.Enabled = True
    txtEthOpt.Enabled = True
    txtTimeout.Enabled = True
        
    chkEchoMode.Enabled = False
    cmdSend.Enabled = False
    
    Exit Sub
    
ResetCao:
    Set caoEng = Nothing
    Set caoWS = Nothing
    Set caoCtrl = Nothing
    Set caoMess = Nothing
    Set caoEng = New CaoEngine
    Set caoWS = caoEng.Workspaces(0)
    Resume Next
    
End Sub

' ----------------------------------------------------
' 送信
Private Sub cmdSend_Click()
On Error GoTo ErrProc

    Dim vntSend As Variant
    
    If bBinary = True Then          ' バイナリモード（バイト配列）
        Dim RacData As RacRes
        Dim strTemp As String
        
        Set RacData = New RacRes
        strTemp = CStr(vbArray + vbByte) & "," & txtSendData.Text
        vntSend = RacData.VariantFromBstr(strTemp)
    Else                             'テキストモード（文字列）
        vntSend = txtSendData.Text
        
        ' ASCII変換
        If bUniTrans = False Then
            vntSend = StrConv(vntSend, vbFromUnicode)
        End If
    End If
    

    ' サーバモードのとき
    If bSrverMode Then
        caoMess.Reply vntSend
        
    ' それ以外のとき
    Else
        caoCtrl.Execute "send", vntSend
    End If
     
    Exit Sub
ErrProc:
    MsgBox Err.Number & vbCrLf & Err.Description
End Sub

Private Sub Form_Load()

    Set caoEng = New CaoEngine

    ' 初期値の設定
    cmbConn.ListIndex = 0
   
    bUniTrans = True

    On Error GoTo CommandLineErrProc
    
    Dim strCommand As String
    strCommand = Command()
    
    Dim vntCommands As Variant
    vntCommands = Split(strCommand, ";")

    Dim vntCommand As Variant
    For Each vntCommand In vntCommands
        Dim vntItem As Variant
        vntItem = Split(vntCommand, "=")
        Select Case Trim(LCase(vntItem(0)))
        Case "conn"
            cmbConn.Text = Trim(vntItem(1))
        Case "packet", "pac", "pacopt"
            txtPacOpt.Text = Trim(vntItem(1))
        Case "ether", "eth", "ethopt"
            txtEthOpt.Text = Trim(vntItem(1))
        Case "timeout", "to"
            txtTimeout.Text = Trim(vntItem(1))
        End Select
    Next

CommandLineEnd:
    
    Exit Sub

CommandLineErrProc:
    Resume CommandLineEnd

End Sub

Private Sub Form_Unload(Cancel As Integer)

    cmdDisconnect_Click

End Sub

Private Sub caoCtrl_OnMessage(ByVal pICaoMess As CAOLib.ICaoMessage)
On Error GoTo ErrProc

    Select Case pICaoMess.Number
    Case 1 ' DATA
        Dim strRet As String
    
        If bBinary = True Then          ' バイナリモード（バイト配列）
            Dim RacData As RacRes
            Dim strTemp As String

            Set RacData = New RacRes
            strRet = RacData.BstrFromVariant(pICaoMess.Value, 1)
        
        Else                             'テキストモード（文字列）
            If bUniTrans = False Then
                strRet = StrConv(pICaoMess.Value, vbUnicode)
            Else
                strRet = pICaoMess.Value
            End If
        End If
        
        lblResponse.Caption = CStr(pICaoMess.DateTime) & " " & CStr(strRet)
        txtReceiveData.Text = txtReceiveData.Text + strRet + vbCrLf
        
        ' Echoモードのときは同じ内容を返信
        If chkEchoMode.Enabled = True And chkEchoMode.Value = 1 Then
            pICaoMess.Reply pICaoMess.Value
            
        Else
            Set caoMess = pICaoMess     ' メッセージの保存
            cmdSend.Enabled = True
            
        End If
        
    Case 2  ' error
        MsgBox pICaoMess.Value
    End Select
    
    Exit Sub
    
ErrProc:
    MsgBox Err.Number & vbCrLf & Err.Description
End Sub

Private Sub cmdClear_Click()

    txtReceiveData.Text = ""

End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub