一个简单的点对点聊天程序
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
Caption = "点对点通讯"
ClientHeight = 6330
ClientLeft = 60
ClientTop = 345
ClientWidth = 6855
Icon = "Form1.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6330
ScaleWidth = 6855
StartUpPosition = 2 'CenterScreen
Begin VB.ListBox lstTo
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2460
ItemData = "Form1.frx":030A
Left = 90
List = "Form1.frx":030C
TabIndex = 5
TabStop = 0 'False
Top = 3225
Width = 6675
End
Begin MSWinsockLib.Winsock Winsock1
Left = 6345
Top = 2790
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.CommandButton cmdConnect
Caption = "连接"
Height = 495
Left = 4725
TabIndex = 4
TabStop = 0 'False
Top = 2655
Width = 1215
End
Begin VB.TextBox txtIP
Height = 300
Left = 1500
TabIndex = 3
TabStop = 0 'False
Text = "192.168.1.68"
Top = 2760
Visible = 0 'False
Width = 2745
End
Begin VB.CheckBox chkServer
Caption = "服务器"
Height = 330
Left = 120
TabIndex = 2
TabStop = 0 'False
Top = 2745
Visible = 0 'False
Width = 1215
End
Begin VB.TextBox txtMemo
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 75
TabIndex = 1
Top = 5805
Width = 6675
End
Begin VB.ListBox lstFrom
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2460
ItemData = "Form1.frx":030E
Left = 120
List = "Form1.frx":0310
TabIndex = 0
TabStop = 0 'False
Top = 150
Width = 6615
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub chkServer_Click()
If Me.chkServer.Value Then
If Me.Winsock1.State <> sckClosed Then Me.Winsock1.Close
Me.Winsock1.LocalPort = 4001
Me.Winsock1.Listen
End If
End Sub
Private Sub cmdConnect_Click()
If Me.Winsock1.State <> sckClosed Then Me.Winsock1.Close
Me.Winsock1.RemoteHost = txtIP.Text
Me.Winsock1.RemotePort = 4001
Me.Winsock1.Connect
Call AddTo("呼叫")
End Sub
Private Sub Form_Load()
Call chkServer_Click
End Sub
Public Sub AddTo(ByVal pstrTemp As String)
lstTo.AddItem (pstrTemp)
lstTo.ListIndex = lstTo.ListCount - 1
DoEvents
Me.txtMemo.SetFocus
End Sub
Public Sub AddFrom(ByVal pstrTemp As String)
lstFrom.AddItem (pstrTemp)
lstFrom.ListIndex = lstFrom.ListCount - 1
DoEvents
Me.txtMemo.SetFocus
End Sub
Private Sub lstFrom_DblClick()
Me.lstFrom.Clear
Me.txtMemo.SetFocus
End Sub
Private Sub lstTo_DblClick()
Me.lstTo.Clear
Me.txtMemo.SetFocus
End Sub
Private Sub txtMemo_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
If UCase(Me.txtMemo.Text) = "/SHOW" Then
Me.chkServer.Visible = True
Me.txtIP.Visible = True
Me.txtMemo.Text = ""
Exit Sub
End If
If Len(Trim(Me.txtMemo.Text)) > 0 Then
Call SendInfo(Me.txtMemo.Text)
If Left(Trim(Me.txtMemo.Text), 1) <> "/" Then
Call AddTo(Me.txtMemo.Text)
End If
Me.txtMemo.Text = ""
End If
End If
End Sub
Private Sub Winsock1_Close()
Call chkServer_Click
MsgBox "对方退出"
End Sub
Private Sub Winsock1_Connect()
Call AddFrom("连接成功")
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
With Me.Winsock1
If .State <> sckClosed Then .Close
.Accept (requestID)
DoEvents
'Call SendInfo("连接成功")
Call AddFrom("连接成功")
End With
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim strTemp As String
With Me.Winsock1
.GetData strTemp
Select Case UCase(Left(strTemp, 2))
Case "/T"
Me.Caption = Right(strTemp, Len(strTemp) - 2)
Case Else
Call AddFrom(strTemp)
End Select
End With
End Sub
Public Sub SendInfo(ByVal pstr As String)
On Error Resume Next
Me.Winsock1.SendData pstr
End Sub