Option Explicit

Public DX As New DirectX7
Public DP As DirectPlay4
Public DPEnum As DirectPlayEnumConnections
Public DPAddress As DirectPlayAddress
Public Session As DirectPlaySessionData
Public DPEnumSessions As DirectPlayEnumSessions

Public PlayerIDNum As Long
Public PlayerFriendly As String
Public PlayerFormal As String

Public Const MyGuid As String = _
      "{8EC1E2EC-5266-11D4-811C-AD15B9B82C76}"

Public i As Integer

Public Sub DPInit()
  Set DP = DX.DirectPlayCreate("")
  Set DPEnum = _
        DP.GetDPEnumConnections("", DPCONNECTION_DIRECTPLAY)

  Form1.List1.Clear
  If DPEnum.GetCount > 0 Then
    For i = 1 To DPEnum.GetCount
      Form1.List1.AddItem DPEnum.GetName(i)
    Next i

    Form1.List1.ListIndex = 0
  Else
    MsgBox "!!!Achtung, es sind keine Protokolle installiert!!!"
    End
  End If
End Sub

Public Sub CreateSession(ByRef ConnectionIndex As Long)
  Set DPAddress = DPEnum.GetAddress(ConnectionIndex)
  Call DP.InitializeConnection(DPAddress)

  Set Session = DP.CreateSessionData
  Session.SetMaxPlayers 8
  Session.SetSessionName "ChatSession"
  Session.SetGuidApplication MyGuid

  Session.SetFlags _
        DPSESSION_DIRECTPLAYPROTOCOL Or DPSESSION_MIGRATEHOST

  Call DP.Open(Session, DPOPEN_CREATE)
  CreatePlayer

  Form1.Timer1.Enabled = True
End Sub

Public Sub RefreshGameList()
  Session.SetGuidApplication MyGuid
  Session.SetSessionPassword ""
  Set DPEnumSessions = _
      DP.GetDPEnumSessions(Session, 0, DPENUMSESSIONS_AVAILABLE)

  Form1.List2.Clear
  If DPEnumSessions.GetCount > 0 Then
    For i = 1 To DPEnumSessions.GetCount
      Set Session = DPEnumSessions.GetItem(i)
      Form1.List2.AddItem "[" & Session.GetCurrentPlayers & _
            "/" & Session.GetMaxPlayers & "] " & _
            Session.GetSessionName
    Next i
  Else
    Form1.List2.AddItem "Keine Spiele gefunden"
  End If
End Sub

Public Sub JoinSession()
  Set Session = DPEnumSessions.GetItem(Form1.List2.ListIndex + 1)

  If Session.GetMaxPlayers < Session.GetCurrentPlayers Then End

   'Das Spiel benutzt den erstellten GUID
  Session.SetGuidApplication MyGuid 

  DP.Open Session, DPOPEN_JOIN
  CreatePlayer

  Form1.Timer1.Enabled = True
End Sub

Public Sub CreatePlayer()
  PlayerFriendly = InputBox("NickName", "Create Player")
  PlayerFormal = InputBox("Formaler Name", "Create Player")

  PlayerIDNum = _
        DP.CreatePlayer(PlayerFriendly, PlayerFormal, 0, 0)
End Sub

Public Sub SendMessage()
  Dim Msg As DirectPlayMessage

  Set Msg = DP.CreateMessage

  Msg.WriteString PlayerFriendly & ": " & Form1.Text1.Text

  DP.SendEx PlayerIDNum, DPID_ALLPLAYERS, DPSEND_GUARANTEED, _
        Msg, 0, 0, 0

  Form1.List3.AddItem PlayerFriendly & ": " & Form1.Text1.Text
  Form1.Text1.Text = ""
End Sub

Public Sub ReceiveMessage()
  Dim SourceIP As Long
  Dim TargetIP As Long
  Dim NumMessagesWaiting As Long
  Dim Msg As DirectPlayMessage

  NumMessagesWaiting = DP.GetMessageCount(PlayerIDNum)
  
  Do While NumMessagesWaiting > 0
    Set Msg = DP.Receive(SourceIP, TargetIP, DPRECEIVE_ALL)

    Form1.List3.AddItem Msg.ReadString

    NumMessagesWaiting = NumMessagesWaiting - 1
  Loop
End Sub

Public Sub DPUnload()
  Set DPEnum = Nothing
  Set DPEnumSessions = Nothing
  Set DP = Nothing
End Sub

Public Sub ErrorAnalyzing(ByRef Error As ErrObject)
  Select Case Error.Number
    Case -2005466886
      MsgBox "Protokoll nicht vorhanden", vbCritical, "Fehler!"
    Case -2005466856
      MsgBox "Auswahl der Verbindung wurde abgebrochen", _
            vbExclamation, "Achtung!"
      DPUnload
      DPInit
    Case 5
      MsgBox "Formal-Name und Friendly-Name dürfen nicht " & _
             "gleich sein!", vbExclamation, "Achtung!"
      DPUnload
      DPInit
  End Select
End Sub

Option Explicit

Private Sub Command1_Click()
  On Error GoTo fehler:

  CreateSession List1.ListIndex + 1
  pnlConnect.Visible = False
  pnlChat.Visible = True
  Exit Sub

fehler:
  ErrorAnalyzing Err
End Sub

Private Sub Command2_Click()
  On Error GoTo fehler:

  Set DPAddress = DPEnum.GetAddress(List1.ListIndex + 1)
  DP.InitializeConnection DPAddress
  Set Session = DP.CreateSessionData

  pnlConnect.Visible = False
  pnlLogin.Visible = True
  RefreshGameList
  Exit Sub

fehler:
  ErrorAnalyzing Err
End Sub

Private Sub Command3_Click()
  If List2.ListIndex > -1 And DPEnumSessions.GetCount > 0 Then
    JoinSession
    pnlLogin.Visible = False
    pnlChat.Visible = True
  Else
    MsgBox "Wähle eine vorhandene Session!!!", _
        vbExclamation, "Fehler!"
  End If
End Sub

Private Sub Command4_Click()
  pnlLogin.Visible = False
  pnlConnect.Visible = True
  DPUnload
  DPInit
End Sub

Private Sub Command5_Click()
  DPUnload
  End
End Sub

Private Sub Command6_Click()
  RefreshGameList
End Sub

Private Sub Command7_Click()
  SendMessage
End Sub

Private Sub Form_Load()
  DPInit
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = 13 Then Command7_Click
End Sub

Private Sub Timer1_Timer()
  ReceiveMessage
End Sub