⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmclient.frm

📁 Cnnects two computers using the very SIMPLE and SMALL visual basic code.
💻 FRM
📖 第 1 页 / 共 2 页
字号:
            BackColor       =   &H00FFFFFF&
            Caption         =   "C"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   9.75
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   -1  'True
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H000000FF&
            Height          =   255
            Left            =   2640
            TabIndex        =   16
            Top             =   240
            Width           =   255
         End
      End
      Begin VB.TextBox txtSend 
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   405
         Left            =   120
         TabIndex        =   2
         Top             =   2880
         Width           =   3135
      End
      Begin VB.TextBox txtOutput 
         BackColor       =   &H00FFFF00&
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   2055
         Left            =   120
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   1
         Top             =   240
         Width           =   3135
      End
      Begin MSWinsockLib.Winsock tcpClient 
         Left            =   120
         Top             =   240
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
      End
   End
End
Attribute VB_Name = "frmClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim HName As Boolean
Dim IfCliName As Boolean
Dim ServerRHName As String


Private Sub cmdClearCli_Click()
   txtOutput.Text = ""
End Sub

Private Sub cmdClearSer_Click()
   txtOutServer.Text = ""
End Sub

Private Sub cmdDisconnect_Click()
  On Error Resume Next
  tcpServer.SendData "!.EX!T.!"
  tcpClient.SendData "!.EX!T.!"
  cmdDisconnect.Visible = False
  cmdConnect.Visible = True
  Listen
End Sub

Private Sub cmdSendCli_Click()
  SendClient
End Sub

Private Sub cmdSendSer_Click()
  SendServer
End Sub

Private Sub Command1_Click()
cmdDisconnect_Click
Unload Me
End Sub

Private Sub Form_Resize()
On Error Resume Next

Frame3.Width = frmClient.Width - 100
Frame1.Width = frmClient.Width - 100
Frame2.Width = frmClient.Width - 100
Frame2.Height = frmClient.Height - Frame2.Top - 400
Frame1.Height = frmClient.Height - Frame1.Top - 400
txtSend.Top = Frame1.Height - 120 - txtSend.Height
txtSendData.Top = Frame2.Height - 120 - txtSendData.Height
txtSend.Width = Frame1.Width - 240
txtSendData.Width = Frame2.Width - 240
Frame4.Top = Frame1.Height - 1150
Frame5.Top = Frame2.Height - 1150
Frame4.Width = Frame1.Width - 240
Frame5.Width = Frame2.Width - 240
txtOutput.Height = Frame1.Height - 1350
txtOutServer.Height = Frame2.Height - 1350
txtOutput.Width = Frame1.Width - 240
txtOutServer.Width = Frame2.Width - 240

End Sub

Private Sub Form_Terminate()
 cmdDisconnect_Click
End Sub

Private Sub tcpServer_ConnectionRequest _
(ByVal requestID As Long)
    
    If tcpServer.State <> sckClosed Then _
    tcpServer.Close
   
    tcpServer.Accept requestID
     
    HName = True
    
    frmClient.WindowState = 0
    
    frmClient.Width = 3510
    frmClient.Height = 4965
    frmClient.SetFocus
    'cmdConnect.Enabled = False
    cmdConnect.Visible = False
    cmdDisconnect.Visible = True
    Frame2.Visible = True
          Frame1.Visible = False
          Frame2.Left = 0
          Frame2.Top = 1080
          
End Sub

Private Sub txtSend_KeyPress(KeyAscii As Integer)
 On Error GoTo ErrPara
 If KeyAscii = 13 Then
  If IfCliName Then
     tcpClient.SendData Format(Len(tcpClient.LocalHostName), "000") & tcpClient.LocalHostName & txtSend.Text
     IfCliName = False
  Else
     tcpClient.SendData txtSend.Text
  End If
  txtOutput.Text = txtOutput.Text & vbCrLf & tcpClient.LocalHostName & " : " & txtSend.Text
  txtOutput.SelLength = Len(txtOutput.Text)
  txtSend.Text = ""
 End If
 Exit Sub
ErrPara:
 MsgBox "ERROR IN SENDING MESSAGE" & vbCrLf & "May be disconnected"
 Listen

End Sub



Private Sub tcpServer_DataArrival _
(ByVal bytesTotal As Long)
    On Error GoTo ErrPara
    
    Dim LenOfName As Integer
    Dim strData As String
    tcpServer.GetData strData
    If InStr(1, strData, "!.EX!T.!") <> 0 Then
      Listen
      cmdConnect.Visible = True
      cmdDisconnect.Visible = False
      Exit Sub
    End If
    
    If HName = True Then
       LenOfName = CInt(Mid(strData, 1, 3))
       ServerRHName = Mid(strData, 4, LenOfName)
       txtOutServer.Text = txtOutServer.Text & vbCrLf & ServerRHName & " #: " & Right(strData, Len(strData) - 3 - LenOfName)
       HName = False
    Else
       txtOutServer.Text = txtOutServer.Text & vbCrLf & ServerRHName & " #: " & strData
    End If
    
    txtOutServer.SelLength = Len(txtOutServer.Text)
    
    frmClient.WindowState = 0
    frmClient.SetFocus
    Exit Sub
