实现端口对端口的聊天
出处：网络

本程序可以在互联网和局域网，甚至在一台电脑里面也可以（设置端口就可以了！！！）

模块声明如下：

Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, IParam As Any) As Long
Public Const WM_SYSCOMMAND = &H112
Public Const SC_MOVE = &HF010&
Public Const HTCAPTION = 2

窗口的代码：

Private Sub Form_Load()
txtRemoteIP = Winsock1.LocalIP
Line19.BorderColor = QBColor(15)
Line20.BorderColor = QBColor(15)
Line21.BorderColor = QBColor(0)
Line22.BorderColor = QBColor(0)
Label1.BackColor = &HC07847
Label2.BackColor = &HC07847
Label3.BackColor = &HC07847
Label4.BackColor = &HC07847
Label5.BackColor = &HC07847
Label6.BackColor = &HC07847
Label7.BackColor = &HC07847
Label8.BackColor = &HC07847
Label9.BackColor = &HC07847
Label10.BackColor = &HC07847
Label11.BackColor = &HC07847
Label12.BackColor = &HC07847
label13.BackColor = &HC07847
txtRemoteIP.BackColor = &HC07847
txtRemotePort.BackColor = &HC07847
txtLocalPort.BackColor = &HC07847
Text1.BackColor = &HC07847
Text2.BackColor = &HC07847
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
ret& = SendMessage(Me.hWnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0)
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Line19.BorderColor = QBColor(0)
Line20.BorderColor = QBColor(0)
Line21.BorderColor = QBColor(15)
Line22.BorderColor = QBColor(15)
End If
On Error GoTo ErrHandler
With Winsock1
.RemoteHost = Trim(txtRemoteIP)
.RemotePort = Trim(txtRemotePort)
If .LocalPort = Empty Then
.LocalPort = Trim(txtLocalPort)
.Bind .LocalPort
End If
End With
txtLocalPort.Locked = Tru
Label7.Caption = " Connected to " & Winsock1.RemoteHost & " "
Text2.SetFocus
ErrHandler:
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Line19.Visible = False Then
Line19.Visible = True
Line20.Visible = True
Line21.Visible = True
Line22.Visible = True
End If
End Sub

Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Line19.BorderColor = QBColor(15)
Line20.BorderColor = QBColor(15)
Line21.BorderColor = QBColor(0)
Line22.BorderColor = QBColor(0)
End If
End Sub

Private Sub Label1_Click()
End
End Sub

Private Sub Label11_Click()
MsgBox "郭镇东全力制作！", , "About"
End Sub

Private Sub Label12_Click()
Text1.Text = ""
Text2.Text = ""
End Sub

Private Sub Label2_Click()
Form1.WindowState = 1
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
Static Last_Line_Feed As Long
Dim New_Line As String
If Trim(Text2) = vbNullString Then Last_Line_Feed = 0
If KeyAscii = 13 Then
New_Line = Mid(Text2, Last_Line_Feed + 1)
Last_Line_Feed = Text2.SelStart
Winsock1.SendData New_Line
Label7.Caption = " Sent " & (LenB(New_Line) / 2) & " bytes "
End If
End Sub

Private Sub Timer1_Timer()
Line19.Visible = False
Line20.Visible = False
Line21.Visible = False
Line22.Visible = False
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim New_Text As String
Winsock1.GetData New_Text
Text1.SelText = New_Text
Label7.Caption = " Recieved " & bytesTotal & " bytes "
End Sub

[返回]

首页 | 设为首页 | 加入收藏 | 关于本站 | 友情链接 | 版权声明