frmpc.frm

上位机的命令编辑和执行器

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmPC 
   Caption         =   "局域网通信"
   ClientHeight    =   5925
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7470
   LinkTopic       =   "Form1"
   ScaleHeight     =   5925
   ScaleWidth      =   7470
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   4920
      Top             =   2160
   End
   Begin MSWinsockLib.Winsock Sockclient 
      Left            =   3480
      Top             =   2160
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      RemotePort      =   1002
      LocalPort       =   1001
   End
   Begin MSWinsockLib.Winsock Sockserver 
      Left            =   2400
      Top             =   2160
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      RemotePort      =   1002
      LocalPort       =   1001
   End
   Begin VB.CommandButton Cmd_connect 
      Caption         =   "连接"
      Height          =   375
      Left            =   6240
      TabIndex        =   9
      Top             =   4800
      Width           =   855
   End
   Begin VB.TextBox txt_ip 
      Height          =   375
      Left            =   2040
      TabIndex        =   8
      Top             =   4800
      Width           =   3975
   End
   Begin VB.CommandButton Cmd_quit 
      Caption         =   "退出"
      Height          =   375
      Left            =   5880
      TabIndex        =   7
      Top             =   4200
      Width           =   855
   End
   Begin VB.CommandButton Cmd_end 
      Caption         =   "中止"
      Height          =   375
      Left            =   3360
      TabIndex        =   6
      Top             =   4200
      Width           =   855
   End
   Begin VB.CommandButton cmd_send 
      Caption         =   "发送"
      Height          =   375
      Left            =   600
      TabIndex        =   5
      Top             =   4200
      Width           =   855
   End
   Begin VB.TextBox Tex_get 
      Height          =   1335
      Left            =   480
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   4
      Top             =   2640
      Width           =   6615
   End
   Begin VB.TextBox Txt_send 
      Height          =   1575
      Left            =   480
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Top             =   480
      Width           =   6615
   End
   Begin VB.Label StatusBar2 
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   3720
      TabIndex        =   11
      Top             =   5400
      Width           =   2655
   End
   Begin VB.Label StatusBar1 
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   720
      TabIndex        =   10
      Top             =   5400
      Width           =   2535
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "对方IP和计算机名"
      Height          =   195
      Left            =   360
      TabIndex        =   2
      Top             =   4920
      Width           =   1410
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "收到消息"
      Height          =   195
      Left            =   480
      TabIndex        =   1
      Top             =   2280
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "发送消息"
      Height          =   195
      Left            =   480
      TabIndex        =   0
      Top             =   120
      Width           =   720
   End
End
Attribute VB_Name = "frmPC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command2_Click()

End Sub

Private Sub Cmd_connect_Click()
   '取得远端机IP，并请求连接
   Sockclient.RemoteHost = txt_ip.Text
   Sockclient.Connect
End Sub

Private Sub Cmd_end_Click()
    '发送退出请求,由服务器关闭
    Sockclient.SendData "~quit~"
End Sub

Private Sub Cmd_quit_Click()
  Unload frmPC
End Sub

Private Sub cmd_send_Click()
   '发送文本
   Dim MySendData As String
   MySendData = Txt_send.Text
   Sockclient.SendData MySendData
   Txt_send.Text = ""
End Sub

Private Sub Form_Load()
   '服务器开始监听
   Sockserver.Listen
End Sub

Private Sub Sockclient_Close()
   '激活连接按钮
   Cmd_connect.Enabled = True
   Txt_send.Text = ""
   Txt_get.Text = ""
End Sub

Private Sub Sockclient_Connect()
   MsgBox "连接成功", vbInformation, "ok!"
   '是连接按钮无效，避免错误
   Cmd_connect.Enabled = False
End Sub

Private Sub Sockclient_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)
    '出错后关闭
    Sockclient.Close
End Sub

Private Sub Sockserver_Close()
    Cmd_connect.Enabled = True
End Sub

Private Sub Sockserver_ConnectionRequest(ByVal requestID As Long)
    '判断服务器不关闭时接受连接请求
    If Sockserver.State <> sckClosed Then Sockserver.Close
       Sockserver.Accept requestID
End Sub

Private Sub Sockserver_DataArrival(ByVal bytesTotal As Long)
    Dim MyGetData As String
    '得到数据
    Sockserver.GetData MyGetData
    If MyGetData = "~quit~" Then
       Sockserver.Close
       Sockserver.Listen
    End If
    Txt_get.Text = Txt_get.Text & Chr(13) & Chr(10) & MyGetData
End Sub

Private Sub Tex_send_KeyPress(KeyAscii As Integer)
   '发现按下回车键时就发送文件
   If KeyAscii = 13 Then
   cmd_send_Click
   End If
End Sub

Private Sub Timer1_Timer()
    '不断的监控服务器和客户端状态,可以添加判断更多的状态
   Select Case Sockclient.State
      Case 0: StatusBar2.Caption = "客户端关闭"
      Case 1: StatusBar2.Caption = "客户端打开"
      Case 7: StatusBar2.Caption = "客户端已经连接"
   End Select
   Select Case Sockserver.State
      Case 0: StatusBar1.Caption = "服务器关闭"
      Case 2: StatusBar1.Caption = "服务器侦听"
      Case 7: StatusBar1.Caption = "服务器已经连接"
   End Select
End Sub