VB.NET实现DirectPlay(6)VOICE语音群聊

关键字: DirectPlay DPlay VB DirectX .net 网络 游戏 作者:董含君
转贴请注明来自 http://a11s.cnblogs.com

按照顺序应该是先Lobby的,但是我还没有理解大厅的意义.怎么看怎么觉得无用.我再去参考一下C++的资料.然后再慢慢看.应该说做一个大厅服务器是一个非常重要的环节.所以往后调整一下.弄完Server-Client回头再看.

周五调试完了语音连接.这个是在DirectPlay连接的基础上建立的.个人认为.他是通过DPlay的连接发送的已经封装好了的数据包.但是用普通方式接收不到-_-b

在当前连接以及session的基础上.建立一个voiceServer.然后设置压缩格式等等,等待VoiceClient连接,也有一个voiceConnect到voiceserver. 整体来说,就是需要设置的东西多了一点.但是没有什么难度.

大体步骤:

1 建立一个Directplay的连接,确保能进行chat(不介意的话,可以拿chat来进行改进,添加一些代码就可.我就是这么干的.大体需要添加70行左右)

2 可能的话,建议测试一下当前的语音环境,比如MicPhone以及Speaker是否正常,呵呵,有向导.



3 建立VoiceSession,设置sessiontype以及压缩格式…最后server.startsession(sessiondesc)

这个是MS的例子



客户端:

4 connectServer,设置ClientConfig,比如自动录音,buffer质量….以及SoundConfig,指定输入输出设备,这个需要DirectSound的一个DSoundHelper类.最后就是Client.Connect ( soundconfig , clientconfig …)

5 指定传输对象, client.TransmitTargets=DirectPlay.Voice.PlayerId.AllPlayers

OK ,这样就可以进行传输了,声音是自动的.不想自动怎么办?呵呵,我还没有发现client有record功能,到时候你再dispose或者修改flag.

但是发现client可以create3DSoundBuffer,跟DirectSound中的是一样的,可以参见我的关于DirectSound的DirectSound3d部分有介绍跟演示.(Emm…既然有了SoundBuffer就可以做很多事情,比如录音以及特效…)

值得一提的是,Client支持很多方法,某些看起来还是很有用的.playercreate recordstart playstart 等等用来描述状态的,其中传递的参数可以得知是谁再说话.如此之类这般…



以下是代码,经过实验证明(偷懒的时候发现),可以直接copy,但是关于directplay的引用需要自己添加.

Imports Microsoft.DirectX

Imports Microsoft.DirectX.DirectPlay

Imports Microsoft.DirectX.DirectPlay.Voice

Imports Microsoft.DirectX.DirectSound

Public Class Form1

Inherits System.Windows.Forms.Form

Dim g As Guid = New Guid("590E16DD-538F-40fb-A7DF-9654EA6BE71E")

'因为自己既要做HOST又要做Client所以干脆都声明一下免得看的混乱

'都还没有实例化,到时候根据是否HOST再来定义

Dim IsHost As Boolean = False

Dim IsConnected As Boolean = False

Dim WithEvents HostPeer As Peer

Dim WithEvents ClientPeer As Peer

Dim HostAddr As Address

Dim ClientAddr As Address

Dim HostDesc As ApplicationDescription

Dim ClientDesc As ApplicationDescription

'Voice相关

Dim WithEvents vClient As DirectPlay.Voice.Client

Dim WithEvents vServer As DirectPlay.Voice.Server

Dim mClientConfig As DirectPlay.voice.ClientConfig

Private mHalfDuplex, mInSession, mIsHost As Boolean

Private mConfig As DirectPlay.voice.ClientConfig

Private mCompressionInfo() As DirectPlay.voice.CompressionInformation

#Region " Windows 窗体设计器生成的代码 "

Public Sub New()

MyBase.New()

'该调用是 Windows 窗体设计器所必需的。

InitializeComponent()

'在 InitializeComponent() 调用之后添加任何初始化

End Sub

'窗体重写 dispose 以清理组件列表。

Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)

If disposing Then

If Not (components Is Nothing) Then

components.Dispose()

End If

End If

