p2pCore 支持二次开发。客户端使用 VB6 服务器端使用C# 2.0。要测试服务器端的朋友们,需要下载一个.NET 2.0框架。
那么我先插入端简单的客户端代码做个示范:
点击下载 p2pCore vb6 + C#
那么我先插入端简单的客户端代码做个示范:
'*************************************************************************
'**模 块 名: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
'**模 块 名: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#