VERSION 5.00
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmTcpipDemo 
   Caption         =   "TCP/IP DEMO"
   ClientHeight    =   6090
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6285
   Icon            =   "TcpipDemo.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6090
   ScaleWidth      =   6285
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdServer 
      Caption         =   "&Start"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   500
      Left            =   4817
      TabIndex        =   9
      Top             =   500
      Width           =   1200
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   5207
      Top             =   1050
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.TextBox txtRemoteIP 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   2000
      Locked          =   -1  'True
      TabIndex        =   4
      Top             =   850
      Width           =   2400
   End
   Begin VB.TextBox txtRemotePort 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   2000
      Locked          =   -1  'True
      TabIndex        =   6
      Top             =   1400
      Width           =   2400
   End
   Begin VB.TextBox txtLocalPort 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   360
      Left            =   2000
      TabIndex        =   2
      Top             =   250
      Width           =   2400
   End
   Begin VB.TextBox txtDescription 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   2000
      Locked          =   -1  'True
      TabIndex        =   8
      Top             =   1900
      Width           =   2400
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "&Exit"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   500
      Left            =   4817
      TabIndex        =   10
      Top             =   1550
      Width           =   1200
   End
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   330
      Left            =   237
      Top             =   2250
      Visible         =   0   'False
      Width           =   5780
      _ExtentX        =   10186
      _ExtentY        =   582
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin MSDataGridLib.DataGrid DataGrid1 
      Height          =   3250
      Left            =   237
      TabIndex        =   0
      Top             =   2550
      Width           =   5780
      _ExtentX        =   10186
      _ExtentY        =   5741
      _Version        =   393216
      AllowUpdate     =   0   'False
      HeadLines       =   1
      RowHeight       =   19
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ColumnCount     =   2
      BeginProperty Column00 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1028
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1028
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
         EndProperty
         BeginProperty Column01 
         EndProperty
      EndProperty
   End
   Begin VB.Label lblDescription 
      AutoSize        =   -1  'True
      Caption         =   "&Comm Status : "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   240
      TabIndex        =   7
      Top             =   1905
      Width           =   1545
   End
   Begin VB.Label lblLocalPort 
      AutoSize        =   -1  'True
      Caption         =   "&Local Port : "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   237
      TabIndex        =   1
      Top             =   315
      Width           =   1245
   End
   Begin VB.Label lblRemotePort 
      AutoSize        =   -1  'True
      Caption         =   "Remote &Port : "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   237
      TabIndex        =   5
      Top             =   1400
      Width           =   1485
   End
   Begin VB.Label lblRemoteIP 
      AutoSize        =   -1  'True
      Caption         =   "Remote &IP : "
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   237
      TabIndex        =   3
      Top             =   850
      Width           =   1275
   End
End
Attribute VB_Name = "frmTcpipDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const strStop As String = "&Stop"
Const strStart As String = "&Start"

Dim strReceive As String

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdServer_Click()
    If cmdServer.Caption = strStart Then
        txtLocalPort.Locked = True
        cmdServer.Caption = strStop
        Winsock1.Protocol = sckTCPProtocol
        Winsock1.LocalPort = CStr(txtLocalPort.Text)
        Winsock1.RemotePort = 0
        Winsock1.Listen
    Else
        txtRemoteIP.Text = ""
        txtRemotePort.Text = ""
        txtLocalPort.Locked = False
        cmdServer.Caption = strStart
        txtDescription.Text = "Server Close."
        If Winsock1.State <> sckClosed Then Winsock1.Close
    End If
End Sub

Private Sub Form_Load()
    Me.Caption = "TCP/IP Demo version " & App.Major & "." & App.Minor & App.Revision
    
    Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                              "Data Source=" & App.Path & "\TcpipDemo.mdb;" & _
                              "Persist Security Info=False"
    Adodc1.CommandType = adCmdTable
    Adodc1.RecordSource = "TcpipDemo"
    Adodc1.Refresh
        
    Set DataGrid1.DataSource = Adodc1
    DataGrid1.MarqueeStyle = dbgHighlightRow
    DataGrid1.Refresh

    txtLocalPort.Text = 1024
    txtRemoteIP.Text = ""
    txtRemotePort.Text = ""
    txtDescription.Text = ""
    
    cmdServer.Caption = strStart