ErrPara:
    MsgBox "ERROR IN RECEIVING MESSAGE" & vbCrLf & "Probably you are disconnected"
    Listen
End Sub

Private Sub Form_Load()
    If tcpServer.State <> sckClosed Then _
       tcpServer.Close
    tcpServer.LocalPort = 995
    tcpServer.Listen
    frmClient.Width = 3510
    frmClient.Height = 1515
End Sub

Private Sub cmdConnect_Click()
On Error GoTo ErrPara
    tcpClient.Close
    tcpServer.Close
    tcpClient.RemoteHost = Text1.Text
    tcpClient.RemotePort = 995
    
    ''''''''''Code for server
    tcpServer.LocalPort = 995
    tcpServer.Listen
      
    tcpClient.Connect
       
    frmClient.Width = 3510
    frmClient.Height = 4965
    cmdConnect.Enabled = False
    cmdConnect.Visible = False
    cmdDisconnect.Visible = True
    Frame1.Visible = True
    Frame2.Visible = False
    txtOutServer.Text = ""
    txtOutput.Text = ""
    txtSend.Text = ""
    txtSendData.Text = ""
    
    IfCliName = True
    
    Exit Sub
ErrPara:
     MsgBox "Enter a valid computer name. CONNECTION FAILURE"
     cmdConnect.Visible = True
     cmdConnect.Enabled = True
     cmdDisconnect.Visible = False
End Sub
Private Sub tcpClient_DataArrival _
(ByVal bytesTotal As Long)
    On Error GoTo ErrPara
    Dim strData As String
    tcpClient.GetData strData
    
    If InStr(1, strData, "!.EX!T.!") <> 0 Then
      Listen
      cmdConnect.Visible = True
      cmdDisconnect.Visible = False
      Exit Sub
    End If
    
    txtOutput.Text = txtOutput.Text & vbCrLf & tcpClient.RemoteHost & " #: " & strData
    
    frmClient.WindowState = 0
    frmClient.SetFocus
    
    txtOutput.SelLength = Len(txtOutput.Text)
    Exit Sub
ErrPara:
    MsgBox "ERROR IN REVEIVING MESSAGE" & vbCrLf & "Probably you are disconnected"
    Listen
End Sub
Private Sub txtSendData_KeyPress(KeyAscii As Integer)
 On Error GoTo ErrPara
 
 If KeyAscii = 13 Then
  tcpServer.SendData txtSendData.Text
  txtOutServer.Text = txtOutServer.Text & vbCrLf & tcpServer.LocalHostName & " :" & txtSendData.Text
  txtSendData.Text = ""
  txtOutServer.SelLength = Len(txtOutServer.Text)
 End If
 Exit Sub
ErrPara:
 MsgBox "ERROR IN SENDING MESSAGE" & vbCrLf & "May be disconnected"
 Listen
End Sub

Private Sub Listen()
 If tcpServer.State <> sckClosed Then _
       tcpServer.Close
 tcpServer.LocalPort = 995
 tcpServer.Listen
 cmdConnect.Enabled = True
 frmClient.Width = 3510
 frmClient.Height = 1515
 cmdDisconnect.Visible = False
 cmdConnect.Visible = True
    
End Sub
Private Sub SendClient()
  On Error GoTo ErrPara
  If IfCliName Then
     tcpClient.SendData Format(Len(tcpClient.LocalHostName), "000") & tcpClient.LocalHostName & txtSend.Text
     IfCliName = False
  Else
     tcpClient.SendData txtSend.Text
  End If
  txtOutput.Text = txtOutput.Text & vbCrLf & tcpClient.LocalHostName & " : " & txtSend.Text
  txtOutput.SelLength = Len(txtOutput.Text)
  txtSend.Text = ""
  Exit Sub
ErrPara:
 MsgBox "ERROR IN SENDING MESSAGE" & vbCrLf & "May be disconnected"
 Listen

End Sub
Private Sub SendServer()
  On Error GoTo ErrPara
  tcpServer.SendData txtSendData.Text
  txtOutServer.Text = txtOutServer.Text & vbCrLf & tcpServer.LocalHostName & " :" & txtSendData.Text
  txtSendData.Text = ""
  txtOutServer.SelLength = Len(txtOutServer.Text)
  Exit Sub
ErrPara:
 MsgBox "ERROR IN SENDING MESSAGE" & vbCrLf & "May be disconnected"
 Listen
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -