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#