登录  
 加关注
查看详情
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

面包会有的

... ...

 
 
 

日志

 
 

实现端口对端口的聊天  

2007-08-21 18:32:24|  分类: 默认分类 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
本程序可以在互联网和局域网,甚至在一台电脑里面也可以(设置端口就可以了!!!)

模块声明如下:

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
  评论这张
 
阅读(457)| 评论(0)

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018