Здесь будут описаны основные принципы работы DirectPlay, а также описан процесс создания программы-чата с возможностью передачи файлов.
DirectPlay - это компонент DirectX, с помощью которого Вы можете создавать сетевые приложения, например, сетевые игры. В DirectPlay есть два вида сетевых подключений: peer-to-peer и client-server.
Так схематически выглядит peer-to-peer игра:
Видно, что при таком соединении информация идёт от каждого компьютера к каждому. Все игроки равноправны. Один из игроков при этом является хостом. Он ничем не отличается от остальных игроков, просто его компьютер отвечает за подключение новых игроков и т.п. С ростом количества игроков, количество сообщений, необходимых для того, чтобы синхронизировать игру, растёт квадатично. Это подходит только для небольшого количества игроков. Преимуществом такой технологии является простота написания программ.
Так выглядит схема client-server игры:
Здесь компьютеры игроков подсоединены к серверу. Сервер выполняет следующие функции:
Передаёт сообщения игроков друг другу. Каждый компьютер посылает сообщения только на сервер, который пересылает их другим игрокам. Это подходит для большого количества игроков.
Сервер выполняет задачи, которые выполнял хост в peer-to-peer игре.
Сервер, как правило, делает гораздо больше, чем просто контролирует обмен сообщениями. "Игровая вселенная" (например, в MMORPG) существует именно на сервере. Клиенты же отвечают только за пересылку на сервер информации о действиях игроков.
Далее будет говориться о peer-to-peer подключении.
В библиотеке DirectX 8 for visual Basic Type Library для peer-to-peer игр существует объект DirectPlay8Peer. Он инициализируется следующим образом:
'Public dx As New DirectX8
'Public dpp As DirectPlay8Peer
Set dpp = dx.DirectPlayPeerCreate
После того, как объект DirectPlay8Peer был создан, необходимо установить объект, который будет реализовывать события DirectPlay. Для этого нужно вставить в раздел объявлений этого объекта (например, формы) следующую строку:
Implements DirectPlay8Event
После этого нужно написать реализации методов класса DirectPlay8Event. У него есть следующие события:
Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_CreateGroup(ByVal lGroupID As Long, ByVal lOwnerID As Long, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_CreatePlayer(ByVal lPlayerID As Long, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_DestroyGroup(ByVal lGroupID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_DestroyPlayer(ByVal lPlayerID As Long, ByVal lReason As Long, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_EnumHostsQuery(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_QUERY, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_EnumHostsResponse(dpnotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_HostMigrate(ByVal lNewHostID As Long, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_IndicateConnect(dpnotify As DxVBLibA.DPNMSG_INDICATE_CONNECT, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_IndicatedConnectAborted(fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_InfoNotify(ByVal lMsgID As Long, ByVal lNotifyID As Long, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_Receive(dpnotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_SendComplete(dpnotify As DxVBLibA.DPNMSG_SEND_COMPLETE, fRejectMsg As Boolean)
End Sub
Private Sub DirectPlay8Event_TerminateSession(dpnotify As DxVBLibA.DPNMSG_TERMINATE_SESSION, fRejectMsg As Boolean)
End Sub
Большинтво этих процедур так и останется пустыми, но все они должны быть вставлены в код объекта, реализующего обработку DirectPlay событий.
После этого можно зарегистрировать объект - обработчик событий, как показано ниже:
'frmConnect - объект класса Form,
'реализующий методы класса DirectPlay8Event
dpp.RegisterMessageHandler frmConnect
Перед тем, как зарегистрировать в качестве обработчика событий другой объект, надо воспользоваться методом UnRegisterMessageHandler.
Следующее, что надо сделать - выбрать способ сетевого подключения. DirectPlay поддерживает соединения по протоколу TCP/IP, по модему, с использованием последовательного порта. Метод GetCountServiceProviders объекта DirectPlay8Peer возвращает количество возможных способов сетевых подключений, а метод GetServiceProvider - информацию о конкретном способе подключения. Ниже приведён пример кода, который выводит названия всех способов подключения в элемент управления ListBox.
Dim i As Integer
Dim dpnSPInfo As DPN_SERVICE_PROVIDER_INFO
For i = 1 To dpp.GetCountServiceProviders
dpnSPInfo = dpp.GetServiceProvider(i)
List1.AddItem dpnSPInfo.Name
Next
Теперь мы создадим объект класса DirectPlay8Address, который будет нужен далее, а также выберем один из способов подключения.
Set dpAddres = dx.DirectPlayAddressCreate
dpAddres.SetSP dpp.GetServiceProvider(List1.ListIndex + 1).Guid
После этого у нас есть два варианта: создать новую сессию и стать в ней хостом или подключиться к существующей сессии.
Создание новой сессии может осуществляться, например, такой процедурой:
Public Sub CreateHost()
bHost = True
Dim pInfo As DPN_PLAYER_INFO
Dim AppDesc As DPN_APPLICATION_DESC
With AppDesc
.guidApplication = AppGUID 'Уникальный идентификатор приложения
.lMaxPlayers = iMaxPlayers 'Максимальное количество игроков в сессии
.SessionName = sGameName 'Название сессии
If bHostMigrate Then
'Хост может меняться в процессе игры
.lFlags = .lFlags Or DPNSESSION_MIGRATE_HOST
End If
End With
pInfo.Name = sUserName
pInfo.lInfoFlags = DPNINFO_NAME
dpp.SetPeerInfo pInfo, DPNOP_SYNC
dpp.Host AppDesc, dpAddres, DPNHOST_OKTOQUERYFORADDRESSING
Set dpAddres = Nothing
End Sub
GUID используется для того, чтобы подключающиеся друг к другу приложения были одинаковыми. GUID - это строка, которая представляет из себя что-то вроде "{BC4B94BF-7DCE-45EA-B73D-1249C17385C2}". Для генерации своего собственного GUID удобно пользоваться методом CreateNewGuid объекта DirectX8 (создание случайного GUID).
Для подключения к уже существующей сессии нужно сначала вывести в список все сессии, к которым можно подключиться, затем пользователь выбирет из списка нужную ему сессию.
Сначала нужно начать поиск хостов.
Dim Desc As DPN_APPLICATION_DESC
Desc.guidApplication = AppGUID
mEnumAsync = dpp.EnumHosts(Desc, Nothing, dpAddres, INFINITE, 0, INFINITE, DPNENUMHOSTS_OKTOQUERYFORADDRESSING, ByVal 0&, 0)
Закончить поиск можно следующим образом:
If mEnumAsync <> 0 Then dpp.CancelAsyncOperation mEnumAsync, 0
Когда какой-то хост будет найден, произойдёт событие DirectPlay8Event. Так может выглядеть его обработчик:
Private Sub DirectPlay8Event_EnumHostsResponse(dpNotify As DxVBLibA.DPNMSG_ENUM_HOSTS_RESPONSE, fRejectMsg As Boolean)
AddHostsToListBox dpNotify
End Sub
Информацию из структуры типа DPNMSG_ENUM_HOSTS_RESPONSE можно извлечь, например, так:
'Private Type HostFound
' AppDesc As DPN_APPLICATION_DESC
' AddressHost As String
' AddressDevice As String
' TimeLastFound As Long
' SInfo As String
'End Type
'Dim mHosts() As HostFound
Private Sub AddHostsToListBox(fHost As DPNMSG_ENUM_HOSTS_RESPONSE)
'Здесь мы добавляем хост в список
If Not bSearch Then Exit Sub
Dim i As Integer
Dim Found As Boolean
For i = 0 To iHostCount
If mHosts(i).AppDesc.guidInstance = fHost.ApplicationDescription.guidInstance Then
'Этот хост уже был найден ранее
mHosts(i).TimeLastFound = GetTickCount
Found = True
With fHost.ApplicationDescription
mHosts(i).SInfo = .SessionName & " - " & CStr(.lCurrentPlayers) & "/" & CStr(.lMaxPlayers) & " - Latency:" & CStr(fHost.lRoundTripLatencyMS) & " ms"
End With
Exit For
End If
Next
If Not Found Then
ReDim Preserve mHosts(iHostCount + 1)
mHosts(iHostCount + 1).AppDesc = fHost.ApplicationDescription
mHosts(iHostCount + 1).AddressHost = fHost.AddressSenderUrl
mHosts(iHostCount + 1).AddressDevice = fHost.AddressDeviceUrl
With fHost.ApplicationDescription
mHosts(iHostCount + 1).SInfo = .SessionName & " - " & CStr(.lCurrentPlayers) & "/" & CStr(.lMaxPlayers) & " - Latency:" & CStr(fHost.lRoundTripLatencyMS) & " ms"
End With
'Записываем время, когда хост был найден последний раз
mHosts(iHostCount + 1).TimeLastFound = GetTickCount
iHostCount = iHostCount + 1
End If
End Sub
К выбранному хосту подключаемся с помощью процедуры ConnectToHost.
'Private Sub DirectPlay8Event_ConnectComplete(dpNotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
'bGotEvent = True
'If dpNotify.hResultCode = DPNERR_SESSIONFULL Then 'Подсоединилось слишком много людей
' MsgBox "К этой сессии уже подключилось максимальное количество игроков. Выберите другую сессию или создайте свою собственную.", vbOKOnly Or vbInformation, App.Title
'Else
' bConnectComplete = True
'End If
'End Sub
Private Sub ConnectToHost(hHost As HostFound)
Dim HostAddr As DirectPlay8Address
Dim DeviceAddr As DirectPlay8Address
Dim dpApp As DPN_APPLICATION_DESC
'Подсоединяемся к игре
Dim pInfo As DPN_PLAYER_INFO
'Устанавливаем информацию о нашем игроке
pInfo.Name = sUserName
pInfo.lInfoFlags = DPNINFO_NAME
dpp.SetPeerInfo pInfo, DPNOP_SYNC
With hHost.AppDesc
dpApp.guidApplication = .guidApplication
dpApp.guidInstance = .guidInstance
iMaxPlayers = .lMaxPlayers
End With
bGotEvent = False
bConnectComplete = False
'Получаем адрес хоста
If hHost.AddressHost <> vbNullString Then
Set HostAddr = dx.DirectPlayAddressCreate
HostAddr.BuildFromURL hHost.AddressHost
Else
Set HostAddr = dpAddres
End If
If mHosts(List2.ItemData(List2.ListIndex)).AddressDevice <> vbNullString Then
Set DeviceAddr = dx.DirectPlayAddressCreate
DeviceAddr.BuildFromURL hHost.AddressDevice
Else
Set DeviceAddr = dpAddres
End If
dpp.Connect dpApp, HostAddr, DeviceAddr, DPNCONNECT_OKTOQUERYFORADDRESSING, ByVal 0&, 0
Do While Not bGotEvent 'ждём, пока не произойдёт событие СonnectСomplete
DoSleep 5 'Ждём 5 милисекунд
Loop
If bConnectComplete Then
'Мы подсоединились к игре
bHost = False
'Очищаем адреса
Set HostAddr = Nothing
Set DeviceAddr = Nothing
Set dpAddres = Nothing
dpp.UnRegisterMessageHandler
frmChat.Show
Unload Me
End If
End Sub
Теперь, когда соединение установлено, всё просто - остаётся только отправлять и получать сообщения :-) .
Послать сообщение можно при помощи метода SendTo объекта DirectPlay8Peer. Первый параметр этого метода - число типа Long, определяющее какому игроку мы посылаем сообщение, можно воспользоваться константой DPNID_ALL_PLAYERS_GROUP, чтобы послать сообщение всем игрокам, или послать сообщение конкретному игроку (его ID можно узнать в процедуре DirectPlay8Event_CreatePlayer); второй параметр - массив байтов, который содержит само сообщение; третий параметр - приоритет сообщения; четвёртый параметр - задержка в милисекундах перед отправкой сообщения; пятый параметр - совокупность флагов из набора констант CONST_DPNSENDFLAGS. Сам метод является функцией и возвращает асинхронный идентификатор данной операции (тип Long). Этот идентификатор можно использовать в методе CancelAsyncOperation, чтобы остановить данную операцию, если она совершается асинхронно.
Для заполнения буфера с сообщением можно пользоваться процедурами AddDataToBuffer и AddStringToBuffer.
Sub AddDataToBuffer(Buffer() As Byte, lData As Any, lSize As Long, lOffset As Long)
'lData - переменная, которую мы записываем в буфер
'lSize - размер предыдущей переменной в байтах
'lOffset - позиция, начиная с которой в буфере, мы будем записывать данные
Sub AddStringToBuffer(Buffer() As Byte, StringData As String, lOffset As Long)
'StringData - строка, помещаемая в буфер
Для того, чтобы в чате послать всем остальным игрокам текстовое сообщение, можно воспользоваться процедурой SendText.
'Const MSGChat As Long = 0
Public Sub SendText(sMessage As String)
Dim lMsg As Long, lOffset As Long
Dim oBuf() As Byte
'Посылаем это сообщение всем
lMsg = MSGChat
lOffset = NewBuffer(oBuf)
AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
AddStringToBuffer oBuf, sMessage, lOffset
dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_NOLOOPBACK
End Sub
Послать файл не намного сложнее. Это будет делать процедура SendFile.
'Const MSGFile As Long = 1
Public Sub SendFile(sFileName As String)
Dim lMsg As Long, lOffset As Long, lFileSize As Long
Dim oBuf() As Byte
Dim FileData() As Byte
'Посылаем этот файл всем
lMsg = MSGFile
lOffset = NewBuffer(oBuf)
lFileSize = FileLen(sFileName)
ReDim FileData(1 To lFileSize)
Open sFileName For Binary As #1
Get #1, 1, FileData 'Читаем данные с диска в массив FileData
Close #1
AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
'Записываем в буфер имя файла
AddStringToBuffer oBuf, sFileName, lOffset
'Записываем в буфер длину файла
AddDataToBuffer oBuf, lFileSize, LenB(lFileSize), lOffset
'Записываем в буфер данные из файла
AddDataToBuffer oBuf, FileData(1), lFileSize, lOffset
dpp.SendTo DPNID_ALL_PLAYERS_GROUP, oBuf, 0, DPNSEND_NOLOOPBACK
UpdateText "Вами был отправлен файл " & sFileName
End Sub
Таким образом, по первым четырём байтам сообщения (длина переменной типа Long) мы впоследствии можем определить, что нами было получено - файл или строка.
Чтобы научиться получать сообщения достаточно написать обработчик события Receive.
'Процедура UpdateText просто добавляет свой параметр в TextBox
Private Sub DirectPlay8Event_Receive(dpNotify As DxVBLibA.DPNMSG_RECEIVE, fRejectMsg As Boolean)
Dim sPeer As String
sPeer = dpp.GetPeerInfo(dpNotify.idSender).Name
Dim lMsg As Long, lOffset As Long, lFileSize As Long
Dim dpPeer As DPN_PLAYER_INFO
With dpNotify
GetDataFromBuffer .ReceivedData, lMsg, LenB(lMsg), lOffset
Select Case lMsg
Case MSGChat
Dim sChat As String
sChat = GetStringFromBuffer(.ReceivedData, lOffset)
UpdateText "<" & sPeer & ">" & sChat
Case MSGFile
Dim sFileName As String, iAns As Integer
Dim FileData() As Byte
sFileName = GetStringFromBuffer(.ReceivedData, lOffset)
GetDataFromBuffer .ReceivedData, lFileSize, LenB(lFileSize), lOffset
iAns = MsgBox(sPeer & " послал Вам файл." & vbCrLf & _
"Исходное имя файла: " & sFileName & "." & vbCrLf & _
"Размер файла: " & Str(lFileSize) & " байт." & vbCrLf & _
"Сохранить файл?", vbYesNo Or vbDefaultButton1 Or vbQuestion, App.Title)
If iAns = vbYes Then
CommonDialog1.FileName = vbNullString
CommonDialog1.flags = cdlOFNHideReadOnly Or cdlOFNOverwritePrompt
CommonDialog1.ShowSave
If CommonDialog1.FileName = vbNullString Then Exit Sub
ReDim FileData(1 To lFileSize)
GetDataFromBuffer .ReceivedData, FileData(1), lFileSize, lOffset
Open CommonDialog1.FileName For Binary As #1
Put #1, 1, FileData
Close #1
UpdateText "Вами был получен файл " & sFileName & _
" и сохранён под именем " & CommonDialog1.FileName
End If
End Select
End With
End Sub
Как видно, вся информация о полученном сообщении находится в структуре dpNotify. Из неё можно извлечь ID игрока, от которого получено сообщение (а по нему определить его имя). Кроме того, структура содержит буфер ReceivedData, который содержит ровно то, что мы в него помеcтили на этапе отправки сообщения. Извлекать информацию из буфера можно процедурой GetDataFromBuffer, а также функцией GetStringFromBuffer.
Sub GetDataFromBuffer(Buffer() As Byte, lData As Any, lSize As Long, lOffset As Long)
'lData - переменная, которую мы читаем из буфера
'lSize - размер предыдущей переменной в байтах
'lOffset - позиция, начиная с которой в буфере, мы будем читать данные
Function GetStringFromBuffer(Buffer() As Byte, lOffset As Long) As String
'Значение, возвращаемое функцией - строка, считываемая из буфера
Здесь было написано об основных принципах работы с DirectPlay, знания которых, как мне кажется, достаточно для написания простой сетевой программы.
Вы можете скачать RAR-архив с исходниками такой программы. Выше были приведены лишь ключевые места её кода. Эта программа - чат с возможностью передачи файлов от одного игрока к другому (здесь и ранее употреблялись слова "игра", "игрок" и т.д., т.к. основное назначение DirectPlay всё же написание сетевых игр).
Если у Вас нет локальной сети, то возможно тестировать программу на локальном компьютере. Для этого нужно пользоваться протоколом TCP/IP (необходимо запустить как минимум два экземпляра программы, в одной создать сессию, а в другой - подключиться к ней) и на зарос о вводе адреса удалённого компьютера ввести "127.0.0.1" (без кавычек) - это значит, что все сообщения будут идти от Вашего компьютера к Вашему же компьютеру. Свой ip-адрес в Internet или локальной сети можно узнать, набрав в консоли winipcfg (win98) или ipconfig (winNT/2000/XP). Кроме ip-адресов можно вводить имена компьютеров в локальной сети. После того, как подключение было завершено, для обмена сообщениями достаточно набрать текст в нижнем TextBox'е и нажать Enter.