MyBase.Dispose(disposing)

End Sub

'Windows 窗体设计器所必需的

Private components As System.ComponentModel.IContainer

'注意: 以下过程是 Windows 窗体设计器所必需的

'可以使用 Windows 窗体设计器修改此过程。

'不要使用代码编辑器修改它。

Friend WithEvents Button1 As System.Windows.Forms.Button

Friend WithEvents Button2 As System.Windows.Forms.Button

Friend WithEvents Button3 As System.Windows.Forms.Button

Friend WithEvents Button4 As System.Windows.Forms.Button

Friend WithEvents TextBox2 As System.Windows.Forms.TextBox

Friend WithEvents ListBox1 As System.Windows.Forms.ListBox

Friend WithEvents Button5 As System.Windows.Forms.Button

Friend WithEvents Button6 As System.Windows.Forms.Button

Friend WithEvents GroupBox1 As System.Windows.Forms.GroupBox

Friend WithEvents Button7 As System.Windows.Forms.Button

Friend WithEvents Button8 As System.Windows.Forms.Button

Friend WithEvents Button9 As System.Windows.Forms.Button

Friend WithEvents Label1 As System.Windows.Forms.Label

<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()

Me.Button1 = New System.Windows.Forms.Button

Me.Button2 = New System.Windows.Forms.Button

Me.Button3 = New System.Windows.Forms.Button

Me.Button4 = New System.Windows.Forms.Button

Me.TextBox2 = New System.Windows.Forms.TextBox

Me.ListBox1 = New System.Windows.Forms.ListBox

Me.Button5 = New System.Windows.Forms.Button

Me.Button6 = New System.Windows.Forms.Button

Me.GroupBox1 = New System.Windows.Forms.GroupBox

Me.Label1 = New System.Windows.Forms.Label

Me.Button9 = New System.Windows.Forms.Button

Me.Button8 = New System.Windows.Forms.Button

Me.Button7 = New System.Windows.Forms.Button

Me.GroupBox1.SuspendLayout()

Me.SuspendLayout()

'

'Button1

'

Me.Button1.Location = New System.Drawing.Point(8, 8)

Me.Button1.Name = "Button1"

Me.Button1.Size = New System.Drawing.Size(120, 32)

Me.Button1.TabIndex = 0

Me.Button1.Text = "HOST"

'

'Button2

'

Me.Button2.Location = New System.Drawing.Point(160, 8)

Me.Button2.Name = "Button2"

Me.Button2.Size = New System.Drawing.Size(120, 32)

Me.Button2.TabIndex = 2

Me.Button2.Text = "Left"

'

'Button3

'

Me.Button3.Location = New System.Drawing.Point(8, 56)

Me.Button3.Name = "Button3"

Me.Button3.Size = New System.Drawing.Size(120, 32)

Me.Button3.TabIndex = 3

Me.Button3.Text = "Search"

'

'Button4

'

Me.Button4.Location = New System.Drawing.Point(160, 56)

Me.Button4.Name = "Button4"

Me.Button4.Size = New System.Drawing.Size(120, 32)

Me.Button4.TabIndex = 4

Me.Button4.Text = "Left Session"

'

'TextBox2

'

Me.TextBox2.Location = New System.Drawing.Point(8, 168)

Me.TextBox2.Name = "TextBox2"

Me.TextBox2.Size = New System.Drawing.Size(184, 21)

Me.TextBox2.TabIndex = 5

Me.TextBox2.Text = "TextBox2"

'

'ListBox1

'

Me.ListBox1.ItemHeight = 12

Me.ListBox1.Location = New System.Drawing.Point(8, 96)

Me.ListBox1.Name = "ListBox1"

Me.ListBox1.Size = New System.Drawing.Size(272, 64)

Me.ListBox1.TabIndex = 6

'

'Button5

'

Me.Button5.Location = New System.Drawing.Point(208, 168)

Me.Button5.Name = "Button5"

Me.Button5.Size = New System.Drawing.Size(72, 24)

Me.Button5.TabIndex = 7

Me.Button5.Text = "send"

'

'Button6

'

Me.Button6.Location = New System.Drawing.Point(8, 216)

