实现端口对端口的聊天 (转)[@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 LongPublic Const WM_SYMMAND = &H112Public Const SC_MOVE = &HF010&Public Const HTCAPTION = 2

窗口的代码：

Private Sub Form_Load()txtRemote= Winsock1.LocalIPLine19.BorderColor = QBColor(15)Line20.BorderColor = QBColor(15)Line21.BorderColor = QBColor(0)Line22.BorderColor = QBColor(0)Label1.BackColor = &HC07847Label2.BackColor = &HC07847Label3.BackColor = &HC07847Label4.BackColor = &HC07847Label5.BackColor = &HC07847Label6.BackColor = &HC07847Label7.BackColor = &HC07847Label8.BackColor = &HC07847Label9.BackColor = &HC07847Label10.BackColor = &HC07847Label11.BackColor = &HC07847Label12.BackColor = &HC07847label13.BackColor = &HC07847txtRemoteIP.BackColor = &HC07847txtRemotePort.BackColor = &HC07847txtLocalPort.BackColor = &HC07847Text1.BackColor = &HC07847Text2.BackColor = &HC07847End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

ReleaseCaptureret& = 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 ThenLine19.BorderColor = QBColor(0)Line20.BorderColor = QBColor(0)Line21.BorderColor = QBColor(15)Line22.BorderColor = QBColor(15)End IfOn Error GoTo ErrHandlerWith Winsock1.RemoteHost = Trim(txtRemoteIP).RemotePort = Trim(txtRemotePort)  If .LocalPort = Empty Then  .LocalPort = Trim(txtLocalPort)  .Bind .LocalPort  End IfEnd WithtxtLocalPort.Locked = TruLabel7.Caption = "  Connected to " & Winsock1.RemoteHost & "  "Text2.SetFocusErrHandler:End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Line19.Visible = False ThenLine19.Visible = TrueLine20.Visible = TrueLine21.Visible = TrueLine22.Visible = TrueEnd IfEnd Sub

Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = 1 ThenLine19.BorderColor = QBColor(15)Line20.BorderColor = QBColor(15)Line21.BorderColor = QBColor(0)Line22.BorderColor = QBColor(0)End IfEnd Sub

Private Sub Label1_Click()

EndEnd 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 = 1End SubPrivate Sub Text2_KeyPress(KeyAscii As Integer)Static Last_Line_Feed As LongDim New_Line As StringIf Trim(Text2) = vbNullString Then Last_Line_Feed = 0If 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 IfEnd Sub

Private Sub Timer1_Timer()

Line19.Visible = FalseLine20.Visible = FalseLine21.Visible = FalseLine22.Visible = FalseEnd Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

Dim New_Text As StringWinsock1.GetData New_TextText1.SelText = New_TextLabel7.Caption = "  Recieved " & bytesTotal & " bytes  "End Sub

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/10748419/viewspace-976327/，如需转载，请注明出处，否则将追究法律责任。