form_multitcp.frm

VB库存管理系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Frm_MultiTCP 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "堆垛机"
   ClientHeight    =   3585
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4320
   Icon            =   "Form_MultiTCP.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3585
   ScaleWidth      =   4320
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "接受到的信息:"
      Height          =   3015
      Left            =   120
      TabIndex        =   1
      Top             =   120
      Width           =   4095
      Begin VB.TextBox Text2 
         Height          =   2415
         Left            =   120
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   2
         Top             =   360
         Width           =   3855
      End
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   2000
      Left            =   3480
      Top             =   600
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   0
      ToolTipText     =   "fdsaf"
      Top             =   3210
      Width           =   4320
      _ExtentX        =   7620
      _ExtentY        =   661
      Style           =   1
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin MSWinsockLib.Winsock WSK_Server 
      Index           =   0
      Left            =   3600
      Top             =   360
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
End
Attribute VB_Name = "Frm_MultiTCP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim GetData As String
Dim SendData As String
Private Type ServerInfo
SVStatus As Integer
SVInfo As String
End Type
Dim ClientNum As Integer

'Private Sub Command1_Click()
'Dim i As Integer
'
'    For i = 1 To ClientNum
'        If Not WSK_Server(i) Is Nothing Then
'            DoEvents
'            WSK_Server(i).SendData "服务器:" & Text1.Text
'        End If
'    Next
'End Sub

Private Sub Form_Load()
    Me.Enabled = False
    Me.Top = 1500
    Me.Left = 1500 + 4680
    WSK_Server(0).LocalPort = 1001
    '程序启动时侦听
    WSK_Server(0).Listen
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Call WSK_Server_Close(Index)
Unload Me
End Sub

Private Sub Timer1_Timer()
'MsgBox "堆剁机收到:" + GetData
Timer1.Enabled = False
Select Case GetData
Case "TC接通电源要求启动"
SendData = "1StepOK"
Case "系统开始指令"
SendData = "2StepOK"
Case "系统开始完上报"
SendData = "3StepOK"
'(1)存货
'SendData = "3Step(Stock)OK"
Case "存货开始指令"
SendData = "4Step(Stock)OK"
Case "存货开始完了指令"
SendData = "5Step(Stock)OK"
'(2)取货
'SendData = "3Step(Get)OK"
Case "取货开始指令"
SendData = "4Step(Get)OK"
Case "取货开始完了指令"
SendData = "5Step(Get)OK"

End Select
Dim i As Integer
For i = 1 To ClientNum
  If Not WSK_Server(i) Is Nothing Then
    DoEvents
    WSK_Server(i).SendData SendData
  End If
Next
End Sub

Private Sub WSK_Server_Close(Index As Integer)
On Error GoTo next1
    WSK_Server(Index).Close
'    Set WSK_Server(Index) = Nothing
    Unload Me
    Exit Sub
next1:
   MsgBox "主机已关闭", vbOKOnly, "提示"
   Unload Me
End Sub

Private Sub WSK_Server_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    ClientNum = ClientNum + 1
    Load WSK_Server(ClientNum)  '载入一个新的socket控件
    
    WSK_Server(ClientNum).Accept requestID  '接受客户端的请求
    
    WSK_Server(ClientNum).SendData "堆剁机:准备就绪！！"
    Text2.Text = Text2.Text + "主机:成功连接" + vbCrLf
End Sub

Private Sub WSK_Server_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'Dim myData As String
'
'    WSK_Server(Index).GetData myData
'    Text2.Text = Text2.Text + myData + vbCrLf

WSK_Server(Index).GetData GetData
Text2.Text = Text2.Text + "主机:" + GetData + vbCrLf
Timer1.Enabled = True
    
End Sub

Private Sub WSK_Server_Error(Index As Integer, 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)
    WSK_Server(Index).Close
'    Set WSK_Server(Index) = Nothing
End Sub