End Sub

Private Sub Form_Paint()
    DataGrid1.SetFocus
End Sub

Private Sub Winsock1_Close()
    Winsock1.Close
    txtRemoteIP.Text = ""
    txtRemotePort.Text = ""
    txtDescription.Text = "Remote Close."

    Winsock1.Protocol = sckTCPProtocol
    Winsock1.LocalPort = CStr(txtLocalPort.Text)
    Winsock1.RemotePort = 0
    Winsock1.Listen
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    If Winsock1.State <> sckClosed Then Winsock1.Close

    Winsock1.Accept requestID

    If Winsock1.State = sckConnected Then
        txtDescription.Text = ""
        txtRemoteIP = CStr(Winsock1.RemoteHostIP)
        txtRemotePort = CStr(Winsock1.RemotePort)
    End If
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim bytReceive() As Byte
    Dim intLen As Integer, i As Integer, j As Integer

    intLen = Winsock1.BytesReceived
    Winsock1.GetData bytReceive, vbByte

    For i = 0 To Abs(intLen - 1)
        If bytReceive(i) = 13 Then
            Call Parse(strReceive)
            strReceive = ""
        Else
            strReceive = strReceive & Chr(bytReceive(i))
        End If
    Next i
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    Winsock1.Close
    cmdServer.Caption = strStart
    txtLocalPort.Locked = False

    txtRemoteIP.Text = ""
    txtRemotePort.Text = ""
    txtDescription.Text = Description
End Sub

Private Function Parse(ByVal strCommand As String)
    Dim strHead As String * 1
    Dim strData As String

    strHead = Left(strCommand, 1)
    strData = Mid(strCommand, 2, Abs(Len(strCommand) - 1))
    
    If strHead = "I" Then
        Call Receive_Query_Item(strData)
    ElseIf strHead = "Q" Then
        Call Receive_Qty_Update(strData)
    End If
End Function

Private Sub Receive_Query_Item(ByVal strData As String)
    Dim strSend As String

    Adodc1.Recordset.MoveFirst
    Adodc1.Recordset.Find "ITEM" & " = " & strData
    
    If Adodc1.Recordset.EOF Then
        Adodc1.Recordset.MoveLast
        Adodc1.Recordset.MoveNext
        txtDescription.Text = "Data not found !!"
        strSend = "N"
    Else
        txtDescription.Text = "Found Data !!"
        strSend = "D" & Adodc1.Recordset.Fields("NAME").Value & "," & _
                        Adodc1.Recordset.Fields("QTY").Value
    End If
    
    DataGrid1.SetFocus
    DataGrid1.Refresh
    
    If Winsock1.State = sckConnected Then
        Winsock1.SendData strSend & vbCr
        DoEvents
    End If
End Sub

Private Sub Receive_Qty_Update(ByVal strData As String)
    Dim strItem As String, strQty As String, strSend As String
    Dim intLen As Integer, i As Integer

    intLen = Len(strData)
    For i = 1 To intLen
        If Mid(strData, i, 1) = "," Then
            strItem = Left(strData, Abs(i - 1))
            strQty = Mid(strData, i + 1, Abs(intLen - i))
        End If
    Next i

    If strItem = "" Then Exit Sub
    If strQty = "" Then strQty = "0"
    
    Adodc1.Recordset.MoveFirst
    Adodc1.Recordset.Find "ITEM" & " = " & strItem
        
    If Adodc1.Recordset.EOF Then
        Adodc1.Recordset.MoveLast
        Adodc1.Recordset.MoveNext
        txtDescription.Text = "Update NG !!"
        strSend = "U" & "NG"
    Else
        Adodc1.Recordset.Fields("QTY").Value = strQty
        Adodc1.Recordset.Update
        txtDescription.Text = "Update OK !!"
        strSend = "U" & "OK"
    End If
        
    DataGrid1.SetFocus
    DataGrid1.Refresh
    
    If Winsock1.State = sckConnected Then
        Winsock1.SendData strSend & vbCr
        DoEvents
    End If
End Sub
