[原创]使用VB6开发既时通信的朋友们有福咯，p2pCore 支持二次开发

p2pCore 支持二次开发。客户端使用 VB6 服务器端使用C# 2.0。要测试服务器端的朋友们，需要下载一个.NET 2.0框架。

那么我先插入端简单的客户端代码做个示范：

'*************************************************************************

'**模 块 名：P2PCoreSample - frmChat

'**说 明：福建小熊在线 FJ007.COM 版权所有 2007 - 2008(C)

'**创 建 人：Ray Lynn

'**日 期：2007-04-27 10:23:36

'**描 述：

'**版 本：V1.0.0

'*************************************************************************

'

Option Explicit

Public MyNickname As String

Private TargetNickname As String

Private WithEvents p2pCore As clsP2PCore 'p2p核心

Public colUserIds As New Collection

'*************************************************************************

'**函 数 名：UpdateOnlineUsers

'**输 入：ByVal sUserIds(String) -

'**输 出：无

'**功能描述：从服务器获得在线用户

'**作 者：Ray Lynn

'**日 期：2007-04-27 10:58:05

'**版 本：V1.0.0

'*************************************************************************

Public Sub UpdateOnlineUsers(ByVal sUserIds As String)

Dim userIds() As String, tmpUserItem As Variant, i As Integer

Set colUserIds = New Collection

userIds = Split(sUserIds, "|")

lstOnlineUsers.Clear

For i = 0 To UBound(userIds) - 1

colUserIds.Add userIds(i)

lstOnlineUsers.AddItem userIds(i)

Next

End Sub

'*************************************************************************

'**函 数 名：Login

'**输 入：ByVal ServerIP(String) -

'** ：ByVal ServerPort(Integer) -

'**输 出：无

'**功能描述：登录服务器

'**作 者：Ray Lynn

'**日 期：2007-04-27 10:58:12

'**版 本：V1.0.0

'*************************************************************************

Public Sub Login(ByVal ServerIP As String, ByVal ServerPort As Integer)

Set p2pCore = New clsP2PCore

p2pCore.LoginServer ServerIP, ServerPort, MyNickname

timGetContacters.Enabled = True

Call timGetContacters_Timer

End Sub

'*************************************************************************

'**函 数 名：cmdSend_Click

'**输 入：无

'**输 出：无

'**功能描述：发送消息

'**作 者：Ray Lynn

'**日 期：2007-04-27 10:58:27

'**版 本：V1.0.0

'*************************************************************************

Private Sub cmdSend_Click()

If TargetNickname = Empty Then

MsgBox "请在左边选择一个聊天对象再继续", vbInformation, "提示"

Exit Sub

End If

Dim Msg As clsMessagePackage

Set Msg = New clsMessagePackage

Msg.Init "chat", _

TargetNickname '目标者ID

Msg.AddMessage MyNickname

Msg.AddMessage txtSendbox.Text

p2pCore.Send Msg '发送聊天信息

txtReceivText.Text = txtReceivText.Text & "我对 " & TargetNickname & " 说：" & txtSendbox.Text & vbCrLf

txtReceivText.SelStart = Len(txtReceivText.Text)

txtSendbox.Text = Empty

txtSendbox.SetFocus

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

p2pCore.LogoutServer

End Sub

Private Sub lstOnlineUsers_Click()

TargetNickname = lstOnlineUsers.List(lstOnlineUsers.ListIndex)

lblStatus.Caption = "正在和 " & TargetNickname & " 进行聊天"

End Sub

'*************************************************************************

'**函 数 名：p2pCore_DataArrival

'**输 入：Protocol(String) - 协议名称

'** ：ArrivalDatas()(String) - 内容

'** ：ArrivalDatasContainsProtocol()(String) - 内容，包含着协议（一般不用）

'**输 出：无

'**功能描述：

'**作 者：Ray Lynn

'**日 期：2007-04-27 10:23:47

'**版 本：V1.0.0

'*************************************************************************

Private Sub p2pCore_DataArrival(Protocol As String, ArrivalDatas() As String, ArrivalDatasContainsProtocol() As String)

If Protocol = "chat" Then

txtReceivText.Text = txtReceivText.Text & ArrivalDatas(0) & " 说：" & ArrivalDatas(1) & vbCrLf

txtReceivText.SelStart = Len(txtReceivText.Text)

ElseIf Protocol = "3001" Then

Call UpdateOnlineUsers(ArrivalDatas(0))

End If

End Sub

Private Sub p2pCore_LoginServer(ByVal Successfully As Boolean)

If Successfully = True Then

MsgBox "登录服务器成功", vbInformation, "提示"

Else

MsgBox "登录服务器失败", vbCritical, "失败"

Unload Me

End If

Unload frmStatusForm

End Sub

Private Sub p2pCore_SendFailed(Protocol As String, ArrivalDatas() As String)

If Protocol = "chat" Then

txtReceivText.Text = txtReceivText.Text & "消息" & ArrivalDatas(1) & "发送失败" & vbCrLf

txtReceivText.SelStart = Len(txtReceivText.Text)

End If

End Sub

Private Sub timGetContacters_Timer()

Dim mb As clsMessagePackage

Set mb = New clsMessagePackage

mb.Init "3000" '向服务器索取好友列表

p2pCore.Send2Svr mb

End Sub

点击下载 p2pCore vb6 + C#