WebSVN – spacemission – Diff – /VCL_DELPHIX_D6/DXPlay.pas


unit DXPlay;
 
interface
 
{$INCLUDE DelphiXcfg.inc}
 
uses
  Windows, SysUtils, Classes, Forms, DXClass, ActiveX, DXETable,  
{$IfDef StandardDX}
  DirectDraw,
// Delphi 2010 cannot be use DirectPlay8 because structure was not rewriten
//  {$IfDef DX9}
//  DirectPlay8, DX7toDX8;
//  {$Else}
  DirectPlay; //old wersion, current in directory
//  {$EndIf}
{$Else}
  DirectX;
{$EndIf}
 
type
  {$IfDef DX9}
  TDPID = DWORD;
  {$EndIf}
 
  {  TDXPlayPlayer  }
 
  TDXPlayPlayer = class(TCollectionItem)
  private
    FData: Pointer;
    FID: TDPID;
    FName: string;
    FRemotePlayer: Boolean;
  public
    property Data: Pointer read FData write FData;
    property ID: TDPID read FID;
    property Name: string read FName;
    property RemotePlayer: Boolean read FRemotePlayer;
  end;
 
  {  TDXPlayPlayers  }
 
  TDXPlayPlayers = class(TCollection)
  private
    function GetPlayer(Index: Integer): TDXPlayPlayer;
  public
    constructor Create;
    function Find(ID: TDPID): TDXPlayPlayer;
    function IndexOf(ID: TDPID): Integer;
    property Players[Index: Integer]: TDXPlayPlayer read GetPlayer; default;
  end;
 
  {  TDXPlayModemSetting  }
 
  TDXPlayModemSetting = class(TPersistent)
  private
    FEnabled: Boolean;
    FPhoneNumber: string;
    FModemName: string;
    FModemNames: TStrings;
    function GetModemNames: TStrings;
  public
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property ModemName: string read FModemName write FModemName;
    property ModemNames: TStrings read GetModemNames;
  published
    property Enabled: Boolean read FEnabled write FEnabled;
    property PhoneNumber: string read FPhoneNumber write FPhoneNumber;
  end;
 
  {  TDXPlayTCPIPSetting  }
 
  TDXPlayTCPIPSetting = class(TPersistent)
  private
    FEnabled: Boolean;
    FHostName: string;
    FPort: Word;
  public
    procedure Assign(Source: TPersistent); override;
  published
    property Enabled: Boolean read FEnabled write FEnabled;
    property HostName: string read FHostName write FHostName;
    property Port: Word read FPort write FPort;
  end;
 
  {  EDXPlayError  }
 
  EDXPlayError = class(Exception);
 
  {  TCustomDXPlay  }
 
  TDXPlayEvent = procedure(Sender: TObject; Player: TDXPlayPlayer) of object;
 
  TDXPlayMessageEvent = procedure(Sender: TObject; From: TDXPlayPlayer;
    Data: Pointer; DataSize: Integer) of object;
 
  TDXPlaySendCompleteResult = (crOk, crAbort, crGeneric);
 
  TDXPlaySendCompleteEvent = procedure(Sender: TObject; MessageID: DWORD;
    Result: TDXPlaySendCompleteResult; SendTime: Integer) of object;
 
  TCustomDXPlay = class(TComponent)
  private
    FDPlay: //{$IfDef DX7}
      IDirectPlay4A;//{$Else}IDirectPlay8Address{$EndIf};
    FGUID: string;
    FIsHost: Boolean;
    FLocalPlayer: TDXPlayPlayer;
    FMaxPlayers: Integer;
    FPlayers: TDXPlayPlayers;
    FCalledDoOpen: Boolean;
    FOnAddPlayer: TDXPlayEvent;
    FOnClose: TNotifyEvent;
    FOnDeletePlayer: TDXPlayEvent;
    FOnMessage: TDXPlayMessageEvent;
    FOnOpen: TNotifyEvent;
    FOnSendComplete: TDXPlaySendCompleteEvent;
    FOnSessionLost: TNotifyEvent;
    FOpened: Boolean;
    FRecvEvent: array[0..1] of THandle;
    FRecvThread: TThread;
    FInThread: Boolean;
    FProviderName: string;
    FProviders: TStrings;
    FSessionName: string;
    FSessions: TStrings;
    FReadSessioned: Boolean;
    FModemSetting: TDXPlayModemSetting;
    FTCPIPSetting: TDXPlayTCPIPSetting;
    FAsync: Boolean;
    FAsyncSupported: Boolean;
    procedure ChangeDPlay;
    procedure CreateDPlayWithoutDialog(out DPlay:
     //{$IfDef DX7}
     IDirectPlay4A;
     //{$Else}IDirectPlay8Address{$EndIf};
      const ProviderName: string);
    function OpenDPlayWithLobby(out Name: string): Boolean;
    function OpenDPlayWithoutLobby(out Name: string): Boolean;
    function OpenDPlayWithoutLobby2(const NewSession: Boolean; const ProviderName, SessionName, PlayerName: string): Boolean;
    procedure Open_(NameS: string);
    procedure ReceiveMessage;
    function GetProviders: TStrings;
    function GetSessionsPty: TStrings;
    procedure ClearSessionList;
    procedure SetGUID(const Value: string);
    procedure SetModemSetting(Value: TDXPlayModemSetting);
    procedure SetProviderName(const Value: string);
    procedure SetTCPIPSetting(Value: TDXPlayTCPIPSetting);
  protected
    procedure DoAddPlayer(Player: TDXPlayPlayer); virtual;
    procedure DoClose; virtual;
    procedure DoDeletePlayer(Player: TDXPlayPlayer); virtual;
    procedure DoMessage(From: TDXPlayPlayer; Data: Pointer; DataSize: Integer); virtual;
    procedure DoOpen; virtual;
    procedure DoSessionLost; virtual;
    procedure DoSendComplete(MessageID: DWORD; Result: TDXPlaySendCompleteResult;
      SendTime: Integer); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Close;
    procedure Open;
    procedure Open2(NewSession: Boolean; const SessionName, PlayerName: string);
    function GetProviderNameFromGUID(const ProviderGUID: TGUID): string;
    procedure GetSessions;
    procedure SendMessage(ToID: TDPID; Data: Pointer; DataSize: Integer);
    function SendMessageEx(ToID: TDPID; Data: Pointer; DataSize: Integer;
      dwFlags: DWORD): DWORD;
    property GUID: string read FGUID write SetGUID;
    property IsHost: Boolean read FIsHost;
    property LocalPlayer: TDXPlayPlayer read FLocalPlayer;
    property MaxPlayers: Integer read FMaxPlayers write FMaxPlayers;
    property OnAddPlayer: TDXPlayEvent read FOnAddPlayer write FOnAddPlayer;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnDeletePlayer: TDXPlayEvent read FOnDeletePlayer write FOnDeletePlayer;
    property OnMessage: TDXPlayMessageEvent read FOnMessage write FOnMessage;
    property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
    property OnSendComplete: TDXPlaySendCompleteEvent read FOnSendComplete write FOnSendComplete;
    property OnSessionLost: TNotifyEvent read FOnSessionLost write FOnSessionLost;
    property Opened: Boolean read FOpened;
    property Players: TDXPlayPlayers read FPlayers;
    property ProviderName: string read FProviderName write SetProviderName;
    property Providers: TStrings read GetProviders;
    property SessionName: string read FSessionName;
    property Sessions: TStrings read GetSessionsPty;
    property ModemSetting: TDXPlayModemSetting read FModemSetting write SetModemSetting;
    property TCPIPSetting: TDXPlayTCPIPSetting read FTCPIPSetting write SetTCPIPSetting;
    property Async: Boolean read FAsync write FAsync;
    property AsyncSupported: Boolean read FAsyncSupported;
  end;
 
  TDXPlay = class(TCustomDXPlay)
  published
    property Async;
    property GUID;
    property MaxPlayers;
    property ModemSetting;
    property TCPIPSetting;
    property OnAddPlayer;
    property OnClose;
    property OnDeletePlayer;
    property OnMessage;
    property OnOpen;
    property OnSendComplete;
    property OnSessionLost;
  end;
 
function DXPlayMessageType(P: Pointer): DWORD;
 
function DXPlayStringToGUID(const S: string): TGUID;
function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
  //{$IfDef DX7}
  IDirectPlay;
  //{$Else}IDirectPlay8Server{$EndIf};
  pUnk: IUnknown): HRESULT;
 
implementation
 
uses DXPlayFm, DXConsts;
 
function DXPlayMessageType(P: Pointer): DWORD;
begin
  Result := PDPMSG_GENERIC(P)^.dwType;
end;
 
function DXPlayStringToGUID(const S: string): TGUID;
var
  ErrorCode: Integer;
begin
  ErrorCode := CLSIDFromString(PWideChar(WideString(S)), Result);
  if ErrorCode<0 then
    raise EDXPlayError.Create(WindowsErrorMsg(ErrorCode));
end;
 
function GUIDToString(const ClassID: TGUID): string;
var
  ErrorCode: Integer;
  P: PWideChar;
begin
  ErrorCode := StringFromCLSID(ClassID, P);
  if ErrorCode<0 then
    raise EDXPlayError.Create(WindowsErrorMsg(ErrorCode));
  Result := P;
  CoTaskMemFree(P);
end;
 
function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
  //{$IfDef DX7}
  IDirectPlay;
  //{$Else}IDirectPlay8Server{$EndIf};
  pUnk: IUnknown): HRESULT;
type
  TDirectPlayCreate= function(const lpGUID: TGUID; out lplpDP: IDirectPlay; pUnk: IUnknown): HRESULT; stdcall;
