Attribute VB_Name = "modDplay"
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  Copyright (C) 2000 Microsoft Corporation.  All Rights Reserved.
'
'  File:       modDPlay.bas
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Here are all of the messages we can transfer in this app
Public Enum vbMsgType
    MsgChat 'We are talking in the chat channel
    MsgWhisper 'We are whispering to someone in the chat channel
    MsgAskToJoin 'We want to ask if we can join this session
    MsgAcceptJoin 'Accept the call
    MsgRejectJoin 'Reject the call
    MsgCancelCall 'Cancel the call
    MsgShowChat 'Show the chat window
    MsgSendFileRequest 'Request a file transfer
    MsgSendFileAccept 'Accept the file transfer
    MsgSendFileDeny 'Deny the file transfer
    MsgSendFileInfo 'File information (size)
    MsgSendFilePart 'Send a chunk of the file
    MsgAckFilePart 'Acknowledge the file part
    MsgSendDrawPixel 'Send a drawn pixel
    MsgSendDrawLine 'Send a drawn line
    MsgShowWhiteBoard 'Show the whiteboard window
    MsgClearWhiteBoard 'Clear the contents of the whiteboard
End Enum

'Win32 declares
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    sTip As String * 64
End Type
    
Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIF_DOALL = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONUP = &H205

'Constants
Public Const AppGuid = "{9073823A-A565-4865-87EC-19B93B014D27}"
Public Const glDefaultPort As Long = 9987

'DirectX variables
Public dx As DirectX8
Public dpp As DirectPlay8Peer
Public dvClient As DirectPlayVoiceClient8
Public dvServer As DirectPlayVoiceServer8

'Window variables for this app
Public ChatWindow As frmChat
Public WhiteBoardWindow As frmWhiteBoard
Public NetWorkForm As frmNetwork

'Misc app variables
Public sysIcon As NOTIFYICONDATA
Public gsUserName As String
Public glAsyncEnum As Long
Public glMyPlayerID As Long
Public gfHost As Boolean

Public Sub Main()
    If App.PrevInstance Then
        'We can only run one instance of this sample per machine since we
        'specify a port to run this application on.  Only one application can
        'be listening (hosting) on a particular port at any given time.
        MsgBox "Only one instance of vbConferencer may be run at a time.", vbOKOnly Or vbInformation, "Only one"
        Exit Sub
    End If
    'Set our username up
    gsUserName = GetSetting("VBDirectPlay", "Defaults", "UserName", vbNullString)
    If gsUserName = vbNullString Then
        'If there is not a default username, then pick the currently
        'logged on username
        gsUserName = Space$(255)
        GetUserName gsUserName, 255
        gsUserName = Left$(gsUserName, InStr(gsUserName, Chr$(0)) - 1)
    End If
    Screen.MousePointer = vbHourglass
    'Show the splash screen
    frmSplash.Show
    'Start the host
    Set NetWorkForm = New frmNetwork
    Load NetWorkForm
    'We don't need it anymore
    Unload frmSplash
    Screen.MousePointer = vbNormal
    NetWorkForm.Show
End Sub

Public Sub InitDPlay()
    Set dx = New DirectX8
    Set dpp = dx.DirectPlayPeerCreate
End Sub

Public Sub Cleanup()
    On Error Resume Next
    Set ChatWindow = Nothing
    Set WhiteBoardWindow = Nothing
    If Not dpp Is Nothing Then dpp.UnRegisterMessageHandler 'Stop taking messages
    If Not (dvClient Is Nothing) Then dvClient.UnRegisterMessageHandler
    If Not (dvServer Is Nothing) Then dvServer.UnRegisterMessageHandler
    'Lets wait right here for a second letting things finish cleaning up
    Sleep 50
    DoEvents
    If Not (dvClient Is Nothing) Then dvClient.Disconnect DVFLAGS_SYNC
    If Not (dvServer Is Nothing) Then dvServer.StopSession 0
    'Close our peer connection
    If Not dpp Is Nothing Then dpp.Close
    'Destroy the objects
    Set dvClient = Nothing
    Set dvServer = Nothing
    'Lose references to peer and dx objects
    Set dpp = Nothing
    Set dx = Nothing
End Sub

