實現埠對埠的聊天 (轉)

實現埠對埠的聊天 (轉)[@more@]

 

 

 

本可以在網際網路和，甚至在一臺裡面也可以（設定埠就可以了！！！）

模組宣告如下：

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_SYMMAND = &H112
Public Const SC_MOVE = &HF010&
Public Const HTCAPTION = 2

視窗的程式碼：

Private Sub Form_Load()
txtRemote= 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.tate = 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