begin
  Result := TDirectPlayCreate(DXLoadLibrary('DPlayX.dll', 'DirectPlayCreate'))
    (lpGUID, lplpDP, pUnk);
end;
{$IFDEF UNICODE}
function DXDirectPlayEnumerate(lpEnumDPCallback: TDPEnumDPCallbackW; lpContext: Pointer): HRESULT;
type
  TDirectPlayEnumerateW= function(lpEnumDPCallback: TDPEnumDPCallbackW; lpContext: Pointer): HRESULT; stdcall;
begin
  Result := TDirectPlayEnumerateW(DXLoadLibrary('DPlayX.dll', 'DirectPlayEnumerateW'))
    (lpEnumDPCallback, lpContext);
end;
 
function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyW;
  lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT;
type
  TDirectPlayLobbyCreateW = function(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyW;
    lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT; stdcall;
begin
  Result := TDirectPlayLobbyCreateW(DXLoadLibrary('DPlayX.dll', 'DirectPlayLobbyCreateW'))
    (lpguidSP, lplpDPL, lpUnk, lpData, dwDataSize);
end;
{$ELSE}
function DXDirectPlayEnumerate(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT;
type
  TDirectPlayEnumerateA= function(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT; stdcall;
begin
  Result := TDirectPlayEnumerateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayEnumerateA'))
    (lpEnumDPCallback, lpContext);
end;
 
function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
  lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT;
type
  TDirectPlayLobbyCreateA = function(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
    lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT; stdcall;
begin
  Result := TDirectPlayLobbyCreateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayLobbyCreateA'))
    (lpguidSP, lplpDPL, lpUnk, lpData, dwDataSize);
end;
{$ENDIF}
{  TDXPlayPlayers  }
 
constructor TDXPlayPlayers.Create;
begin
  inherited Create(TDXPlayPlayer);
end;
 
function TDXPlayPlayers.Find(ID: TDPID): TDXPlayPlayer;
var
  i: Integer;
begin
  i := IndexOf(ID);
  if i=-1 then
    raise EDXPlayError.Create(SDXPlayPlayerNotFound);
  Result := Players[i];
end;
 
function TDXPlayPlayers.IndexOf(ID: TDPID): Integer;
var
  i: Integer;
begin
  for i:=0 to Count-1 do
    if Players[i].FID=ID then
    begin
      Result := i;
      Exit;
    end;
  Result := -1;
end;
 
function TDXPlayPlayers.GetPlayer(Index: Integer): TDXPlayPlayer;
begin
  Result := TDXPlayPlayer(Items[Index]);
end;
 
{  TDXPlayModemSetting  }
 
destructor TDXPlayModemSetting.Destroy;
begin
  FModemNames.Free;
  inherited Destroy;
end;
 
procedure TDXPlayModemSetting.Assign(Source: TPersistent);
begin
  if Source is TDXPlayModemSetting then
  begin
    FEnabled := TDXPlayModemSetting(Source).FEnabled;
    FPhoneNumber := TDXPlayModemSetting(Source).FPhoneNumber;
    FModemName := TDXPlayModemSetting(Source).FModemName;
  end else
    inherited Assign(Source);
end;
 
function TDXPlayModemSetting.GetModemNames: TStrings;
 
  function EnumModemAddress(const guidDataType: TGUID;
    dwDataSize: DWORD; lpData: Pointer; lpContext: Pointer): BOOL; stdcall;
  begin
    if CompareMem(@guidDataType, @DPAID_Modem, SizeOf(TGUID)) then
      TStrings(lpContext).Add( PChar(lpData));
    Result := True;
  end;
 
var
  {$IFDEF UNICODE}
  Lobby1: IDirectPlayLobbyW;
  Lobby: IDirectPlayLobby2W;
  DPlay: IDirectPlay4W;
  {$ELSE}
  Lobby1: IDirectPlayLobbyA;
  Lobby: IDirectPlayLobby2A;
 
  DPlay: IDirectPlay4A;
  {$ENDIF}
  DPlay1: IDirectPlay;
  lpAddress: Pointer;
  dwAddressSize: DWORD;
begin
  if FModemNames=nil then
  begin
    FModemNames := TStringList.Create;
    try
      if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
        raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
      Lobby := Lobby1 as {$IFDEF UNICODE}IDirectPlayLobby2W{$ELSE}IDirectPlayLobby2A{$ENDIF};
 
      if DXDirectPlayCreate(DPSPGUID_MODEM, DPlay1, nil)<>0 then
        raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
      DPlay := DPlay1 as {$IFDEF UNICODE}IDirectPlay4W{$ELSE}IDirectPlay4A{$ENDIF};
 
      {  get size of player address for all players  }
      if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
        raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
 
      GetMem(lpAddress, dwAddressSize);
      try
        FillChar(lpAddress^, dwAddressSize, 0);
 
        {  get the address  }
        if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, lpAddress, dwAddressSize)<>0 then
          raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
 
        {  get modem strings from address and put them in the combo box  }
        if Lobby.EnumAddress(@EnumModemAddress, lpAddress^, dwAddressSize, FModemNames)<>0 then
          raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
      finally
        FreeMem(lpAddress);
      end;
    except
      FModemNames.Free; FModemNames := nil;
      raise;
    end;
  end;
 
  Result := FModemNames;
end;
 
{  TDXPlayTCPIPSetting  }
 
procedure TDXPlayTCPIPSetting.Assign(Source: TPersistent);
begin
  if Source is TDXPlayTCPIPSetting then
  begin
    FEnabled := TDXPlayTCPIPSetting(Source).FEnabled;
    FHostName := TDXPlayTCPIPSetting(Source).FHostName;
  end else
    inherited Assign(Source);
end;
 
{  TCustomDXPlay  }
 
constructor TCustomDXPlay.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPlayers := TDXPlayPlayers.Create;
  FModemSetting := TDXPlayModemSetting.Create;
  FTCPIPSetting := TDXPlayTCPIPSetting.Create;
  FSessions := TStringList.Create;
 
  FGUID := GUIDToString(GUID_NULL);
  FMaxPlayers := 0;
end;
 
destructor TCustomDXPlay.Destroy;
var
  i: Integer;
begin
  Close;
 
  FPlayers.Free;
 
  if FProviders<>nil then
  begin
    for i:=0 to FProviders.Count-1 do
      Dispose(PGUID(FProviders.Objects[i]));
  end;
  FProviders.Free;
  FModemSetting.Free;
  FTCPIPSetting.Free;
  ClearSessionList;
  FSessions.Free;
  inherited Destroy;
end;
 
type
  TDXPlayRecvThread = class(TThread)
  private
    FDXPlay: TCustomDXPlay;
    constructor Create(DXPlay: TCustomDXPlay);
    destructor Destroy; override;
    procedure Execute; override;
  end;
 
constructor TDXPlayRecvThread.Create(DXPlay: TCustomDXPlay);
begin
  FDXPlay := DXPlay;
 
  FDXPlay.FRecvEvent[1] := CreateEvent(nil, False, False, nil);
 
  FreeOnTerminate := True;
  inherited Create(True);
end;
 
destructor TDXPlayRecvThread.Destroy;
begin
  FreeOnTerminate := False;
  SetEvent(FDXPlay.FRecvEvent[1]);
 
  inherited Destroy;
 
  CloseHandle(FDXPlay.FRecvEvent[1]);
 
  FDXPlay.FRecvThread := nil;
  FDXPlay.Close;
end;
 
procedure TDXPlayRecvThread.Execute;
begin
  while WaitForMultipleObjects(2, @FDXPlay.FRecvEvent, False, INFINITE)=WAIT_OBJECT_0 do
  begin
    Synchronize(FDXPlay.ReceiveMessage);
  end;
end;
 
procedure TCustomDXPlay.ReceiveMessage;
var
  idFrom, idTo: DWORD;
  hr: HRESULT;
  lpvMsgBuffer: Pointer;
  dwMsgBufferSize: DWORD;
  Msg_CreatePlayerOrGroup: PDPMSG_CREATEPLAYERORGROUP;
  Msg_DeletePlayerOrGroup: PDPMSG_DESTROYPLAYERORGROUP;
  Msg_SendComplete: PDPMsg_SendComplete;
  SendCompleteResult: TDXPlaySendCompleteResult;
  Player: TDXPlayPlayer;
  i: Integer;
begin
  FInThread := True;
  try
    try
      lpvMsgBuffer := nil;
      dwMsgBufferSize := 0;
 
      try
        repeat
          hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);
 
          if hr=DPERR_BUFFERTOOSMALL then
          begin
            ReAllocMem(lpvMsgBuffer, dwMsgBufferSize);
            hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);
          end;
 
          if (hr=0) and (dwMsgBufferSize>=SizeOf(TDPMSG_GENERIC)) then
          begin
            if idFrom=DPID_SYSMSG then
            begin
              {  System message  }
              case PDPMSG_GENERIC(lpvMsgBuffer)^.dwType of
                DPSYS_CREATEPLAYERORGROUP:
                  begin
                    {  New player  }
                    Msg_CreatePlayerOrGroup := lpvMsgBuffer;
 
                    if Msg_CreatePlayerOrGroup.DPID<>FLocalPlayer.FID then
                    begin
                      Player := TDXPlayPlayer.Create(Players);
                      Player.FID := Msg_CreatePlayerOrGroup.DPID;
                      Player.FRemotePlayer := True;
 
                      with Msg_CreatePlayerOrGroup.dpnName do
                      begin
                        {$IFDEF UNICODE}
                        if lpszShortNameW<>nil then
                          Player.FName := lpszShortNameW;
                        {$ELSE}
                        if lpszShortNameA<>nil then
                          Player.FName := lpszShortNameA;
                        {$ENDIF}
                      end;
 
                      DoAddPlayer(Player);
                    end;
                  end;
                DPSYS_DESTROYPLAYERORGROUP:
                  begin
                    {  Player deletion  }
                    Msg_DeletePlayerOrGroup := lpvMsgBuffer;
 
                    if Msg_DeletePlayerOrGroup.DPID<>FLocalPlayer.FID then
                    begin
                      i := Players.IndexOf(Msg_DeletePlayerOrGroup.DPID);
                      if i<>-1 then
                      begin
                        Player := Players[i];
                        DoDeletePlayer(Player);
                        Player.Free;
                      end;
                    end;
                  end;
                DPSYS_SESSIONLOST:
                  begin
                    {  The session was lost.  }
                    DoSessionLost;
                    Close;
                  end;
                DPSYS_HOST:
                  begin
                    {  Here became a host.  }
                    FIsHost := True;
                  end;
                DPSYS_SENDCOMPLETE:
                   begin
                     { Send complete  }
                     Msg_SendComplete := lpvMsgBuffer;
                     if Msg_SendComplete.idFrom=FLocalPlayer.FID then
                     begin
                       case Msg_SendComplete.hr of
                         DP_OK        : SendCompleteResult := crOk;
                         DPERR_ABORTED: SendCompleteResult := crAbort;
                         else           SendCompleteResult := crGeneric;
                       end;
 
                       DoSendComplete(Msg_SendComplete^.dwMsgID, SendCompleteResult, Msg_SendComplete^.dwSendTime);
                     end;
                   end;
              end;
            end else
            begin
              {  Application definition message  }
              DoMessage(Players.Find(idFrom), lpvMsgBuffer, dwMsgBufferSize);
            end;
          end;
        until hr<>0;
      finally
        FreeMem(lpvMsgBuffer);
      end;
    except
      on E: Exception do
        Application.HandleException(E);
    end;
  finally
    FInThread := False;
  end;
end;
 
procedure TCustomDXPlay.DoAddPlayer(Player: TDXPlayPlayer);
begin
  if Assigned(FOnAddPlayer) then FOnAddPlayer(Self, Player)
end;
 
procedure TCustomDXPlay.DoClose;
begin
  if Assigned(FOnClose) then FOnClose(Self);
end;
 
procedure TCustomDXPlay.DoDeletePlayer(Player: TDXPlayPlayer);
begin
  if Assigned(FOnDeletePlayer) then FOnDeletePlayer(Self, Player)
end;
 
procedure TCustomDXPlay.DoMessage(From: TDXPlayPlayer; Data: Pointer; DataSize: Integer);
begin
  if Assigned(FOnMessage) then FOnMessage(Self, From, Data, DataSize);
end;
 
procedure TCustomDXPlay.DoOpen;
begin
  if Assigned(FOnOpen) then FOnOpen(Self);
end;
 
procedure TCustomDXPlay.DoSessionLost;
begin
  if Assigned(FOnSessionLost) then FOnSessionLost(Self);
end;
 
procedure TCustomDXPlay.DoSendComplete(MessageID: DWORD; Result: TDXPlaySendCompleteResult;
  SendTime: Integer);
begin
  if Assigned(FOnSendComplete) then FOnSendComplete(Self, MessageID, Result, SendTime);
end;
 
function TCustomDXPlay.GetProviders: TStrings;
 
  function EnumProviderCallback(const lpguidSP: TGUID; lpSPName: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPSTR{$ENDIF};
      dwMajorVersion: DWORD; dwMinorVersion: DWORD; lpContext: Pointer):
      BOOL; stdcall;
  var
    GUID: PGUID;
  begin
    GUID := New(PGUID);
    Move(lpguidSP, GUID^, SizeOf(TGUID));
    TStrings(lpContext).AddObject(lpSPName, TObject(GUID));
    Result := True;
  end;
 
begin
  if FProviders=nil then
  begin
    FProviders := TStringList.Create;
    try
      DXDirectPlayEnumerate(@EnumProviderCallback, FProviders);
    except
      FProviders.Free; FProviders := nil;
      raise;
    end;
  end;
 
  Result := FProviders;
end;
 
procedure TCustomDXPlay.GetSessions;
 
  function EnumSessionsCallback(const lpThisSD: TDPSessionDesc2;
    var lpdwTimeOut: DWORD; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
  var
    Guid: PGUID;
  begin
    if dwFlags and DPESC_TIMEDOUT<>0 then
    begin
      Result := False;
      Exit;
    end;
 
    Guid := New(PGUID);
    Move(lpThisSD.guidInstance, Guid^, SizeOf(TGUID));
    {$IFDEF UNICODE}
    TStrings(lpContext).AddObject(lpThisSD.lpszSessionNameW, TObject(Guid));
    {$ELSE}
    TStrings(lpContext).AddObject(lpThisSD.lpszSessionNameA, TObject(Guid));
    {$ENDIF}
    Result := True;
  end;
 
var
  dpDesc: TDPSessionDesc2;
  hr: HRESULT;
begin
  if FDPlay=nil then
    raise EDXPlayError.Create(SDXPlayNotConnectedNow);
 
  ClearSessionList;
 
  FillChar(dpDesc, SizeOf(dpDesc), 0);
  dpDesc.dwSize := SizeOf(dpDesc);
  dpDesc.guidApplication := DXPlayStringToGUID(FGUID);
 
  hr := FDPlay.EnumSessions(dpDesc, 0, @EnumSessionsCallback, FSessions, DPENUMSESSIONS_AVAILABLE);
  if hr=DPERR_USERCANCEL then Abort;
  if hr<>0 then
    raise EDXPlayError.Create(SDXPlaySessionListCannotBeAcquired);
 
  FReadSessioned := True;
end;
 
function TCustomDXPlay.GetSessionsPty: TStrings;
begin
  if not FReadSessioned then GetSessions;
  Result := FSessions;
end;
 
function TCustomDXPlay.GetProviderNameFromGUID(const ProviderGUID: TGUID): string;
var
  i: Integer;
begin
  for i:=0 to Providers.Count-1 do
    if CompareMem(PGUID(Providers.Objects[i]), @ProviderGUID, SizeOf(TGUID)) then
    begin
      Result := Providers[i];
      Exit;
    end;
 
  raise EDXPlayError.Create(SDXPlayProviderSpecifiedGUIDNotFound);
end;
 
procedure TCustomDXPlay.CreateDPlayWithoutDialog(out DPlay: IDirectPlay4A; const ProviderName: string);
var
  i: Integer;
  ProviderGUID: TGUID;
  addressElements: array[0..15] of TDPCompoundAddressElement;
  dwElementCount: Integer;
  {$IFDEF UNICODE}
  Lobby1: IDirectPlayLobbyW;
  Lobby: IDirectPlayLobby2W;
  {$ELSE}
  Lobby1: IDirectPlayLobbyA;
  Lobby: IDirectPlayLobby2A;
  {$ENDIF}
  lpAddress: Pointer;
  dwAddressSize: DWORD;
begin
  i := Providers.IndexOf(ProviderName);
  if i=-1 then
    raise EDXPlayError.CreateFmt(SDXPlayProviderNotFound, [ProviderName]);
  ProviderGUID := PGUID(Providers.Objects[i])^;
 
  {  DirectPlay address making  }
  if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
    raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
  Lobby := Lobby1 as {$IFDEF UNICODE}IDirectPlayLobby2W{$ELSE}IDirectPlayLobby2A{$ENDIF};
 
  FillChar(addressElements, SizeOf(addressElements), 0);
  dwElementCount := 0;
 
  addressElements[dwElementCount].guidDataType := DPAID_ServiceProvider;
  addressElements[dwElementCount].dwDataSize := SizeOf(TGUID);
  addressElements[dwElementCount].lpData := @ProviderGUID;
  Inc(dwElementCount);
 
  if CompareMem(@ProviderGUID, @DPSPGUID_MODEM, SizeOf(TGUID)) and ModemSetting.Enabled then
  begin
    {  Modem  }
    if ModemSetting.FModemName<>'' then
    begin
      addressElements[dwElementCount].guidDataType := DPAID_Modem;
      addressElements[dwElementCount].dwDataSize := Length(ModemSetting.FModemName)+1;
      addressElements[dwElementCount].lpData := PChar(ModemSetting.FModemName);
      Inc(dwElementCount);
    end;
 
    if ModemSetting.FPhoneNumber<>'' then
    begin
      addressElements[dwElementCount].guidDataType := DPAID_Phone;
      addressElements[dwElementCount].dwDataSize := Length(ModemSetting.FPhoneNumber)+1;
      addressElements[dwElementCount].lpData := PChar(ModemSetting.FPhoneNumber);
      Inc(dwElementCount);
    end;
  end else
  if CompareMem(@ProviderGUID, @DPSPGUID_TCPIP, SizeOf(TGUID)) and TCPIPSetting.Enabled then
  begin
    {  TCP/IP  }
    if TCPIPSetting.FHostName<>'' then
    begin
      addressElements[dwElementCount].guidDataType := DPAID_INet;
      addressElements[dwElementCount].dwDataSize := Length(TCPIPSetting.FHostName)+1;
      addressElements[dwElementCount].lpData := PChar(TCPIPSetting.FHostName);
      Inc(dwElementCount);
    end;
 
    if TCPIPSetting.Port<>0 then
    begin
      addressElements[dwElementCount].guidDataType := DPAID_INetPort;
      addressElements[dwElementCount].dwDataSize := SizeOf(TCPIPSetting.FPort);
      addressElements[dwElementCount].lpData := @TCPIPSetting.FPort;
      Inc(dwElementCount);
    end;
  end;
 
  if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
    raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
 
  GetMem(lpAddress, dwAddressSize);
  try
    FillChar(lpAddress^, dwAddressSize, 0);
 
    if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, lpAddress, dwAddressSize)<>0 then
      raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
 
    {  DirectPlay initialization  }
    if CoCreateInstance(CLSID_DirectPlay, nil, CLSCTX_INPROC_SERVER, IID_IDirectPlay4A, DPlay)<>0 then
      raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
    try
      {  DirectPlay address initialization  }
      if DPlay.InitializeConnection(lpAddress, 0)<>0 then
        raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
    except
      DPlay := nil;
      raise;
    end;
  finally
    FreeMem(lpAddress);
  end;
end;
 
procedure TCustomDXPlay.ClearSessionList;
var
  i: Integer;
begin
  FReadSessioned := False;
  for i:=0 to FSessions.Count-1 do
    Dispose(PGUID(FSessions.Objects[i]));
  FSessions.Clear;
end;
 
procedure TCustomDXPlay.Open;
var
  PlayerName: string;
begin
  Close;
  try
    if not OpenDPlayWithLobby(PlayerName) then
    begin
      if not OpenDPlayWithoutLobby(PlayerName) then
        Abort;
    end;
 
    Open_(PlayerName);
  except
    Close;
    raise;
  end;
end;
 
procedure TCustomDXPlay.Open2(NewSession: Boolean; const SessionName, PlayerName: string);
begin
  if not OpenDPlayWithoutLobby2(NewSession, ProviderName, SessionName, PlayerName) then
    Abort;
 
  Open_(PlayerName);
end;
 
procedure TCustomDXPlay.Open_(NameS: string);
 
  function EnumPlayersCallback2(TDPID: TDPID; dwPlayerType: DWORD;
    const lpName: TDPName; dwFlags: DWORD; lpContext: Pointer): BOOL;
    stdcall;
  var
    Player: TDXPlayPlayer;
  begin
    Player := TDXPlayPlayer.Create(TCustomDXPlay(lpContext).Players);
    Player.FID := TDPID;
    Player.FRemotePlayer := True;
 
    with lpName do
    begin
      {$IFDEF UNICODE}
      if lpszShortNameW<>nil then
        Player.FName := lpszShortNameW;
      {$ELSE}
      if lpszShortNameA<>nil then
        Player.FName := lpszShortNameA;
      {$ENDIF}
    end;
 
    Result := True;
  end;
 
var
  Name2: array[0..1023] of Char;
  Name: TDPName;
begin
  if FOpened then Close;
  FOpened := True;
  try
    {  Player making  }
    StrLCopy(@Name2, PChar(NameS), SizeOf(Name2));
 
    Name.lpszShortNameA := @Name2;
    Name.lpszLongNameA := nil;
 
    FRecvEvent[0] := CreateEvent(nil, False, False, nil);
 
    FLocalPlayer := TDXPlayPlayer.Create(FPlayers);
    FLocalPlayer.FName := NameS;
 
    if FDPlay.CreatePlayer(FLocalPlayer.FID, @Name, FRecvEvent[0], nil, 0, 0)<>DP_OK then
      raise EDXPlayError.CreateFmt(SCannotOpened, [FSessionName]);
 
    {  Player enumeration  }
    FDPlay.EnumPlayers(PGUID(nil), @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
 
    FIsHost := FPlayers.Count=1;
 
    FCalledDoOpen := True; DoOpen;
    DoAddPlayer(FLocalPlayer);
 
    {  Thread start  }
    FRecvThread := TDXPlayRecvThread.Create(Self);
    FRecvThread.Resume;
  except
    Close;
    raise;
  end;
end;
 
procedure TCustomDXPlay.ChangeDPlay;
var
  caps: TDPCAPS;
begin
  FAsyncSupported := False;
  if FDPlay<>nil then
  begin
    FillChar(caps, SizeOf(caps), 0);
    caps.dwSize := SizeOf(caps);
    FDPlay.GetCaps(caps, 0);
 
    FAsyncSupported := caps.dwFlags and DPCAPS_ASYNCSUPPORTED<>0;
  end;
end;
 
function TCustomDXPlay.OpenDPlayWithLobby(out Name: string): Boolean;
var
  DPlay1: IDirectPlay2;
  {$IFDEF UNICODE}
  Lobby: IDirectPlayLobbyW;
  {$ELSE}
  Lobby: IDirectPlayLobbyA;
  {$ENDIF}
  dwSize: DWORD;
  ConnectionSettings: PDPLConnection;
begin
  Result := False;
 
  if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby, nil, nil, 0)<>0 then
    Exit;
 
  if Lobby.GetConnectionSettings(0, PDPLConnection(nil), dwSize)<>DPERR_BUFFERTOOSMALL then
    Exit;
 
  GetMem(ConnectionSettings, dwSize);
  try
    if Lobby.GetConnectionSettings(0, ConnectionSettings, dwSize)<>0 then
      Exit;
 
    with ConnectionSettings^.lpSessionDesc^ do
    begin
      dwFlags := DPSESSION_MIGRATEHOST or DPSESSION_KEEPALIVE or DPSESSION_DIRECTPLAYPROTOCOL;
      dwMaxPlayers := FMaxPlayers;
    end;
 
    if Lobby.SetConnectionSettings(0, 0, ConnectionSettings^)<>0 then
      Exit;
 
    if Lobby.Connect(0, DPlay1, nil)<>0 then
      Exit;
    FDPlay := DPlay1 as IDirectPlay4A;
    ChangeDPlay;
 
    with ConnectionSettings.lpSessionDesc^ do
    begin
      {$IFDEF UNICODE}
      if lpszSessionNameW<>nil then
        FSessionName := lpszSessionNameW;
      {$ELSE}
      if lpszSessionNameA<>nil then
        FSessionName := lpszSessionNameA;
      {$ENDIF}
    end;
 
    with ConnectionSettings.lpPlayerName^ do
    begin
      {$IFDEF UNICODE}
      if lpszShortNameW<>nil then
        Name := lpszShortNameW;
      {$ELSE}
      if lpszShortNameA<>nil then
        Name := lpszShortNameA;
      {$ENDIF}
    end;
  finally
    FreeMem(ConnectionSettings);
  end;
 
  Result := True;
end;
 
function TCustomDXPlay.OpenDPlayWithoutLobby(out Name: string): Boolean;
var
  Form: TDelphiXDXPlayForm;
begin
  Form := TDelphiXDXPlayForm.Create(Application);
  try
    Form.DXPlay := Self;
    Form.ShowModal;
 
    Result := Form.Tag<>0;
 
    FDPlay := Form.DPlay;
    ChangeDPlay;
 
    Name := Form.PlayerName;
    FProviderName := Form.ProviderName;
    FSessionName := Form.SessionName;
  finally
    Form.Free;
  end;
end;
 
function TCustomDXPlay.OpenDPlayWithoutLobby2(const NewSession: Boolean;
  const ProviderName, SessionName, PlayerName: string): Boolean;
var
  dpDesc: TDPSessionDesc2;
  i: Integer;
  hr: HRESULT;
begin
  Result := False;
 
  if FDPlay=nil then
    raise EDXPlayError.Create(SDXPlayNotConnectedNow);
 
  if SessionName='' then
    raise EDXPlayError.Create(SDXPlaySessionNameIsNotSpecified);
 
  if PlayerName='' then
    raise EDXPlayError.Create(SDXPlayPlayerNameIsNotSpecified);
 
  if NewSession then
  begin
    {  Session connection  }
    FillChar(dpDesc, SizeOf(dpDesc), 0);
    dpDesc.dwSize := SizeOf(dpDesc);
    dpDesc.dwFlags := DPSESSION_MIGRATEHOST or DPSESSION_KEEPALIVE;
    {$IFDEF UNICODE}
    dpDesc.lpszSessionNameW := {$IFDEF VER12UP}PChar{$ELSE}PWideChar{$ENDIF}(SessionName);
    {$ELSE}
    dpDesc.lpszSessionNameA := PAnsiChar(SessionName);
    {$ENDIF}
    dpDesc.guidApplication := DXPlayStringToGUID(GUID);
    dpDesc.dwMaxPlayers := MaxPlayers;
 
    hr := FDPlay.Open(dpDesc, DPOPEN_CREATE);
    if hr=DPERR_USERCANCEL then Exit;
    if hr<>0 then
      raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [FSessionName]);
  end else
  begin
    {  Session connection  }
    {  Enum session  }
    i := Sessions.IndexOf(SessionName);
    if i=-1 then raise EDXPlayError.CreateFmt(SDXPlaySessionNotFound, [SessionName]);
 
    FillChar(dpDesc, SizeOf(dpDesc), 0);
    dpDesc.dwSize := SizeOf(dpDesc);
    dpDesc.guidInstance := PGUID(Sessions.Objects[i])^;
    dpDesc.guidApplication := DXPlayStringToGUID(GUID);
 
    hr := FDPlay.Open(dpDesc, DPOPEN_JOIN);
    if hr=DPERR_USERCANCEL then Exit;
    if hr<>0 then
      raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [FSessionName]);
  end;
 
  Result := True;
 
  FSessionName := SessionName;
