frmserver.frm

该软件用于网络聊天 或人机互动

      TabIndex        =   5
      Top             =   720
      Width           =   1500
   End
   Begin VB.Label Label1 
      Caption         =   "服务器地址"
      BeginProperty Font 
         Name            =   "幼圆"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   75
      TabIndex        =   4
      Top             =   750
      Width           =   3240
   End
   Begin VB.Menu mnuSystem 
      Caption         =   "系统"
      Begin VB.Menu mnuBreak 
         Caption         =   "断开连接"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu mnuMissage 
      Caption         =   "消息"
      Begin VB.Menu mnuSend 
         Caption         =   "发送消息"
      End
      Begin VB.Menu mnuList 
         Caption         =   "客户列表"
      End
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件"
      Begin VB.Menu mnuOpen 
         Caption         =   "打开"
      End
      Begin VB.Menu mnuSave 
         Caption         =   "保存"
      End
   End
End
Attribute VB_Name = "frmServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Num As Integer
Dim flag As Boolean
'Dim member(1 To 10) As Integer
Dim NumOnline As Integer
Dim clientName(1 To 5)




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)

End Sub

Private Sub cmdLogin_Click()
Load frmServerLogIn
frmServerLogIn.Show
End Sub

Private Sub Command1_Click()

End Sub

Private Sub cmdExit_Click()

End Sub

Private Sub Form_Load()
StatusBar1.Panels(1).Text = "Now there is nobody connected"
Num = 0
NumOnline = 0
tcpServer(0).LocalPort = 5000
tcpServer(0).Listen
Label1.Caption = Label1.Caption + CStr(tcpServer(0).LocalIP)
Label3.Caption = Label3.Caption + CStr(tcpServer(0).LocalPort)


End Sub

Private Sub mnuBreak_Click()
For i = 1 To Num
    tcpServer(i).Close
    
    Next i
    
End Sub

Private Sub mnuExit_Click()
    
    response = MsgBox("要保存文件后再退出吗?", vbYesNo, "退出")
        If response = vbYes Then
         CommonDialog1.ShowSave
      rtbSave.SaveFile (CommonDialog1.FileName)
          End If
          End
End Sub

Private Sub mnuList_Click()
mnuList.Checked = Not mnuList.Checked
If mnuList.Checked Then
Toolbar1.Buttons("List").Value = tbrPressed
  Me.lstClient.ForeColor = RGB(0, 0, 0)
Else
Toolbar1.Buttons("List").Value = tbrUnpressed
 Me.lstClient.ForeColor = Me.lstClient.BackColor
End If


End Sub

Private Sub mnuOpen_Click()
 CommonDialog1.ShowOpen
        Load frmInspect
        
        frmInspect.rtbOpen.LoadFile (CommonDialog1.FileName)
        'frmInspect.rtbOpen.Visible = True
        frmInspect.Show
End Sub

Private Sub mnuSave_Click()
 CommonDialog1.ShowSave
      rtbSave.SaveFile (CommonDialog1.FileName)
End Sub

Private Sub mnuSend_Click()
mnuSend.Checked = Not mnuSend.Checked

TxtSend.Locked = Not TxtSend.Locked

End Sub

Private Sub tcpServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'For i = 1 To Num
'If tcpServer.State <> sckClosed Then tcpServer.Close
'tcpServer(Num - 1).Accept requestID
'Next i
If Index = 0 Then
    Num = Num + 1
    NumOnline = NumOnline + 1
    Load tcpServer(Num)
      StatusBar1.Panels(1).Text = "There are " & NumOnline & "Client connected"
  'member(Num) = 1
     tcpServer(Num).LocalPort = 0
    tcpServer(Num).Accept requestID
  
    
    End If

End Sub

Private Sub tcpServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim sData As String
Dim sName As String

   tcpServer(Index).GetData sData
    'rtbSave.Text = sData
   rtbSave.SelStart = Len(rtbSave.Text)
 
    sName = Left(sData, 1)
If sName = "/" Then
    
    'rtbSave.SelLength = Len(rtbSave.Text)

    lstClient.AddItem sData + CStr(Now())
    tcpServer(Index).SendData "recieved successfully"
    ElseIf sName = "^" Then
    tcpServer(Index).SendData "you can quit."
    lstClient.AddItem sData + CStr(Now())
    'lstClient.RemoveItem -1
  '  member(Index) = 0
    
    tcpServer(Index).Close
    NumOnline = NumOnline - 1
     StatusBar1.Panels(1).Text = "There are " & NumOnline & "Client connected"
    rtbSave.SelStart = Len(rtbSave.Text)
       rtbSave.Text = rtbSave.Text + sData

    
        End If
    'rtbSave.SelStart = Len(rtbSave.Text)
 rtbSave.SelStart = Len(rtbSave.Text)
       rtbSave.Text = rtbSave.Text + sData
     txtout.Text = sData

    rtbSave.SelStart = Len(rtbSave.Text)
    
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)


Select Case Button.Key
   'Case "Connect"
       'cmdConnect_Click
    Case "Open"
        CommonDialog1.ShowOpen
        Load frmInspect
        
        frmInspect.rtbOpen.LoadFile (CommonDialog1.FileName)
        'frmInspect.rtbOpen.Visible = True
        frmInspect.Show
        
    Case "Quit"
          response = MsgBox("要保存文件后再退出吗?", vbYesNo, "退出")
        If response = vbYes Then
         CommonDialog1.ShowSave
      rtbSave.SaveFile (CommonDialog1.FileName)
          End If
          End
    Case "Save"
      CommonDialog1.ShowSave
      rtbSave.SaveFile (CommonDialog1.FileName)
    Case "List"
      mnuList_Click
    
      
End Select

End Sub


Private Sub txtOut_Change()
For i = 1 To Num
   
If tcpServer(i).State <> sckClosed Then
    tcpServer(i).SendData txtout.Text

End If

Next i
End Sub

Private Sub TxtSend_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
    For i = 1 To Num
       ' If member(i) = 0 Then
        '    Exit Sub
        'Else
         If tcpServer(i).State = sckClosed Then
            Exit For
        Else
            tcpServer(i).SendData "server:" & TxtSend.Text
            'rtbSave.Text = rtbSave.Text + TxtSend.Text
        End If
        Next i
        rtbSave.SelStart = Len(rtbSave.Text)
 rtbSave.Text = rtbSave.Text + Chr(10) + TxtSend.Text
TxtSend.Text = ""
End If

End Sub