Public Sub StartHosting(MsgForm As Form)
    Dim dpa As DirectPlay8Address
    Dim oPlayer As DPN_PLAYER_INFO
    Dim oAppDesc As DPN_APPLICATION_DESC
    
    'Make sure we're ready to host
    Cleanup
    InitDPlay
    NetWorkForm.cmdHangup.Enabled = False
    NetWorkForm.cmdCall.Enabled = True
    gfHost = True
    'Register the Message Handler
    dpp.RegisterMessageHandler MsgForm
    'Set the peer info
    oPlayer.lInfoFlags = DPNINFO_NAME
    oPlayer.Name = gsUserName
    dpp.SetPeerInfo oPlayer, DPNOP_SYNC
    'Create an address
    Set dpa = dx.DirectPlayAddressCreate
    'We will only be connecting via TCP/IP
    dpa.SetSP DP8SP_TCPIP
    dpa.AddComponentLong DPN_KEY_PORT, glDefaultPort
    
    'First set up our application description
    With oAppDesc
        .guidApplication = AppGuid
        .lMaxPlayers = 10 'We don't want to overcrowd our 'room'
        .lFlags = DPNSESSION_NODPNSVR
    End With
    'Start our host
    dpp.Host oAppDesc, dpa
    Set dpa = Nothing
        
    'After we've created the session and let's start
    'the DplayVoice server
    Dim oSession As DVSESSIONDESC

    'Create our DPlayVoice Server
    Set dvServer = dx.DirectPlayVoiceServerCreate

    'Set up the Session
    oSession.lBufferAggressiveness = DVBUFFERAGGRESSIVENESS_DEFAULT
    oSession.lBufferQuality = DVBUFFERQUALITY_DEFAULT
    oSession.lSessionType = DVSESSIONTYPE_PEER
    oSession.guidCT = vbNullString

    'Init and start the session
    dvServer.Initialize dpp, 0
    dvServer.StartSession oSession, 0
    ConnectVoice
    Set dpa = Nothing
End Sub

Public Sub Connect(MsgForm As Form, ByVal sHost As String)
    Dim dpa As DirectPlay8Address
    Dim dpl As DirectPlay8Address
    Dim oPlayer As DPN_PLAYER_INFO
    Dim oAppDesc As DPN_APPLICATION_DESC
    
    'Try to connect to the host
    'Make sure we're ready to connect
    Cleanup
    InitDPlay
    NetWorkForm.cmdCall.Enabled = False
    gfHost = False
    'Register the Message Handler
    dpp.RegisterMessageHandler MsgForm
    'Set the peer info
    oPlayer.lInfoFlags = DPNINFO_NAME
    oPlayer.Name = gsUserName
    dpp.SetPeerInfo oPlayer, DPNOP_SYNC
    'Now try to enum hosts
    
    'Create an address
    Set dpa = dx.DirectPlayAddressCreate
    'We will only be connecting via TCP/IP
    dpa.SetSP DP8SP_TCPIP
    dpa.AddComponentString DPN_KEY_HOSTNAME, sHost 'We only want to enumerate connections on this host
    dpa.AddComponentLong DPN_KEY_PORT, glDefaultPort
    
    Set dpl = dx.DirectPlayAddressCreate
    'We will only be connecting via TCP/IP
    dpl.SetSP DP8SP_TCPIP
    
    'First set up our application description
    With oAppDesc
        .guidApplication = AppGuid
    End With
    'Try to connect to this host
    dpp.Connect oAppDesc, dpa, dpl, 0, ByVal 0&, 0
    Set dpa = Nothing
    Set dpl = Nothing
End Sub

Public Sub ConnectVoice()
    Dim oSound As DVSOUNDDEVICECONFIG
    Dim oClient As DVCLIENTCONFIG
    'Now create a client as well (so we can both talk and listen)
    Set dvClient = dx.DirectPlayVoiceClientCreate
    'Now let's create a client event..
    dvClient.Initialize dpp, 0
    'Set up our client and sound structs
    oClient.lFlags = DVCLIENTCONFIG_AUTOVOICEACTIVATED Or DVCLIENTCONFIG_AUTORECORDVOLUME
    oClient.lBufferAggressiveness = DVBUFFERAGGRESSIVENESS_DEFAULT
    oClient.lBufferQuality = DVBUFFERQUALITY_DEFAULT
    oClient.lNotifyPeriod = 0
    oClient.lThreshold = DVTHRESHOLD_UNUSED
    oClient.lPlaybackVolume = DVPLAYBACKVOLUME_DEFAULT
    oSound.hwndAppWindow = NetWorkForm.hwnd
    
    On Error Resume Next
    'Connect the client
    dvClient.Connect oSound, oClient, 0
    If Err.Number = DVERR_RUN_SETUP Then    'The audio tests have not been run on this
                                            'machine.  Run them now.
        'we need to run setup first
        Dim dvSetup As DirectPlayVoiceTest8
        
        Set dvSetup = dx.DirectPlayVoiceTestCreate
        dvSetup.CheckAudioSetup vbNullString, vbNullString, NetWorkForm.hwnd, 0 'Check the default devices since that's what we'll be using
        Set dvSetup = Nothing
        dvClient.Connect oSound, oClient, 0
    ElseIf Err.Number <> 0 And Err.Number <> DVERR_PENDING Then
        MsgBox "Could not start DirectPlayVoice.  This sample will not have any voice capablities." & vbCrLf & "Error:" & CStr(Err.Number), vbOKOnly Or vbInformation, "No Voice"
        Exit Sub
    End If
    On Error GoTo 0
    Dim lTargets(0) As Long
    
    lTargets(0) = DVID_ALLPLAYERS
    On Error Resume Next
    'Connect the client
    dvClient.SetTransmitTargets lTargets, 0
    If Err.Number <> 0 And Err.Number <> DVERR_PENDING Then
        MsgBox "Could not start DirectPlayVoice.  This sample will not have any voice capablities." & vbCrLf & "Error:" & CStr(Err.Number), vbOKOnly Or vbInformation, "No Voice"
        Exit Sub
    End If
End Sub