end;
 
procedure TCustomDXPlay.Close;
begin
  FOpened := False;
  FReadSessioned := False;
 
  try
    if FCalledDoOpen then
    begin
      FCalledDoOpen := False;
      DoClose;
    end;
  finally
    if FDPlay<>nil then
    begin
      if FLocalPlayer<>nil then FDPlay.DestroyPlayer(FLocalPlayer.FID);
      FDPlay.Close;
    end;
 
    FProviderName := '';
    FSessionName := '';
    FAsyncSupported := False;
 
    ClearSessionList;
 
    FDPlay := nil;
    ChangeDPlay;
 
    if FInThread then
      SetEvent(FRecvEvent[1])
    else
      FRecvThread.Free;
 
    CloseHandle(FRecvEvent[0]); FRecvEvent[0] := 0;
 
    FPlayers.Clear;
 
    FLocalPlayer := nil;
  end;
end;
 
procedure TCustomDXPlay.SendMessage(ToID: TDPID; Data: Pointer; DataSize: Integer);
begin
  if not Opened then Exit;
 
  if DataSize<SizeOf(TDPMSG_GENERIC) then
    raise EDXPlayError.Create(SDXPlayMessageIllegal);
 
  if ToID=FLocalPlayer.ID then
  begin
    {  Message to me  }
    DoMessage(FLocalPlayer, Data, DataSize);
  end else
  if FAsync and FAsyncSupported then
    FDPlay.SendEx(FLocalPlayer.ID, ToID, DPSEND_GUARANTEED or DPSEND_ASYNC, Data, DataSize, 0, 0, nil, nil)
  else
    FDPlay.Send(FLocalPlayer.ID, ToID, DPSEND_GUARANTEED, Data^, DataSize);
