home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / DirectX8 / dx8vbsdk.exe / samples / multimedia / vbsamples / directplay / dxvbmessenger / server / moddplayserver.bas < prev    next >
Encoding:
BASIC Source File  |  2000-10-02  |  2.6 KB  |  89 lines
  1. Attribute VB_Name = "modDPlayServer"
  2. Option Explicit
  3. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  4. '
  5. '  Copyright (C) 2000 Microsoft Corporation.  All Rights Reserved.
  6. '
  7. '  File:       modDPlayServer.bas
  8. '
  9. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  10.  
  11. 'Public vars for the app
  12. Public dx As New DirectX8
  13. Public dps As DirectPlay8Server
  14. Public dpa As DirectPlay8Address
  15. Public glNumPlayers As Long
  16.  
  17. Public Sub Main()
  18.     If App.PrevInstance Then
  19.         MsgBox "You can only run one instance of this server at a time.", vbOKOnly Or vbInformation, "Close other instance"
  20.         Exit Sub
  21.     End If
  22.     'Set up the default DPlay objects
  23.     InitDPlay
  24.     'Show the form (which will start the server)
  25.     frmServer.Show
  26. End Sub
  27.  
  28. Public Sub InitDPlay()
  29.  
  30.     Set dps = dx.DirectPlayServerCreate
  31.     Set dpa = dx.DirectPlayAddressCreate
  32.     
  33. End Sub
  34.  
  35. Public Sub Cleanup()
  36.  
  37.     'Shut down our message handler
  38.     If Not dps Is Nothing Then dps.UnRegisterMessageHandler
  39.     'Close down our session
  40.     If Not dps Is Nothing Then dps.Close
  41.     Set dps = Nothing
  42.     Set dpa = Nothing
  43.     Set dx = Nothing
  44.     
  45. End Sub
  46.  
  47. 'Send a message to a player
  48. Public Function SendMessage(ByVal sUser As String, ByVal sFrom As String, ByVal sChat As String) As Boolean
  49.  
  50.     Dim lSendID As Long, lMsg As Long
  51.     Dim oBuf() As Byte, lOffset As Long
  52.     
  53.     lSendID = GetCurrentDPlayID(sUser)
  54.     If lSendID = 0 Then SendMessage = False 'This person isn't logged on
  55.     'Before we send this message check to see if this user is blocked
  56.     If AmIBlocked(sUser, sFrom) Then
  57.         lMsg = Msg_UserBlocked
  58.         lOffset = NewBuffer(oBuf)
  59.         AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
  60.         AddStringToBuffer oBuf, sUser, lOffset
  61.         dps.SendTo lSendID, oBuf, 0, 0
  62.     Else
  63.         lMsg = Msg_ReceiveMessage
  64.         lOffset = NewBuffer(oBuf)
  65.         AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
  66.         AddStringToBuffer oBuf, sFrom, lOffset
  67.         AddStringToBuffer oBuf, sChat, lOffset
  68.         dps.SendTo lSendID, oBuf, 0, 0
  69.     End If
  70.     SendMessage = True
  71.  
  72. End Function
  73.  
  74. Public Sub LogInfo(ByVal sLog As String)
  75.  
  76.     #If LOGGING = 1 Then 'Do nothing if there is no logging
  77.     
  78.         Dim lFile As Long
  79.         
  80.         'Open the log file
  81.         lFile = FreeFile
  82.         Open App.Path & "\srv.txt" For Append As #lFile
  83.         Print #lFile, sLog
  84.         Close #lFile
  85.     #End If
  86.  
  87. End Sub
  88.  
  89.