frm_rs.frm

用VB的Socket控件编TCPServer程序

VERSION 5.00
Begin VB.Form frm_rs 
   Caption         =   "Form1"
   ClientHeight    =   8205
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6750
   LinkTopic       =   "Form1"
   ScaleHeight     =   8205
   ScaleWidth      =   6750
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton cmd_stop 
      Caption         =   "停止(&S)"
      Height          =   330
      Left            =   360
      TabIndex        =   16
      Top             =   7560
      Width           =   1100
   End
   Begin VB.CommandButton cmd_rsum 
      Caption         =   "重新计数"
      Height          =   330
      Left            =   1800
      TabIndex        =   15
      Top             =   7560
      Width           =   1100
   End
   Begin VB.Timer timer_poll 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   5640
      Top             =   7680
   End
   Begin VB.CommandButton cmd_exit 
      Caption         =   "退出(&X)"
      Height          =   330
      Left            =   4440
      TabIndex        =   4
      Top             =   7560
      Width           =   1100
   End
   Begin VB.CommandButton cmd_dis 
      Caption         =   "断开(&C)"
      Height          =   330
      Left            =   3120
      TabIndex        =   3
      Top             =   7560
      Width           =   1100
   End
   Begin VB.Frame Frame3 
      Caption         =   "统计"
      Height          =   550
      Left            =   120
      TabIndex        =   2
      Top             =   6960
      Width           =   5800
      Begin VB.Label lbl_diu 
         AutoSize        =   -1  'True
         Caption         =   "Label800"
         Height          =   180
         Left            =   4920
         TabIndex        =   14
         Top             =   240
         Width           =   720
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "发包;"
         Height          =   180
         Left            =   4440
         TabIndex        =   13
         Top             =   240
         Width           =   450
      End
      Begin VB.Label lbl_wuma 
         AutoSize        =   -1  'True
         Caption         =   "Label600"
         Height          =   180
         Left            =   3480
         TabIndex        =   12
         Top             =   240
         Width           =   720
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "收包:"
         Height          =   180
         Left            =   3000
         TabIndex        =   11
         Top             =   240
         Width           =   405
      End
      Begin VB.Label lbl_rev 
         AutoSize        =   -1  'True
         Caption         =   "Label400"
         Height          =   180
         Left            =   2040
         TabIndex        =   10
         Top             =   240
         Width           =   720
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "接收:"
         Height          =   180
         Left            =   1560
         TabIndex        =   9
         Top             =   240
         Width           =   450
      End
      Begin VB.Label lbl_send 
         AutoSize        =   -1  'True
         Caption         =   "Label200"
         Height          =   180
         Left            =   600
         TabIndex        =   8
         Top             =   240
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "发送:"
         Height          =   180
         Left            =   120
         TabIndex        =   7
         Top             =   240
         Width           =   450
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "接收"
      Height          =   3135
      Left            =   40
      TabIndex        =   1
      Top             =   3720
      Width           =   5800
      Begin VB.TextBox txt_rec 
         Height          =   2730
         Left            =   120
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   6
         Text            =   "frm_rs.frx":0000
         Top             =   240
         Width           =   5600
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "发送"
      Height          =   3375
      Left            =   40
      TabIndex        =   0
      Top             =   120
      Width           =   5800
      Begin VB.TextBox txt_send 
         Height          =   3090
         Left            =   120
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   5
         Text            =   "frm_rs.frx":00BA
         Top             =   120
         Width           =   5600
      End
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Label600"
      Height          =   180
      Left            =   6000
      TabIndex        =   17
      Top             =   6600
      Width           =   720
   End
End
Attribute VB_Name = "frm_rs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim send_data(256) As Byte

Private Sub cmd_dis_Click()
    frm_connect.winsck.Close
    frm_connect.cmd_ok.Enabled = True
    frm_connect.chk_edit.Enabled = True
    frm_connect.Show
    frm_connect.MousePointer = 0
    Unload Me
End Sub

Private Sub cmd_exit_Click()
    End
End Sub

Private Sub cmd_rsum_Click()
    lbl_send.Caption = "0"
    lbl_rev.Caption = "0"
    lbl_wuma.Caption = "0"
    lbl_diu.Caption = "0"
End Sub

Private Sub cmd_stop_Click()
    If cmd_stop.Caption = "停止(&S)" Then
        timer_poll.Enabled = False
        cmd_stop.Caption = "开始(&B)"
    ElseIf cmd_stop.Caption = "开始(&B)" Then
        timer_poll.Enabled = True
        cmd_stop.Caption = "停止(&S)"
    End If
End Sub

Private Sub Form_Load()
    create_send_data
    lbl_send.Caption = "0"
    lbl_rev.Caption = "0"
    lbl_wuma.Caption = "0"
    lbl_diu.Caption = "0"
    txt_send = ""
    txt_rec = ""
    timer_poll.Enabled = True
End Sub

'*
'*创建发送数据  send_data(0 To 12) , receive_data(0 To 12)
'*
Public Sub create_send_data()
Dim sum As Long, i As Integer
    'send_data(0) = 255
    For i = 0 To 255
        send_data(i) = i
    Next
End Sub

Private Sub timer_poll_Timer()
Dim i As Integer
    If timer_poll.Tag = "S" Then
        lbl_diu.Caption = CStr(CInt(lbl_diu.Caption) + 1)
    ElseIf timer_poll.Tag = "R" Then
        'lbl_rev.Caption = CStr(CInt(lbl_rev.Caption) + 1)
    End If
    '发送数据
    If frm_connect.winsck.State = 7 Then
    For i = 0 To 255
        frm_connect.winsck.SendData send_data(i)
    Next
        
'        frm_connect.winsck.SendData send_data
        lbl_send.Caption = CStr(CLng(lbl_send.Caption) + 256)
        timer_poll.Tag = "S"
        '送显
        txt_send = ""
        For i = 0 To 255
            'txt_send = txt_send + Format(Hex(send_data(i)), "00") + " "
            txt_send = txt_send + Hex(send_data(i)) + " "
        Next
        txt_send = txt_send + vbCrLf
    ElseIf frm_connect.winsck.State <> 7 Then
        MsgBox "与串口服务器连接断开.", vbOKOnly + vbCritical, "Disconnected"
        timer_poll.Enabled = False
        frm_connect.cmd_ok.Enabled = True
        frm_connect.chk_edit.Enabled = True
        Unload Me
        frm_connect.Show
        frm_connect.MousePointer = 0
        
    End If

End Sub