end;
 
function TCustomDXPlay.SendMessageEx(ToID: TDPID; Data: Pointer; DataSize: Integer;
  dwFlags: DWORD): DWORD;
begin
  if not Opened then Exit;
 
  if DataSize<SizeOf(TDPMSG_GENERIC) then
    raise EDXPlayError.Create(SDXPlayMessageIllegal);
 
  Result := 0;
  if ToID=FLocalPlayer.ID then
  begin
    {  ©ª¶ÌbZ[W  }
    DoMessage(FLocalPlayer, Data, DataSize);
  end else
    FDPlay.SendEx(FLocalPlayer.ID, ToID, dwFlags, Data, DataSize,
      0, 0, nil, @Result); // 0 ÈOÍT|[gµÈ¢foCX éÌÅgíÈ¢
end;
 
procedure TCustomDXPlay.SetGUID(const Value: string);
begin
  if Value<>FGUID then
  begin
    if Value='' then
    begin
      FGUID := GUIDToString(GUID_NULL);
    end else
    begin
      FGUID := GUIDToString(DXPlayStringToGUID(Value));
    end;
  end;
end;
 
procedure TCustomDXPlay.SetModemSetting(Value: TDXPlayModemSetting);
begin
  FModemSetting.Assign(Value);
end;
 
procedure TCustomDXPlay.SetProviderName(const Value: string);
begin
  Close;
  FProviderName := Value;
  if FProviderName='' then Exit;
  try
    CreateDPlayWithoutDialog(FDPlay, Value);
  except
    FProviderName := '';
    raise;
  end;
end;
 
procedure TCustomDXPlay.SetTCPIPSetting(Value: TDXPlayTCPIPSetting);
begin
  FTCPIPSetting.Assign(Value);
end;
 
initialization
  CoInitialize(nil);
finalization
  CoUninitialize;
end.
 

Rev 1	Rev 4
1	unit DXPlay;	1	unit DXPlay;
2		2
3	interface	3	interface
4		4
5	{$INCLUDE DelphiXcfg.inc}	5	{$INCLUDE DelphiXcfg.inc}
6		6
7	uses	7	uses
8	Windows, SysUtils, Classes, Forms, DXClass, ActiveX, DirectX, DXETable;	8	Windows, SysUtils, Classes, Forms, DXClass, ActiveX, DXETable,
-		9	{$IfDef StandardDX}
-		10	DirectDraw,
-		11	// Delphi 2010 cannot be use DirectPlay8 because structure was not rewriten
-		12	// {$IfDef DX9}
-		13	// DirectPlay8, DX7toDX8;
-		14	// {$Else}
-		15	DirectPlay; //old wersion, current in directory
-		16	// {$EndIf}
-		17	{$Else}
-		18	DirectX;
-		19	{$EndIf}
9		20
10	type	21	type
-		22	{$IfDef DX9}
-		23	TDPID = DWORD;
-		24	{$EndIf}
11		25
12	{ TDXPlayPlayer }	26	{ TDXPlayPlayer }
13		27
14	TDXPlayPlayer = class(TCollectionItem)	28	TDXPlayPlayer = class(TCollectionItem)
15	private	29	private
16	FData: Pointer;	30	FData: Pointer;
17	FID: TDPID;	31	FID: TDPID;
18	FName: string;	32	FName: string;
19	FRemotePlayer: Boolean;	33	FRemotePlayer: Boolean;
20	public	34	public
21	property Data: Pointer read FData write FData;	35	property Data: Pointer read FData write FData;
22	property ID: TDPID read FID;	36	property ID: TDPID read FID;
23	property Name: string read FName;	37	property Name: string read FName;
24	property RemotePlayer: Boolean read FRemotePlayer;	38	property RemotePlayer: Boolean read FRemotePlayer;
25	end;	39	end;
26		40
27	{ TDXPlayPlayers }	41	{ TDXPlayPlayers }
28		42
29	TDXPlayPlayers = class(TCollection)	43	TDXPlayPlayers = class(TCollection)
30	private	44	private
31	function GetPlayer(Index: Integer): TDXPlayPlayer;	45	function GetPlayer(Index: Integer): TDXPlayPlayer;
32	public	46	public
33	constructor Create;	47	constructor Create;
34	function Find(ID: TDPID): TDXPlayPlayer;	48	function Find(ID: TDPID): TDXPlayPlayer;
35	function IndexOf(ID: TDPID): Integer;	49	function IndexOf(ID: TDPID): Integer;
36	property Players[Index: Integer]: TDXPlayPlayer read GetPlayer; default;	50	property Players[Index: Integer]: TDXPlayPlayer read GetPlayer; default;
37	end;	51	end;
38		52
39	{ TDXPlayModemSetting }	53	{ TDXPlayModemSetting }
40		54
41	TDXPlayModemSetting = class(TPersistent)	55	TDXPlayModemSetting = class(TPersistent)
42	private	56	private
43	FEnabled: Boolean;	57	FEnabled: Boolean;
44	FPhoneNumber: string;	58	FPhoneNumber: string;
45	FModemName: string;	59	FModemName: string;
46	FModemNames: TStrings;	60	FModemNames: TStrings;
47	function GetModemNames: TStrings;	61	function GetModemNames: TStrings;
48	public	62	public
49	destructor Destroy; override;	63	destructor Destroy; override;
50	procedure Assign(Source: TPersistent); override;	64	procedure Assign(Source: TPersistent); override;
51	property ModemName: string read FModemName write FModemName;	65	property ModemName: string read FModemName write FModemName;
52	property ModemNames: TStrings read GetModemNames;	66	property ModemNames: TStrings read GetModemNames;
53	published	67	published
54	property Enabled: Boolean read FEnabled write FEnabled;	68	property Enabled: Boolean read FEnabled write FEnabled;
55	property PhoneNumber: string read FPhoneNumber write FPhoneNumber;	69	property PhoneNumber: string read FPhoneNumber write FPhoneNumber;
56	end;	70	end;
57		71
58	{ TDXPlayTCPIPSetting }	72	{ TDXPlayTCPIPSetting }
59		73
60	TDXPlayTCPIPSetting = class(TPersistent)	74	TDXPlayTCPIPSetting = class(TPersistent)
61	private	75	private
62	FEnabled: Boolean;	76	FEnabled: Boolean;
63	FHostName: string;	77	FHostName: string;
64	FPort: Word;	78	FPort: Word;
65	public	79	public
66	procedure Assign(Source: TPersistent); override;	80	procedure Assign(Source: TPersistent); override;
67	published	81	published
68	property Enabled: Boolean read FEnabled write FEnabled;	82	property Enabled: Boolean read FEnabled write FEnabled;
69	property HostName: string read FHostName write FHostName;	83	property HostName: string read FHostName write FHostName;
70	property Port: Word read FPort write FPort;	84	property Port: Word read FPort write FPort;
71	end;	85	end;
72		86
73	{ EDXPlayError }	87	{ EDXPlayError }
74		88
75	EDXPlayError = class(Exception);	89	EDXPlayError = class(Exception);
76		90
77	{ TCustomDXPlay }	91	{ TCustomDXPlay }
78		92
79	TDXPlayEvent = procedure(Sender: TObject; Player: TDXPlayPlayer) of object;	93	TDXPlayEvent = procedure(Sender: TObject; Player: TDXPlayPlayer) of object;
80		94
81	TDXPlayMessageEvent = procedure(Sender: TObject; From: TDXPlayPlayer;	95	TDXPlayMessageEvent = procedure(Sender: TObject; From: TDXPlayPlayer;
82	Data: Pointer; DataSize: Integer) of object;	96	Data: Pointer; DataSize: Integer) of object;
83		97
84	TDXPlaySendCompleteResult = (crOk, crAbort, crGeneric);	98	TDXPlaySendCompleteResult = (crOk, crAbort, crGeneric);
85		99
86	TDXPlaySendCompleteEvent = procedure(Sender: TObject; MessageID: DWORD;	100	TDXPlaySendCompleteEvent = procedure(Sender: TObject; MessageID: DWORD;
87	Result: TDXPlaySendCompleteResult; SendTime: Integer) of object;	101	Result: TDXPlaySendCompleteResult; SendTime: Integer) of object;
88		102
89	TCustomDXPlay = class(TComponent)	103	TCustomDXPlay = class(TComponent)
90	private	104	private
91	FDPlay: IDirectPlay4A;	105	FDPlay: //{$IfDef DX7}
-		106	IDirectPlay4A;//{$Else}IDirectPlay8Address{$EndIf};
92	FGUID: string;	107	FGUID: string;
93	FIsHost: Boolean;	108	FIsHost: Boolean;
94	FLocalPlayer: TDXPlayPlayer;	109	FLocalPlayer: TDXPlayPlayer;
95	FMaxPlayers: Integer;	110	FMaxPlayers: Integer;
96	FPlayers: TDXPlayPlayers;	111	FPlayers: TDXPlayPlayers;
97	FCalledDoOpen: Boolean;	112	FCalledDoOpen: Boolean;
98	FOnAddPlayer: TDXPlayEvent;	113	FOnAddPlayer: TDXPlayEvent;
99	FOnClose: TNotifyEvent;	114	FOnClose: TNotifyEvent;
100	FOnDeletePlayer: TDXPlayEvent;	115	FOnDeletePlayer: TDXPlayEvent;
101	FOnMessage: TDXPlayMessageEvent;	116	FOnMessage: TDXPlayMessageEvent;
102	FOnOpen: TNotifyEvent;	117	FOnOpen: TNotifyEvent;
103	FOnSendComplete: TDXPlaySendCompleteEvent;	118	FOnSendComplete: TDXPlaySendCompleteEvent;
104	FOnSessionLost: TNotifyEvent;	119	FOnSessionLost: TNotifyEvent;
105	FOpened: Boolean;	120	FOpened: Boolean;
106	FRecvEvent: array[0..1] of THandle;	121	FRecvEvent: array[0..1] of THandle;
107	FRecvThread: TThread;	122	FRecvThread: TThread;
108	FInThread: Boolean;	123	FInThread: Boolean;
109	FProviderName: string;	124	FProviderName: string;
110	FProviders: TStrings;	125	FProviders: TStrings;
111	FSessionName: string;	126	FSessionName: string;
112	FSessions: TStrings;	127	FSessions: TStrings;
113	FReadSessioned: Boolean;	128	FReadSessioned: Boolean;
114	FModemSetting: TDXPlayModemSetting;	129	FModemSetting: TDXPlayModemSetting;
115	FTCPIPSetting: TDXPlayTCPIPSetting;	130	FTCPIPSetting: TDXPlayTCPIPSetting;
116	FAsync: Boolean;	131	FAsync: Boolean;
117	FAsyncSupported: Boolean;	132	FAsyncSupported: Boolean;
118	procedure ChangeDPlay;	133	procedure ChangeDPlay;
119	procedure CreateDPlayWithoutDialog(out DPlay: IDirectPlay4A; const ProviderName: string);	134	procedure CreateDPlayWithoutDialog(out DPlay:
-		135	//{$IfDef DX7}
-		136	IDirectPlay4A;
-		137	//{$Else}IDirectPlay8Address{$EndIf};
-		138	const ProviderName: string);
120	function OpenDPlayWithLobby(out Name: string): Boolean;	139	function OpenDPlayWithLobby(out Name: string): Boolean;
121	function OpenDPlayWithoutLobby(out Name: string): Boolean;	140	function OpenDPlayWithoutLobby(out Name: string): Boolean;
122	function OpenDPlayWithoutLobby2(const NewSession: Boolean; const ProviderName, SessionName, PlayerName: string): Boolean;	141	function OpenDPlayWithoutLobby2(const NewSession: Boolean; const ProviderName, SessionName, PlayerName: string): Boolean;
123	procedure Open_(NameS: string);	142	procedure Open_(NameS: string);
124	procedure ReceiveMessage;	143	procedure ReceiveMessage;
125	function GetProviders: TStrings;	144	function GetProviders: TStrings;
126	function GetSessionsPty: TStrings;	145	function GetSessionsPty: TStrings;
127	procedure ClearSessionList;	146	procedure ClearSessionList;
128	procedure SetGUID(const Value: string);	147	procedure SetGUID(const Value: string);
129	procedure SetModemSetting(Value: TDXPlayModemSetting);	148	procedure SetModemSetting(Value: TDXPlayModemSetting);
130	procedure SetProviderName(const Value: string);	149	procedure SetProviderName(const Value: string);
131	procedure SetTCPIPSetting(Value: TDXPlayTCPIPSetting);	150	procedure SetTCPIPSetting(Value: TDXPlayTCPIPSetting);
132	protected	151	protected
133	procedure DoAddPlayer(Player: TDXPlayPlayer); virtual;	152	procedure DoAddPlayer(Player: TDXPlayPlayer); virtual;
134	procedure DoClose; virtual;	153	procedure DoClose; virtual;
135	procedure DoDeletePlayer(Player: TDXPlayPlayer); virtual;	154	procedure DoDeletePlayer(Player: TDXPlayPlayer); virtual;
136	procedure DoMessage(From: TDXPlayPlayer; Data: Pointer; DataSize: Integer); virtual;	155	procedure DoMessage(From: TDXPlayPlayer; Data: Pointer; DataSize: Integer); virtual;
137	procedure DoOpen; virtual;	156	procedure DoOpen; virtual;
138	procedure DoSessionLost; virtual;	157	procedure DoSessionLost; virtual;
139	procedure DoSendComplete(MessageID: DWORD; Result: TDXPlaySendCompleteResult;	158	procedure DoSendComplete(MessageID: DWORD; Result: TDXPlaySendCompleteResult;
140	SendTime: Integer); virtual;	159	SendTime: Integer); virtual;
141	public	160	public
142	constructor Create(AOwner: TComponent); override;	161	constructor Create(AOwner: TComponent); override;
143	destructor Destroy; override;	162	destructor Destroy; override;
144	procedure Close;	163	procedure Close;
145	procedure Open;	164	procedure Open;
146	procedure Open2(NewSession: Boolean; const SessionName, PlayerName: string);	165	procedure Open2(NewSession: Boolean; const SessionName, PlayerName: string);
147	function GetProviderNameFromGUID(const ProviderGUID: TGUID): string;	166	function GetProviderNameFromGUID(const ProviderGUID: TGUID): string;
148	procedure GetSessions;	167	procedure GetSessions;
149	procedure SendMessage(ToID: TDPID; Data: Pointer; DataSize: Integer);	168	procedure SendMessage(ToID: TDPID; Data: Pointer; DataSize: Integer);
150	function SendMessageEx(ToID: TDPID; Data: Pointer; DataSize: Integer;	169	function SendMessageEx(ToID: TDPID; Data: Pointer; DataSize: Integer;
151	dwFlags: DWORD): DWORD;	170	dwFlags: DWORD): DWORD;
152	property GUID: string read FGUID write SetGUID;	171	property GUID: string read FGUID write SetGUID;
153	property IsHost: Boolean read FIsHost;	172	property IsHost: Boolean read FIsHost;
154	property LocalPlayer: TDXPlayPlayer read FLocalPlayer;	173	property LocalPlayer: TDXPlayPlayer read FLocalPlayer;
155	property MaxPlayers: Integer read FMaxPlayers write FMaxPlayers;	174	property MaxPlayers: Integer read FMaxPlayers write FMaxPlayers;
156	property OnAddPlayer: TDXPlayEvent read FOnAddPlayer write FOnAddPlayer;	175	property OnAddPlayer: TDXPlayEvent read FOnAddPlayer write FOnAddPlayer;
157	property OnClose: TNotifyEvent read FOnClose write FOnClose;	176	property OnClose: TNotifyEvent read FOnClose write FOnClose;
158	property OnDeletePlayer: TDXPlayEvent read FOnDeletePlayer write FOnDeletePlayer;	177	property OnDeletePlayer: TDXPlayEvent read FOnDeletePlayer write FOnDeletePlayer;
159	property OnMessage: TDXPlayMessageEvent read FOnMessage write FOnMessage;	178	property OnMessage: TDXPlayMessageEvent read FOnMessage write FOnMessage;
160	property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;	179	property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
161	property OnSendComplete: TDXPlaySendCompleteEvent read FOnSendComplete write FOnSendComplete;	180	property OnSendComplete: TDXPlaySendCompleteEvent read FOnSendComplete write FOnSendComplete;
162	property OnSessionLost: TNotifyEvent read FOnSessionLost write FOnSessionLost;	181	property OnSessionLost: TNotifyEvent read FOnSessionLost write FOnSessionLost;
163	property Opened: Boolean read FOpened;	182	property Opened: Boolean read FOpened;
164	property Players: TDXPlayPlayers read FPlayers;	183	property Players: TDXPlayPlayers read FPlayers;
165	property ProviderName: string read FProviderName write SetProviderName;	184	property ProviderName: string read FProviderName write SetProviderName;
166	property Providers: TStrings read GetProviders;	185	property Providers: TStrings read GetProviders;
167	property SessionName: string read FSessionName;	186	property SessionName: string read FSessionName;
168	property Sessions: TStrings read GetSessionsPty;	187	property Sessions: TStrings read GetSessionsPty;
169	property ModemSetting: TDXPlayModemSetting read FModemSetting write SetModemSetting;	188	property ModemSetting: TDXPlayModemSetting read FModemSetting write SetModemSetting;
170	property TCPIPSetting: TDXPlayTCPIPSetting read FTCPIPSetting write SetTCPIPSetting;	189	property TCPIPSetting: TDXPlayTCPIPSetting read FTCPIPSetting write SetTCPIPSetting;
171	property Async: Boolean read FAsync write FAsync;	190	property Async: Boolean read FAsync write FAsync;
172	property AsyncSupported: Boolean read FAsyncSupported;	191	property AsyncSupported: Boolean read FAsyncSupported;
173	end;	192	end;
174		193
175	TDXPlay = class(TCustomDXPlay)	194	TDXPlay = class(TCustomDXPlay)
176	published	195	published
177	property Async;	196	property Async;
178	property GUID;	197	property GUID;
179	property MaxPlayers;	198	property MaxPlayers;
180	property ModemSetting;	199	property ModemSetting;
181	property TCPIPSetting;	200	property TCPIPSetting;
182	property OnAddPlayer;	201	property OnAddPlayer;
183	property OnClose;	202	property OnClose;
184	property OnDeletePlayer;	203	property OnDeletePlayer;
185	property OnMessage;	204	property OnMessage;
186	property OnOpen;	205	property OnOpen;
187	property OnSendComplete;	206	property OnSendComplete;
188	property OnSessionLost;	207	property OnSessionLost;
189	end;	208	end;
190		209
191	function DXPlayMessageType(P: Pointer): DWORD;	210	function DXPlayMessageType(P: Pointer): DWORD;
192		211
193	function DXPlayStringToGUID(const S: string): TGUID;	212	function DXPlayStringToGUID(const S: string): TGUID;
194	function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP: IDirectPlay;	213	function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
-		214	//{$IfDef DX7}
-		215	IDirectPlay;
-		216	//{$Else}IDirectPlay8Server{$EndIf};
195	pUnk: IUnknown): HRESULT;	217	pUnk: IUnknown): HRESULT;
196		218
197	implementation	219	implementation
198		220
199	uses DXPlayFm, DXConsts;	221	uses DXPlayFm, DXConsts;
200		222
201	function DXPlayMessageType(P: Pointer): DWORD;	223	function DXPlayMessageType(P: Pointer): DWORD;
202	begin	224	begin
203	Result := PDPMSG_GENERIC(P)^.dwType;	225	Result := PDPMSG_GENERIC(P)^.dwType;
204	end;	226	end;
205		227
206	function DXPlayStringToGUID(const S: string): TGUID;	228	function DXPlayStringToGUID(const S: string): TGUID;
207	var	229	var
208	ErrorCode: Integer;	230	ErrorCode: Integer;
209	begin	231	begin
210	ErrorCode := CLSIDFromString(PWideChar(WideString(S)), Result);	232	ErrorCode := CLSIDFromString(PWideChar(WideString(S)), Result);
211	if ErrorCode<0 then	233	if ErrorCode<0 then
212	raise EDXPlayError.Create(WindowsErrorMsg(ErrorCode));	234	raise EDXPlayError.Create(WindowsErrorMsg(ErrorCode));
213	end;	235	end;
214		236
215	function GUIDToString(const ClassID: TGUID): string;	237	function GUIDToString(const ClassID: TGUID): string;
216	var	238	var
217	ErrorCode: Integer;	239	ErrorCode: Integer;
218	P: PWideChar;	240	P: PWideChar;
219	begin	241	begin
220	ErrorCode := StringFromCLSID(ClassID, P);	242	ErrorCode := StringFromCLSID(ClassID, P);
221	if ErrorCode<0 then	243	if ErrorCode<0 then
222	raise EDXPlayError.Create(WindowsErrorMsg(ErrorCode));	244	raise EDXPlayError.Create(WindowsErrorMsg(ErrorCode));
223	Result := P;	245	Result := P;
224	CoTaskMemFree(P);	246	CoTaskMemFree(P);
225	end;	247	end;
226		248
227	function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP: IDirectPlay;	249	function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
-		250	//{$IfDef DX7}
-		251	IDirectPlay;
-		252	//{$Else}IDirectPlay8Server{$EndIf};
228	pUnk: IUnknown): HRESULT;	253	pUnk: IUnknown): HRESULT;
229	type	254	type
230	TDirectPlayCreate= function(const lpGUID: TGUID; out lplpDP: IDirectPlay; pUnk: IUnknown): HRESULT; stdcall;	255	TDirectPlayCreate= function(const lpGUID: TGUID; out lplpDP: IDirectPlay; pUnk: IUnknown): HRESULT; stdcall;
231	begin	256	begin
232	Result := TDirectPlayCreate(DXLoadLibrary('DPlayX.dll', 'DirectPlayCreate'))	257	Result := TDirectPlayCreate(DXLoadLibrary('DPlayX.dll', 'DirectPlayCreate'))
233	(lpGUID, lplpDP, pUnk);	258	(lpGUID, lplpDP, pUnk);
234	end;	259	end;
-		260	{$IFDEF UNICODE}
-		261	function DXDirectPlayEnumerate(lpEnumDPCallback: TDPEnumDPCallbackW; lpContext: Pointer): HRESULT;
-		262	type
-		263	TDirectPlayEnumerateW= function(lpEnumDPCallback: TDPEnumDPCallbackW; lpContext: Pointer): HRESULT; stdcall;
-		264	begin
-		265	Result := TDirectPlayEnumerateW(DXLoadLibrary('DPlayX.dll', 'DirectPlayEnumerateW'))
-		266	(lpEnumDPCallback, lpContext);
-		267	end;
235		268
-		269	function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyW;
-		270	lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT;
-		271	type
-		272	TDirectPlayLobbyCreateW = function(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyW;
-		273	lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT; stdcall;
-		274	begin
-		275	Result := TDirectPlayLobbyCreateW(DXLoadLibrary('DPlayX.dll', 'DirectPlayLobbyCreateW'))
-		276	(lpguidSP, lplpDPL, lpUnk, lpData, dwDataSize);
-		277	end;
-		278	{$ELSE}
236	function DXDirectPlayEnumerateA(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT;	279	function DXDirectPlayEnumerate(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT;
237	type	280	type
238	TDirectPlayEnumerateA= function(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT; stdcall;	281	TDirectPlayEnumerateA= function(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT; stdcall;
239	begin	282	begin
240	Result := TDirectPlayEnumerateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayEnumerateA'))	283	Result := TDirectPlayEnumerateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayEnumerateA'))
241	(lpEnumDPCallback, lpContext);	284	(lpEnumDPCallback, lpContext);
242	end;	285	end;
243		286
244	function DXDirectPlayLobbyCreateA(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;	287	function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
245	lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT;	288	lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT;
246	type	289	type
247	TDirectPlayLobbyCreateA = function(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;	290	TDirectPlayLobbyCreateA = function(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
248	lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT; stdcall;	291	lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT; stdcall;
249	begin	292	begin
250	Result := TDirectPlayLobbyCreateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayLobbyCreateA'))	293	Result := TDirectPlayLobbyCreateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayLobbyCreateA'))
251	(lpguidSP, lplpDPL, lpUnk, lpData, dwDataSize);	294	(lpguidSP, lplpDPL, lpUnk, lpData, dwDataSize);
252	end;	295	end;
253		296	{$ENDIF}
254	{ TDXPlayPlayers }	297	{ TDXPlayPlayers }
255		298
256	constructor TDXPlayPlayers.Create;	299	constructor TDXPlayPlayers.Create;
257	begin	300	begin
258	inherited Create(TDXPlayPlayer);	301	inherited Create(TDXPlayPlayer);
259	end;	302	end;
260		303
261	function TDXPlayPlayers.Find(ID: TDPID): TDXPlayPlayer;	304	function TDXPlayPlayers.Find(ID: TDPID): TDXPlayPlayer;
262	var	305	var
263	i: Integer;	306	i: Integer;
264	begin	307	begin
265	i := IndexOf(ID);	308	i := IndexOf(ID);
266	if i=-1 then	309	if i=-1 then
267	raise EDXPlayError.Create(SDXPlayPlayerNotFound);	310	raise EDXPlayError.Create(SDXPlayPlayerNotFound);
268	Result := Players[i];	311	Result := Players[i];
269	end;	312	end;
270		313
271	function TDXPlayPlayers.IndexOf(ID: TDPID): Integer;	314	function TDXPlayPlayers.IndexOf(ID: TDPID): Integer;
272	var	315	var
273	i: Integer;	316	i: Integer;
274	begin	317	begin
275	for i:=0 to Count-1 do	318	for i:=0 to Count-1 do
276	if Players[i].FID=ID then	319	if Players[i].FID=ID then
277	begin	320	begin
278	Result := i;	321	Result := i;
279	Exit;	322	Exit;
280	end;	323	end;
281	Result := -1;	324	Result := -1;
282	end;	325	end;
283		326
284	function TDXPlayPlayers.GetPlayer(Index: Integer): TDXPlayPlayer;	327	function TDXPlayPlayers.GetPlayer(Index: Integer): TDXPlayPlayer;
285	begin	328	begin
286	Result := TDXPlayPlayer(Items[Index]);	329	Result := TDXPlayPlayer(Items[Index]);
287	end;	330	end;
288		331
289	{ TDXPlayModemSetting }	332	{ TDXPlayModemSetting }
290		333
291	destructor TDXPlayModemSetting.Destroy;	334	destructor TDXPlayModemSetting.Destroy;
292	begin	335	begin
293	FModemNames.Free;	336	FModemNames.Free;
294	inherited Destroy;	337	inherited Destroy;
295	end;	338	end;
296		339
297	procedure TDXPlayModemSetting.Assign(Source: TPersistent);	340	procedure TDXPlayModemSetting.Assign(Source: TPersistent);
298	begin	341	begin
299	if Source is TDXPlayModemSetting then	342	if Source is TDXPlayModemSetting then
300	begin	343	begin
301	FEnabled := TDXPlayModemSetting(Source).FEnabled;	344	FEnabled := TDXPlayModemSetting(Source).FEnabled;
302	FPhoneNumber := TDXPlayModemSetting(Source).FPhoneNumber;	345	FPhoneNumber := TDXPlayModemSetting(Source).FPhoneNumber;
303	FModemName := TDXPlayModemSetting(Source).FModemName;	346	FModemName := TDXPlayModemSetting(Source).FModemName;
304	end else	347	end else
305	inherited Assign(Source);	348	inherited Assign(Source);
306	end;	349	end;
307		350
308	function TDXPlayModemSetting.GetModemNames: TStrings;	351	function TDXPlayModemSetting.GetModemNames: TStrings;
309		352
310	function EnumModemAddress(const guidDataType: TGUID;	353	function EnumModemAddress(const guidDataType: TGUID;
311	dwDataSize: DWORD; lpData: Pointer; lpContext: Pointer): BOOL; stdcall;	354	dwDataSize: DWORD; lpData: Pointer; lpContext: Pointer): BOOL; stdcall;
312	begin	355	begin
313	if CompareMem(@guidDataType, @DPAID_Modem, SizeOf(TGUID)) then	356	if CompareMem(@guidDataType, @DPAID_Modem, SizeOf(TGUID)) then
314	TStrings(lpContext).Add( PChar(lpData));	357	TStrings(lpContext).Add( PChar(lpData));
315	Result := True;	358	Result := True;
316	end;	359	end;
317		360
318	var	361	var
-		362	{$IFDEF UNICODE}
-		363	Lobby1: IDirectPlayLobbyW;
-		364	Lobby: IDirectPlayLobby2W;
-		365	DPlay: IDirectPlay4W;
-		366	{$ELSE}
319	Lobby1: IDirectPlayLobbyA;	367	Lobby1: IDirectPlayLobbyA;
320	Lobby: IDirectPlayLobby2A;	368	Lobby: IDirectPlayLobby2A;
321	DPlay1: IDirectPlay;	-
322	DPlay: IDirectPlay4A;	369	DPlay: IDirectPlay4A;
-		370	{$ENDIF}
-		371	DPlay1: IDirectPlay;
323	lpAddress: Pointer;	372	lpAddress: Pointer;
324	dwAddressSize: DWORD;	373	dwAddressSize: DWORD;
325	begin	374	begin
326	if FModemNames=nil then	375	if FModemNames=nil then
327	begin	376	begin
328	FModemNames := TStringList.Create;	377	FModemNames := TStringList.Create;
329	try	378	try
330	if DXDirectPlayLobbyCreateA(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then	379	if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
331	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);	380	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
332	Lobby := Lobby1 as IDirectPlayLobby2A;	381	Lobby := Lobby1 as {$IFDEF UNICODE}IDirectPlayLobby2W{$ELSE}IDirectPlayLobby2A{$ENDIF};
333		382
334	if DXDirectPlayCreate(DPSPGUID_MODEM, DPlay1, nil)<>0 then	383	if DXDirectPlayCreate(DPSPGUID_MODEM, DPlay1, nil)<>0 then
335	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);	384	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
336	DPlay := DPlay1 as IDirectPlay4A;	385	DPlay := DPlay1 as {$IFDEF UNICODE}IDirectPlay4W{$ELSE}IDirectPlay4A{$ENDIF};
337		386
338	{ get size of player address for all players }	387	{ get size of player address for all players }
339	if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, nil^, dwAddressSize)<>DPERR_BUFFERTOOSMALL then	388	if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
340	raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);	389	raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
341		390
342	GetMem(lpAddress, dwAddressSize);	391	GetMem(lpAddress, dwAddressSize);
343	try	392	try
344	FillChar(lpAddress^, dwAddressSize, 0);	393	FillChar(lpAddress^, dwAddressSize, 0);
345		394
346	{ get the address }	395	{ get the address }
347	if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, lpAddress^, dwAddressSize)<>0 then	396	if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, lpAddress, dwAddressSize)<>0 then
348	raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);	397	raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
349		398
350	{ get modem strings from address and put them in the combo box }	399	{ get modem strings from address and put them in the combo box }
351	if Lobby.EnumAddress(@EnumModemAddress, lpAddress^, dwAddressSize, FModemNames)<>0 then	400	if Lobby.EnumAddress(@EnumModemAddress, lpAddress^, dwAddressSize, FModemNames)<>0 then
352	raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);	401	raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
353	finally	402	finally
354	FreeMem(lpAddress);	403	FreeMem(lpAddress);
355	end;	404	end;
356	except	405	except
357	FModemNames.Free; FModemNames := nil;	406	FModemNames.Free; FModemNames := nil;
358	raise;	407	raise;
359	end;	408	end;
360	end;	409	end;
361		410
362	Result := FModemNames;	411	Result := FModemNames;
363	end;	412	end;
364		413
365	{ TDXPlayTCPIPSetting }	414	{ TDXPlayTCPIPSetting }
366		415
367	procedure TDXPlayTCPIPSetting.Assign(Source: TPersistent);	416	procedure TDXPlayTCPIPSetting.Assign(Source: TPersistent);
368	begin	417	begin
369	if Source is TDXPlayTCPIPSetting then	418	if Source is TDXPlayTCPIPSetting then
370	begin	419	begin
371	FEnabled := TDXPlayTCPIPSetting(Source).FEnabled;	420	FEnabled := TDXPlayTCPIPSetting(Source).FEnabled;
372	FHostName := TDXPlayTCPIPSetting(Source).FHostName;	421	FHostName := TDXPlayTCPIPSetting(Source).FHostName;
373	end else	422	end else
374	inherited Assign(Source);	423	inherited Assign(Source);
375	end;	424	end;
376		425
377	{ TCustomDXPlay }	426	{ TCustomDXPlay }
378		427
379	constructor TCustomDXPlay.Create(AOwner: TComponent);	428	constructor TCustomDXPlay.Create(AOwner: TComponent);
380	begin	429	begin
381	inherited Create(AOwner);	430	inherited Create(AOwner);
382	FPlayers := TDXPlayPlayers.Create;	431	FPlayers := TDXPlayPlayers.Create;
383	FModemSetting := TDXPlayModemSetting.Create;	432	FModemSetting := TDXPlayModemSetting.Create;
384	FTCPIPSetting := TDXPlayTCPIPSetting.Create;	433	FTCPIPSetting := TDXPlayTCPIPSetting.Create;
385	FSessions := TStringList.Create;	434	FSessions := TStringList.Create;
386		435
387	FGUID := GUIDToString(GUID_NULL);	436	FGUID := GUIDToString(GUID_NULL);
388	FMaxPlayers := 0;	437	FMaxPlayers := 0;
389	end;	438	end;
390		439
391	destructor TCustomDXPlay.Destroy;	440	destructor TCustomDXPlay.Destroy;
392	var	441	var
393	i: Integer;	442	i: Integer;
394	begin	443	begin
395	Close;	444	Close;
396		445
397	FPlayers.Free;	446	FPlayers.Free;
398		447
399	if FProviders<>nil then	448	if FProviders<>nil then
400	begin	449	begin
401	for i:=0 to FProviders.Count-1 do	450	for i:=0 to FProviders.Count-1 do
402	Dispose(PGUID(FProviders.Objects[i]));	451	Dispose(PGUID(FProviders.Objects[i]));
403	end;	452	end;
404	FProviders.Free;	453	FProviders.Free;
405	FModemSetting.Free;	454	FModemSetting.Free;
406	FTCPIPSetting.Free;	455	FTCPIPSetting.Free;
407	ClearSessionList;	456	ClearSessionList;
408	FSessions.Free;	457	FSessions.Free;
409	inherited Destroy;	458	inherited Destroy;
410	end;	459	end;
411		460
412	type	461	type
413	TDXPlayRecvThread = class(TThread)	462	TDXPlayRecvThread = class(TThread)
414	private	463	private
415	FDXPlay: TCustomDXPlay;	464	FDXPlay: TCustomDXPlay;
416	constructor Create(DXPlay: TCustomDXPlay);	465	constructor Create(DXPlay: TCustomDXPlay);
417	destructor Destroy; override;	466	destructor Destroy; override;
418	procedure Execute; override;	467	procedure Execute; override;
419	end;	468	end;
420		469
421	constructor TDXPlayRecvThread.Create(DXPlay: TCustomDXPlay);	470	constructor TDXPlayRecvThread.Create(DXPlay: TCustomDXPlay);
422	begin	471	begin
423	FDXPlay := DXPlay;	472	FDXPlay := DXPlay;
424		473
425	FDXPlay.FRecvEvent[1] := CreateEvent(nil, False, False, nil);	474	FDXPlay.FRecvEvent[1] := CreateEvent(nil, False, False, nil);
426		475
427	FreeOnTerminate := True;	476	FreeOnTerminate := True;
428	inherited Create(True);	477	inherited Create(True);
429	end;	478	end;
430		479
431	destructor TDXPlayRecvThread.Destroy;	480	destructor TDXPlayRecvThread.Destroy;
432	begin	481	begin
433	FreeOnTerminate := False;	482	FreeOnTerminate := False;
434	SetEvent(FDXPlay.FRecvEvent[1]);	483	SetEvent(FDXPlay.FRecvEvent[1]);
435		484
436	inherited Destroy;	485	inherited Destroy;
437		486
438	CloseHandle(FDXPlay.FRecvEvent[1]);	487	CloseHandle(FDXPlay.FRecvEvent[1]);
439		488
440	FDXPlay.FRecvThread := nil;	489	FDXPlay.FRecvThread := nil;
441	FDXPlay.Close;	490	FDXPlay.Close;
442	end;	491	end;
443		492
444	procedure TDXPlayRecvThread.Execute;	493	procedure TDXPlayRecvThread.Execute;
445	begin	494	begin
446	while WaitForMultipleObjects(2, @FDXPlay.FRecvEvent, False, INFINITE)=WAIT_OBJECT_0 do	495	while WaitForMultipleObjects(2, @FDXPlay.FRecvEvent, False, INFINITE)=WAIT_OBJECT_0 do
447	begin	496	begin
448	Synchronize(FDXPlay.ReceiveMessage);	497	Synchronize(FDXPlay.ReceiveMessage);
449	end;	498	end;
450	end;	499	end;

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/DXPlay.pas – Rev 1 → 4