VERSION 5.00 Begin VB.Form frmDataRelay BorderStyle = 3 'Fixed Dialog Caption = "vbData Relay" ClientHeight = 6255 ClientLeft = 645 ClientTop = 930 ClientWidth = 7755 Icon = "frmDataRelay.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6255 ScaleWidth = 7755 StartUpPosition = 3 'Windows Default Begin VB.Frame Frame5 Caption = "Connection Information" Height = 2715 Left = 3240 TabIndex = 23 Top = 960 Width = 4455 Begin VB.TextBox txtInfo BackColor = &H8000000F& Height = 1935 Left = 120 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 26 Top = 660 Width = 4155 End Begin VB.ComboBox cboInfoTarget Height = 315 Left = 1380 Style = 2 'Dropdown List TabIndex = 25 Top = 240 Width = 2655 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Info Target: " Height = 195 Index = 6 Left = 300 TabIndex = 24 Top = 300 Width = 1035 End End Begin VB.Timer tmrReceivedData Interval = 1 Left = 180 Top = 3060 End Begin VB.Timer tmrSendData Interval = 1 Left = 720 Top = 3060 End Begin VB.Frame Frame4 Caption = "Statistics" Height = 915 Left = 60 TabIndex = 18 Top = 2760 Width = 3135 Begin VB.Label lblReceive BackStyle = 0 'Transparent Caption = "0.0" Height = 195 Left = 2160 TabIndex = 22 Top = 480 Width = 855 End Begin VB.Label lblSendRate BackStyle = 0 'Transparent Caption = "0.0" Height = 195 Left = 2160 TabIndex = 21 Top = 240 Width = 795 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Received Rate (bytes/sec) :" Height = 195 Index = 8 Left = 60 TabIndex = 20 Top = 480 Width = 2055 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Send Rate (bytes/sec) :" Height = 195 Index = 7 Left = 60 TabIndex = 19 Top = 240 Width = 2055 End End Begin VB.Frame Frame3 Caption = "Send" Height = 1755 Left = 60 TabIndex = 9 Top = 960 Width = 3135 Begin VB.ComboBox cboTimeout Height = 315 Left = 1200 Style = 2 'Dropdown List TabIndex = 17 Top = 1320 Width = 1815 End Begin VB.ComboBox cboTarget Height = 315 Left = 1200 Style = 2 'Dropdown List TabIndex = 16 Top = 240 Width = 1815 End Begin VB.ComboBox cboSize Height = 315 Left = 1200 Style = 2 'Dropdown List TabIndex = 15 Top = 600 Width = 1815 End Begin VB.ComboBox cboRate Height = 315 Left = 1200 Style = 2 'Dropdown List TabIndex = 14 Top = 960 Width = 1815 End Begin VB.Label Label1 BackStyle = 0 'Transparent Caption = "Timeout (ms) :" Height = 195 Index = 5 Left = 120 TabIndex = 13 Top = 1380 Width = 1035 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Target :" Height = 195 Index = 4 Left = 120 TabIndex = 12 Top = 300 Width = 1035 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Size (bytes) :" Height = 195 Index = 3 Left = 120 TabIndex = 11 Top = 660 Width = 1035 End Begin VB.Label Label1 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Rate (ms) :" Height = 195 Index = 2 Left = 120 TabIndex = 10 Top = 1020 Width = 1035 End End Begin VB.Frame Frame2 Caption = "Log" Height = 2415 Left = 60 TabIndex = 7 Top = 3720 Width = 7635 Begin VB.TextBox txtLog BackColor = &H8000000F& Height = 2055 Left = 120 MultiLine = -1 'True ScrollBars = 3 'Both TabIndex = 8 Top = 240 Width = 7395 End End Begin VB.Frame Frame1 Caption = "Game Status" Height = 855 Left = 60 TabIndex = 0 Top = 60 Width = 7635 Begin VB.CommandButton cmdExit Cancel = -1 'True Caption = "Exit" Height = 375 Left = 5880 TabIndex = 6 Top = 300 Width = 1575 End Begin VB.CommandButton cmdSend Caption = "Push to send" Enabled = 0 'False Height = 375 Left = 4200 TabIndex = 5 Top = 300 Width = 1575 End Begin VB.Label lblPlayers BackStyle = 0 'Transparent Caption = "0" Height = 255 Left = 2340 TabIndex = 4 Top = 480 Width = 195 End Begin VB.Label lblPlayer BackStyle = 0 'Transparent Caption = "TestPlayer" Height = 255 Left = 1560 TabIndex = 3 Top = 240 Width = 1635 End Begin VB.Label Label1 BackStyle = 0 'Transparent Caption = "Number of Players in session:" Height = 195 Index = 1 Left = 120 TabIndex = 2 Top = 480 Width = 2175 End Begin VB.Label Label1 BackStyle = 0 'Transparent Caption = "Local Player Name:" Height = 195 Index = 0 Left = 120 TabIndex = 1 Top = 240 Width = 1455 End End End Attribute VB_Name = "frmDataRelay" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Copyright (C) 1999-2001 Microsoft Corporation. All Rights Reserved. ' ' File: frmDataRelay.frm ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Declare for timeGetTime Private Declare Function timeGetTime Lib "winmm.dll" () As Long Implements DirectPlay8Event Private Const mlTextSize As Long = 32768 Private Type PacketInfo lPacketID As Long lDataSize As Long End Type Private mfSending As Boolean Private mlRate As Long Private mlToPlayerID As Long Private mlTimeOut As Long Private mlSize As Long Private mlSending As Long Private mlLastSendTime As Long Private mlDataReceived As Long Private mlDataSent As Long Private mfInSend As Boolean Private mfInReceive As Boolean Private moByte() As Byte, moBuf() As Byte 'DirectPlayBuffer Private moReceived As New Collection Private Sub cmdExit_Click() 'We're done, unload Unload Me End Sub Private Sub cmdSend_Click() If mfSending Then 'Stop sending now cmdSend.Caption = "Push to send" Else 'Start sending now cmdSend.Caption = "Push to stop" ReadCombos End If EnableComboUI mfSending mfSending = Not mfSending End Sub Private Sub Form_Load() 'First lets populate our combo boxes PopulateBoxes 'Here we will init our DPlay objects InitDPlay 'Now we can create a new Connection Form (which will also be our message pump) Set DPlayEventsForm = New DPlayConnect 'Start the connection form (it will either create or join a session) If Not DPlayEventsForm.StartConnectWizard(dx, dpp, AppGuid, 20, Me) Then Cleanup End Else 'We did choose to play a game gsUserName = DPlayEventsForm.UserName lblPlayer.Caption = gsUserName If DPlayEventsForm.IsHost Then Me.Caption = Me.Caption & " (HOST)" End If End Sub Private Sub Form_Unload(Cancel As Integer) Me.Hide 'Here we need to turn off our timers If mfSending Then cmdSend_Click mfSending = False Do While moReceived.Count > 0 DPlayEventsForm.DoSleep 50 Loop tmrReceivedData.Enabled = False tmrSendData.Enabled = False Cleanup End Sub Private Sub PopulateBoxes() With cboTarget .AddItem "Everyone" .ListIndex = 0 End With With cboRate .AddItem "1000" .AddItem "500" .AddItem "250" .AddItem "100" .AddItem "50" .ListIndex = 0 End With With cboSize .AddItem "512" .AddItem "256" .AddItem "128" .AddItem "64" .AddItem "32" .AddItem "16" .ListIndex = 0 End With With cboTimeout .AddItem "5" .AddItem "10" .AddItem "20" .AddItem "50" .AddItem "100" .AddItem "250" .AddItem "500" .ListIndex = 0 End With With cboInfoTarget .AddItem "None" .ListIndex = 0 End With End Sub Private Sub EnableComboUI(ByVal fEnable As Boolean) cboRate.Enabled = fEnable cboTarget.Enabled = fEnable cboTimeout.Enabled = fEnable cboSize.Enabled = fEnable End Sub Private Sub ReadCombos() mlRate = CLng(cboRate.List(cboRate.ListIndex)) mlSize = CLng(cboSize.List(cboSize.ListIndex)) mlTimeOut = CLng(cboTimeout.List(cboTimeout.ListIndex)) mlToPlayerID = cboTarget.ItemData(cboTarget.ListIndex) 'The ItemData for everyone is 0 End Sub Private Sub AppendText(ByVal sString As String) 'Update the chat window first txtLog.Text = txtLog.Text & sString & vbCrLf 'Now limit the text in the window to be 16k If Len(txtLog.Text) > mlTextSize Then txtLog.Text = Right$(txtLog.Text, mlTextSize) End If 'Autoscroll the text txtLog.SelStart = Len(txtLog.Text) End Sub Private Function GetName(ByVal lID As Long) As String Dim lCount As Long 'Here we will get the name of the player sending us info from the combo box GetName = vbNullString For lCount = 0 To cboTarget.ListCount - 1 If cboTarget.ItemData(lCount) = lID Then 'This is the player GetName = cboTarget.List(lCount) Exit For End If Next End Function Private Sub tmrReceivedData_Timer() Dim oBuf() As Byte, lNewMsg As Long, lNewOffset As Long Dim sItems() As String, oPacket As PacketInfo 'If mfInReceive Then Exit Sub 'We use a timer control here because we don't want to ever 'block DirectPlay. Do While moReceived.Count > 0 mfInReceive = True sItems = Split(moReceived.Item(1), ";") AppendText "Received packet #" & sItems(1) & " from " & GetName(CLng(sItems(0))) & " - Size:" & sItems(2) 'now let this user know we received the packet lNewMsg = MSG_PacketReceive lNewOffset = NewBuffer(oBuf) AddDataToBuffer oBuf, lNewMsg, LenB(lNewMsg), lNewOffset oPacket.lDataSize = CLng(sItems(2)) oPacket.lPacketID = CLng(sItems(1)) mlDataReceived = mlDataReceived + oPacket.lDataSize AddDataToBuffer oBuf, oPacket, LenB(oPacket), lNewOffset 'We don't care to see the receive callback. dpp.SendTo CLng(sItems(0)), oBuf, mlTimeOut, DPNSEND_NOLOOPBACK Erase oBuf moReceived.Remove 1 Loop mfInReceive = False End Sub Private Sub tmrSendData_Timer() Dim lMsg As Long, lOffset As Long Dim oPacket As PacketInfo 'We use a timer control here because we don't want to ever 'block DirectPlay. 'If mfInSend Then Exit Sub If mfSending Then 'We are sending If Abs(timeGetTime - mlLastSendTime) > mlRate Then 'We should send another packet now mfInSend = True lMsg = MSG_GamePacket lOffset = NewBuffer(moBuf) AddDataToBuffer moBuf, lMsg, LenB(lMsg), lOffset mlSending = mlSending + 1 oPacket.lPacketID = mlSending oPacket.lDataSize = mlSize mlDataSent = mlDataSent + mlSize AddDataToBuffer moBuf, oPacket, LenB(oPacket), lOffset ReDim moByte(mlSize) AddDataToBuffer moBuf, moByte(0), mlSize, lOffset 'We will send the NOLOOPBACK flag so we do not get a 'Receive' event for 'this message. 'The NOCOPY flag tells DPlay not to copy our buffer. We will erase the buffer in the 'SendComplete event dpp.SendTo mlToPlayerID, moBuf, mlTimeOut, DPNSEND_NOLOOPBACK Or DPNSEND_NOCOPY mlLastSendTime = timeGetTime End If End If 'Regardless of what's going on, we should update our ui UpdateStats End Sub Private Sub UpdateStats() Dim lNumMsgs As Long, lNumBytes As Long Dim lCurTime As Long Dim sText As String, dpnInfo As DPN_CONNECTION_INFO Dim lNumMsgHigh As Long, lNumByteHigh As Long Dim lNumMsgNormal As Long, lNumByteNormal As Long Dim lNumMsgLow As Long, lNumByteLow As Long Dim lDrops As Long, lSends As Long Dim lPlayerID As Long On Error Resume Next Static lLastTime As Long If lLastTime = 0 Then lLastTime = timeGetTime lCurTime = timeGetTime If (lCurTime - lLastTime) < 1000 Then Exit Sub 'We don't need to update more than once a second Dim nSecondsPassed As Single, nDataIn As Single Dim nDataOut As Single nSecondsPassed = (lCurTime - lLastTime) / 1000 nDataIn = mlDataReceived / nSecondsPassed nDataOut = mlDataSent / nSecondsPassed lLastTime = lCurTime mlDataReceived = 0 mlDataSent = 0 lblSendRate.Caption = Format$(CStr(nDataOut), "0.0#") lblReceive.Caption = Format$(CStr(nDataIn), "0.0#") If cboInfoTarget.ListIndex >= 0 Then lPlayerID = cboInfoTarget.ItemData(cboInfoTarget.ListIndex) If lPlayerID <> 0 Then 'Update the connection info dpnInfo = dpp.GetConnectionInfo(lPlayerID, 0) dpp.GetSendQueueInfo lPlayerID, lNumMsgHigh, lNumByteHigh, DPNGETSENDQUEUEINFO_PRIORITY_HIGH dpp.GetSendQueueInfo lPlayerID, lNumMsgLow, lNumByteLow, DPNGETSENDQUEUEINFO_PRIORITY_LOW dpp.GetSendQueueInfo lPlayerID, lNumMsgNormal, lNumByteNormal, DPNGETSENDQUEUEINFO_PRIORITY_NORMAL lDrops = dpnInfo.lPacketsDropped + dpnInfo.lPacketsRetried lDrops = lDrops * 10000 lSends = dpnInfo.lPacketsSentGuaranteed + dpnInfo.lPacketsSentNonGuaranteed If lSends > 0 Then lDrops = lDrops \ lSends sText = "Send Queue Messages High Priority=" & CStr(lNumMsgHigh) & vbCrLf sText = sText & "Send Queue Bytes High Priority=" & CStr(lNumByteHigh) & vbCrLf sText = sText & "Send Queue Messages Normal Priority=" & CStr(lNumMsgNormal) & vbCrLf sText = sText & "Send Queue Bytes Normal Priority=" & CStr(lNumByteNormal) & vbCrLf sText = sText & "Send Queue Messages Low Priority=" & CStr(lNumMsgLow) & vbCrLf sText = sText & "Send Queue Bytes Low Priority=" & CStr(lNumByteLow) & vbCrLf sText = sText & "Round Trip Latency MS=" & CStr(dpnInfo.lRoundTripLatencyMS) & " ms" & vbCrLf sText = sText & "Throughput BPS=" & CStr(dpnInfo.lThroughputBPS) & vbCrLf sText = sText & "Peak Throughput BPS=" & CStr(dpnInfo.lPeakThroughputBPS) & vbCrLf sText = sText & "Bytes Sent Guaranteed=" & CStr(dpnInfo.lBytesSentGuaranteed) & vbCrLf sText = sText & "Packets Sent Guaranteed=" & CStr(dpnInfo.lPacketsSentGuaranteed) & vbCrLf sText = sText & "Bytes Sent Non-Guaranteed=" & CStr(dpnInfo.lBytesSentNonGuaranteed) & vbCrLf sText = sText & "Packets Sent Non-Guaranteed=" & CStr(dpnInfo.lPacketsSentNonGuaranteed) & vbCrLf sText = sText & "Bytes Retried Guaranteed=" & CStr(dpnInfo.lBytesRetried) & vbCrLf sText = sText & "Packets Retried Guaranteed=" & CStr(dpnInfo.lPacketsRetried) & vbCrLf sText = sText & "Bytes Dropped Non-Guaranteed=" & CStr(dpnInfo.lBytesDropped) & vbCrLf sText = sText & "Packets Dropped Non-Guaranteed=" & CStr(dpnInfo.lPacketsDropped) & vbCrLf sText = sText & "Messages Transmitted High Priority=" & CStr(dpnInfo.lMessagesTransmittedHighPriority) & vbCrLf sText = sText & "Messages Timed Out High Priority=" & CStr(dpnInfo.lMessagesTimedOutHighPriority) & vbCrLf sText = sText & "Messages Transmitted Normal Priority=" & CStr(dpnInfo.lMessagesTransmittedNormalPriority) & vbCrLf sText = sText & "Messages Timed Out Normal Priority=" & CStr(dpnInfo.lMessagesTimedOutNormalPriority) & vbCrLf sText = sText & "Messages Transmitted Low Priority=" & CStr(dpnInfo.lMessagesTransmittedLowPriority) & vbCrLf sText = sText & "Messages Timed Out Low Priority=" & CStr(dpnInfo.lMessagesTimedOutLowPriority) & vbCrLf sText = sText & "Bytes Received Guaranteed=" & CStr(dpnInfo.lBytesReceivedGuaranteed) & vbCrLf sText = sText & "Packets Received Guaranteed=" & CStr(dpnInfo.lPacketsReceivedGuaranteed) & vbCrLf sText = sText & "Bytes Received Non-Guaranteed=" & CStr(dpnInfo.lBytesReceivedNonGuaranteed) & vbCrLf sText = sText & "Packets Received Non-Guaranteed=" & CStr(dpnInfo.lPacketsReceivedNonGuaranteed) & vbCrLf sText = sText & "Messages Received=" & CStr(dpnInfo.lMessagesReceived) & vbCrLf sText = sText & "Loss Rate=" & CStr(lDrops \ 100) & "." & CStr(lDrops Mod 100) & vbCrLf txtInfo.Text = sText Else txtInfo.Text = vbNullString End If End If End Sub Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean) 'VB requires that we must implement *every* member of this interface End Sub Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean) 'VB requires that we must implement *every* member of this interface End Sub Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean) 'VB requires that we must implement *every* member of this interface End Sub Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean) If dpnotify.hResultCode <> 0 Then 'For some reason we could not connect. All available slots must be closed. MsgBox "Connect Failed. Error: 0x" & CStr(Hex$(dpnotify.hResultCode)) & " - This sample will now close.", vbOKOnly Or vbCritical, "Closing" DPlayEventsForm.CloseForm Me End If End Sub Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean) 'VB requires that we must implement *every* member of this interface End Sub Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean) Dim lCount As Long Dim dpPeer As DPN_PLAYER_INFO 'When someone joins add them to the 'Target' combo box 'and update the number of players list dpPeer = dpp.GetPeerInfo(lPlayerID) If (dpPeer.lPlayerFlags And DPNPLAYER_LOCAL) = 0 Then 'This isn't me add this user cboTarget.AddItem dpPeer.Name cboTarget.ItemData(cboTarget.ListCount - 1) = lPlayerID cboInfoTarget.AddItem dpPeer.Name cboInfoTarget.ItemData(cboInfoTarget.ListCount - 1) = lPlayerID End If 'Update our player count,and enable the send button (if need be) lblPlayers.Caption = CStr(cboTarget.ListCount) cmdSend.Enabled = (cboTarget.ListCount > 1) End Sub Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean) 'VB requires that we must implement *every* member of this interface End Sub Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean) Dim lCount As Long Dim dpPeer As DPN_PLAYER_INFO 'Remove this player from our list For lCount = 0 To cboTarget.ListCount - 1 If cboTarget.ItemData(lCount) = lPlayerID Then 'This is the player cboTarget.RemoveItem lCount Exit For End If Next For lCount = 0 To cboInfoTarget.ListCount - 1 If cboInfoTarget.ItemData(lCount) = lPlayerID Then 'This is the player cboInfoTarget.RemoveItem lCount Exit For End If Next 'Update our player count,and enable the send button (if need be) lblPlayers.Caption = CStr(cboTarget.ListCount) cmdSend.Enabled = (cboTarget.ListCount > 1) 'If we are sending, and there is no one left to send to, or the person we were sending too left, stop sending If (mfSending) And ((cboTarget.ListCount = 0) Or (mlToPlayerID = lPlayerID)) Then cmdSend_Click If cboInfoTarget.ListIndex < 0 Then cboInfoTarget.ListIndex = 0 If cboTarget.ListIndex < 0 Then cboTarget.ListIndex = 0 End Sub Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean) 'VB requires that we must implement *every* member of this interface End Sub Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean) 'VB requires that we must implement *every* member of this interface End Sub Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean) Dim dpPeer As DPN_PLAYER_INFO dpPeer = dpp.GetPeerInfo(lNewHostID) If (dpPeer.lPlayerFlags And DPNPLAYER_LOCAL) = DPNPLAYER_LOCAL Then 'I am the new host Me.Caption = Me.Caption & " (HOST)" End If End Sub Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean) 'VB requires that we must implement *every* member of this interface End Sub Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean) 'VB requires that we must implement *every* member of this interface End Sub Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean) 'VB requires that we must implement *every* member of this interface End Sub Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean) 'All we care about in this demo is what msgs we receive. Dim lMsg As Long, lOffset As Long Dim oPacket As PacketInfo With dpnotify GetDataFromBuffer .ReceivedData, lMsg, LenB(lMsg), lOffset Select Case lMsg Case MSG_GamePacket 'We received a packet 'Update the UI showing we received the packet GetDataFromBuffer .ReceivedData, oPacket, LenB(oPacket), lOffset moReceived.Add CStr(dpnotify.idSender) & ";" & CStr(oPacket.lPacketID) & ";" & CStr(oPacket.lDataSize) Case MSG_PacketReceive 'They received a packet we sent 'Update the UI showing we received the packet GetDataFromBuffer .ReceivedData, oPacket, LenB(oPacket), lOffset AppendText "Sent packet #" & CStr(oPacket.lPacketID) & " to " & GetName(dpnotify.idSender) & " - Size:" & CStr(oPacket.lDataSize) End Select End With End Sub Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean) If dpnotify.hResultCode = DPNERR_TIMEDOUT Then 'our packet timed out AppendText "Packet Timed Out... " End If 'The send has completed, so DPlay no longer has a need for our 'buffer, so we can get rid of it now. Erase moByte Erase moBuf 'Allow the next send to happen mfInSend = False End Sub Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean) 'This connection has been terminated. If dpnotify.hResultCode = DPNERR_HOSTTERMINATEDSESSION Then MsgBox "The host has terminated this session. This sample will now exit.", vbOKOnly Or vbInformation, "Exiting" Else MsgBox "This session has been lost. This sample will now exit.", vbOKOnly Or vbInformation, "Exiting" End If DPlayEventsForm.CloseForm Me End Sub