Me.Button6.Name = "Button6"

Me.Button6.Size = New System.Drawing.Size(96, 24)

Me.Button6.TabIndex = 8

Me.Button6.Text = "New Me"

'

'GroupBox1

'

Me.GroupBox1.Controls.Add(Me.Label1)

Me.GroupBox1.Controls.Add(Me.Button9)

Me.GroupBox1.Controls.Add(Me.Button8)

Me.GroupBox1.Controls.Add(Me.Button7)

Me.GroupBox1.Location = New System.Drawing.Point(288, 16)

Me.GroupBox1.Name = "GroupBox1"

Me.GroupBox1.Size = New System.Drawing.Size(192, 216)

Me.GroupBox1.TabIndex = 10

Me.GroupBox1.TabStop = False

Me.GroupBox1.Text = "voice"

'

'Label1

'

Me.Label1.Location = New System.Drawing.Point(8, 168)

Me.Label1.Name = "Label1"

Me.Label1.Size = New System.Drawing.Size(168, 24)

Me.Label1.TabIndex = 3

Me.Label1.Text = "状态"

'

'Button9

'

Me.Button9.Location = New System.Drawing.Point(8, 112)

Me.Button9.Name = "Button9"

Me.Button9.Size = New System.Drawing.Size(168, 40)

Me.Button9.TabIndex = 2

Me.Button9.Text = "如果可能,强烈建议你先配置一下"

'

'Button8

'

Me.Button8.Location = New System.Drawing.Point(8, 72)

Me.Button8.Name = "Button8"

Me.Button8.Size = New System.Drawing.Size(168, 24)

Me.Button8.TabIndex = 1

Me.Button8.Text = "连接到服务"

'

'Button7

'

Me.Button7.Location = New System.Drawing.Point(8, 32)

Me.Button7.Name = "Button7"

Me.Button7.Size = New System.Drawing.Size(168, 24)

Me.Button7.TabIndex = 0

Me.Button7.Text = "提供声音服务"

'

'Form1

'

Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)

Me.ClientSize = New System.Drawing.Size(496, 273)

Me.Controls.Add(Me.GroupBox1)

Me.Controls.Add(Me.Button6)

Me.Controls.Add(Me.Button5)

Me.Controls.Add(Me.ListBox1)

Me.Controls.Add(Me.TextBox2)

Me.Controls.Add(Me.Button4)

Me.Controls.Add(Me.Button3)

Me.Controls.Add(Me.Button2)

Me.Controls.Add(Me.Button1)

Me.Name = "Form1"

Me.Text = "Form1"

Me.GroupBox1.ResumeLayout(False)

Me.ResumeLayout(False)

End Sub

#End Region

#Region "建立DPlay连接的"

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

'自己HOST一下

If IsHost Then

MsgBox("你看看标题栏,已经HOST了,别点了")

Exit Sub

End If

Try

'如果参数胡乱填写很可能失败的

HostAddr = New Address

HostAddr.KeyHostname = InputBox("HOST Name:", "IP或者域名", "127.0.0.1")

HostAddr.KeyPort = InputBox("PORT:", "端口", "2603")

HostAddr.ServiceProvider = Address.ServiceProviderTcpIp

HostDesc = New ApplicationDescription

HostDesc.SessionName = InputBox("Session Name:", "起个名字", "Session1")

HostDesc.GuidApplication = g

HostDesc.Flags = DirectPlay.SessionFlags.FastSigned

HostPeer = New Peer

HostPeer.Host(HostDesc, HostAddr)

Me.Text = HostDesc.SessionName

IsHost = True

Catch ex As Exception

MsgBox("失败:" + ex.Message)

Try

HostPeer.Dispose()

'失败就Over掉它

Me.Text = "No Host"

Catch exx As Exception

End Try

IsHost = False

End Try

End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

If Not IsHost Then Exit Sub

Try

HostPeer.Dispose()

'失败就Over掉它

Me.Text = "No Host"

IsHost = False

Catch exx As Exception

End Try

End Sub

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

'找啊找啊找Session,找到一个好Session,敬个礼啊握握手,你是我的好Session

