prjTcpChatSystem - TCP 聊天系统 - SourceCode - VB6 + Winsock - HackerJLY

prjTcpChatSystem - TCP 聊天系统 - SourceCode - VB6 + Winsock - HackerJLY

prjTcpChatSystem.vbp

Type=Exe
Form=frmMain.frm
Reference=*/G{00020430-0000-0000-C000-000000000046}#2.0#0#C:/WINDOWS/system32/stdole2.tlb#OLE Automation
Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; MSWINSCK.OCX
Module=modPub; modPub.bas
IconForm="frmMain"
Startup="frmMain"
ExeName32="prjTcpChatSystem.exe"
Command32=""
Name="prjTcpChatSystem"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="http://blog.csdn.net/HackerJLY"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1

[MS Transaction Server]
AutoRefresh=1

frmMain.frm

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMain
   Caption         =   "prjTcpChatSystem"
   ClientHeight    =   7200
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5115
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   7200
   ScaleWidth      =   5115
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdDisconnect
      Caption         =   "Disconnect"
      Height          =   375
      Left            =   3960
      TabIndex        =   5
      Top             =   120
      Width           =   975
   End
   Begin VB.CommandButton cmdSend
      Caption         =   "Send"
      Height          =   375
      Left            =   3600
      TabIndex        =   4
      Top             =   6480
      Width           =   1215
   End
   Begin VB.CommandButton cmdConnect
      Caption         =   "Connect"
      Height          =   375
      Left            =   2760
      TabIndex        =   3
      Top             =   120
      Width           =   975
   End
   Begin VB.TextBox txtRemoteHostIP
      Height          =   375
      Left            =   120
      TabIndex        =   2
      Text            =   "192.168.1.68"
      Top             =   120
      Width           =   2415
   End
   Begin VB.TextBox txtSend
      Height          =   2535
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   1
      Top             =   3600
      Width           =   4695
   End
   Begin VB.TextBox txtReceive
      Height          =   2535
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   720
      Width           =   4695
   End
   Begin MSWinsockLib.Winsock wsk
      Left            =   120
      Top             =   6360
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdConnect_Click()
    With wsk
        .Close
        .RemoteHost = txtRemoteHostIP
        .RemotePort = 6000
        .Connect
       
'        Sleep 1000
'
'        If .State <> sckConnected Then
'            wsk_Close
'        Else
'            cmdDisconnect.Enabled = True
'        End If
       
        cmdDisconnect.Enabled = True
       
        Me.Caption = "与 " & .RemoteHost & "连接中 - prjTcpChatSystem"

       
    End With
End Sub

Private Sub cmdDisconnect_Click()
    wsk_Close
   
'    Sleep 1000
'
'    With wsk
'        If .State = sckListening Then
'            cmdDisconnect.Enabled = False
'        End If
'    End With
   
End Sub

Private Sub cmdSend_Click()
    With wsk
        If .State <> sckConnected Then
            MsgBox "还未连接，请先连接！"
        Else
            .SendData .LocalHostName & ":" & Date & "_" & Time & vbCrLf & "  " & CStr(txtSend.Text)
            txtSend.Text = ""
        End If
    End With

End Sub

Private Sub Form_DblClick()
    With wsk
        Select Case .State
            Case 0: txtReceive.Text = "wdk关闭" & .LocalIP & "_" & .LocalPort & vbCrLf & txtReceive.Text
            Case 1: txtReceive.Text = "wdk打开 " & .LocalIP & "_" & .LocalPort & vbCrLf & txtReceive.Text
            Case 2: txtReceive.Text = "wdk侦听" & .LocalIP & "_" & .LocalPort & vbCrLf & txtReceive.Text
            Case 3: txtReceive.Text = "wdk连接挂起" & .LocalIP & "_" & .LocalPort & vbCrLf & txtReceive.Text
            Case 4: txtReceive.Text = "wdk正在识别主机" & .LocalIP & "_" & .LocalPort & vbCrLf & txtReceive.Text
            Case 5: txtReceive.Text = "wdk已识别" & vbCrLf & .LocalIP & "_" & .LocalPort & txtReceive.Text
            Case 6: txtReceive.Text = "wdk正在与主机连接" & .LocalIP & "_" & .LocalPort & vbCrLf & txtReceive.Text
            Case 7: txtReceive.Text = "wdk已经连接" & .LocalIP & "_" & .LocalPort & vbCrLf & txtReceive.Text
            Case 8: txtReceive.Text = "wdk同级人员正在关闭连接" & vbCrLf & txtReceive.Text
            Case 9: txtReceive.Text = "wdk错误" & .LocalIP & "_" & .LocalPort & vbCrLf & txtReceive.Text
        End Select
    End With
End Sub

Private Sub Form_Initialize()
    If App.PrevInstance = True Then
        MsgBox "程序已在运行"
        End
    End If
End Sub

Private Sub Form_Load()
   
    cmdDisconnect.Enabled = False
   
    With wsk
       
        .Protocol = sckTCPProtocol
        .LocalPort = 6000
        '.Bind , .LocalIP
        .Listen
       
    End With

End Sub

Private Sub Form_Unload(Cancel As Integer)
    With wsk
        .Close
       
    End With
End Sub

Private Sub wsk_Close()
    With wsk
        .Close
        .Listen
        cmdDisconnect.Enabled = False
        Me.Caption = "prjTcpChatSystem"
    End With
End Sub

Private Sub wsk_ConnectionRequest(ByVal requestID As Long)
    With wsk
        '--------------------------------------------------
        If .State <> sckClosed Then
            .Close
        End If
        '--------------------------------------------------
        .Accept requestID
        '--------------------------------------------------
        .SendData .LocalHostName & ":" & Date & "_" & Time & vbCrLf & "  " & "Welcome " & .RemoteHostIP & " !!!!"
        cmdDisconnect.Enabled = True
        Me.Caption = "与 " & .RemoteHostIP & "连接中 - prjTcpChatSystem"
    End With
   
   
   
End Sub

Private Sub wsk_DataArrival(ByVal bytesTotal As Long)
    Dim strReceive As String
    With wsk
        .GetData strReceive
        txtReceive.Text = strReceive & vbCrLf & vbCrLf & txtReceive.Text  '& vbCrLf & .RemoteHost & .RemoteHostIP & .RemotePort
       
       
    End With

End Sub

Private Sub wsk_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)
    wsk_Close
    Me.Caption = "prjTcpChatSystem"
End Sub

modPub.bas

Attribute VB_Name = "modPub"
Option Explicit

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)