If IsHost Then

MsgBox("你还是再new一个窗体吧,这个已经用来host了")

Exit Sub

End If

HostAddr = New Address

HostAddr.ServiceProvider = HostAddr.ServiceProviderTcpIp

HostDesc.GuidApplication = g

'HostDesc.Flags = SessionFlags.NoDpnServer

ClientAddr = New Address

ClientAddr.KeyHostname = InputBox("本地IP", "HostName", "127.0.0.1")

ClientAddr.KeyPort = InputBox("本地端口", "端口", "3613")

ClientAddr.ServiceProvider = Address.ServiceProviderTcpIp

ClientPeer = New Peer

Me.Text = "Searching..."

ClientPeer.FindHosts(HostDesc, HostAddr, ClientAddr, Nothing, 1, 10, 2000, FindHostsFlags.None)

Me.Text = "Search OK"

'OK 期待回复吧

End Sub

Private Sub ClientPeer_FindHostResponse(ByVal sender As Object, ByVal e As Microsoft.DirectX.DirectPlay.FindHostResponseEventArgs) Handles ClientPeer.FindHostResponse

'如果已经连接了,那么这个就没意义了

If IsConnected Then Exit Sub

'假设这个时候 clientPeer还没有被你释放,其实应该try一下的... -_-b

If MsgBox("找到一个连接,Session='" + e.Message.ApplicationDescription.SessionName + "' 是否连接?", MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then

Me.Text = "连接中..."

ClientPeer.Connect(e.Message.ApplicationDescription, e.Message.AddressSender, ClientAddr, Nothing, ConnectFlags.Sync)

End If

End Sub

Private Sub ClientPeer_ConnectComplete(ByVal sender As Object, ByVal e As Microsoft.DirectX.DirectPlay.ConnectCompleteEventArgs) Handles ClientPeer.ConnectComplete

Me.Text = "连接成功"

IsConnected = True

End Sub

Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

'发信息啊发信息

'没有连接 或者 自己不是主机

If (Not IsConnected) And (Not IsHost) Then

MsgBox("没有连接啊")

Exit Sub

End If

Dim pak As New NetworkPacket

pak.Write(TextBox2.Text)

If IsHost Then

HostPeer.SendTo(DirectPlay.PlayerID.AllPlayers, pak, 1000, SendFlags.Guaranteed)

Else

ClientPeer.SendTo(DirectPlay.PlayerID.AllPlayers, pak, 1000, SendFlags.Guaranteed)

End If

End Sub

Private Sub ClientPeer_Receive(ByVal sender As Object, ByVal e As Microsoft.DirectX.DirectPlay.ReceiveEventArgs) Handles ClientPeer.Receive

ListBox1.Items.Add(e.Message.ReceiveData.ReadString)

End Sub

Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

If IsHost Then Exit Sub

If ClientPeer Is Nothing Then Exit Sub

IsConnected = False

ClientPeer.Dispose()

End Sub

Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click

Dim f As New Form1

f.Show()

End Sub

Private Sub HostPeer_Receive(ByVal sender As Object, ByVal e As Microsoft.DirectX.DirectPlay.ReceiveEventArgs) Handles HostPeer.Receive

'如果做HOST 自然是HOSTPEER 受到信息了

ListBox1.Items.Add(e.Message.ReceiveData.ReadString)

End Sub

Private Sub ClientPeer_SessionTerminated(ByVal sender As Object, ByVal e As Microsoft.DirectX.DirectPlay.SessionTerminatedEventArgs) Handles ClientPeer.SessionTerminated

Try

ClientPeer.Dispose()

MsgBox("SessionTerminated")

Catch ex As Exception

End Try

End Sub

Private Sub ClientPeer_IndicatedConnectAborted(ByVal sender As Object, ByVal e As Microsoft.DirectX.DirectPlay.IndicatedConnectAbortedEventArgs) Handles ClientPeer.IndicatedConnectAborted

Try

ClientPeer.Dispose()

MsgBox("ConnectAborted")

Catch ex As Exception

End Try

End Sub

#End Region

#Region " 关于VOICE的 "

'提供服务

Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click

'临时用一下,因为这个有可能是HOST

Dim LPeer As Peer

If IsHost Then

'如果他提供服务那么

LPeer = HostPeer

Else

LPeer = ClientPeer

If IsConnected = False Then

MsgBox("先建立连接,这个是依赖连接的,先能文字再说")

Exit Sub

End If

End If

vServer = New DirectPlay.Voice.Server(LPeer)

vClient = New DirectPlay.Voice.Client(LPeer)

'''''''建立voice session

Dim sessionDesc As New DirectPlay.Voice.SessionDescription

sessionDesc.BufferAggressiveness = DirectPlay.Voice.BufferAggressiveness.Default

sessionDesc.BufferQuality = DirectPlay.Voice.BufferQuality.Default

sessionDesc.Flags = 0 '为什么是0的???估计是SDK忘了写了

sessionDesc.SessionType = SessionType.Peer

sessionDesc.GuidCompressionType = vServer.CompressionTypes(0).GuidType 'compressionType

'这里的compresstype有自己的描述以及多少bit每秒,可以自己列出来然后选择,这里为了简单,省略

'start the session

vServer.StartSession(sessionDesc)

mIsHost = True

mInSession = True

''创建完Server还是需要连接的,这个仅仅是借助peer建立server,说话的话还是需要Client的

'mClientConfig = mConfig

ConnectToVoiceSession(LPeer, Me)

MsgBox("Voice 创建/连接完毕")

End Sub

Protected Sub ConnectToVoiceSession(ByVal dpp As Peer, ByVal wnd As Form)

mClientConfig = New ClientConfig

'mConfig.Threshold = Threshold.Default

mClientConfig.BufferQuality = BufferQuality.Default

mClientConfig.BufferAggressiveness = BufferAggressiveness.Default

mClientConfig.Flags = ClientConfigFlags.AutoRecordVolume Or ClientConfigFlags.AutoVoiceActivated

mClientConfig.Threshold = Threshold.Unused

Dim soundConfig As New DirectPlay.voice.SoundDeviceConfig

If dpp Is Nothing Then MsgBox("no peer")

'Set sound config to defaults

soundConfig.GuidPlaybackDevice = DSoundHelper.DefaultVoicePlaybackDevice

soundConfig.GuidCaptureDevice = DSoundHelper.DefaultVoiceCaptureDevice

soundConfig.Window = Me

'TODO: add error message for specific failures?

'Connect to voice session

Try

vClient.Connect(soundConfig, mClientConfig, DirectPlay.Voice.VoiceFlags.Sync)

Catch e As ArgumentException

MsgBox(e.Message)

End Try

'set state

mInSession = True

'set transmit targets to all players

Dim xmitTargets(0) As Integer

xmitTargets(0) = CInt(DirectPlay.Voice.PlayerId.AllPlayers)

vClient.TransmitTargets = xmitTargets

'get sound device config to check for half-duplex

soundConfig = vClient.SoundDeviceConfig

mHalfDuplex = (soundConfig.Flags And DirectPlay.Voice.SoundConfigFlags.HalfDuplex) <> 0

End Sub 'ConnectToVoiceSession

'测试设备

Private Sub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.Click

'Voice添加的代码

Dim test As New DirectPlay.Voice.Test

test.CheckAudioSetup()

'其实可以单独测试某个设备 并且不需要弹出对话框的

'test.CheckAudioSetup(DSoundHelper.DefaultPlaybackDevice, DSoundHelper.DefaultCaptureDevice, wnd, Voice.TestFlags.QueryOnly)

'为了防止测试出现异常,应当try catch一下

'这里简单为主,省略掉

End Sub

Private Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click

Dim LPeer As Peer

If IsHost Then

'如果他提供服务那么

LPeer = HostPeer

Else

LPeer = ClientPeer

If IsConnected = False Then

MsgBox("先建立连接,这个是依赖连接的,先能文字再说")

Exit Sub

End If

End If

vClient = New DirectPlay.Voice.Client(LPeer)

ConnectToVoiceSession(LPeer, Me)

MsgBox("建立连接")

End Sub

#End Region

End Class