Subversion Repositories spacemission

Rev

Rev 21 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit DXPlay;
  2.  
  3. {$INCLUDE DelphiXcfg.inc}
  4.  
  5. {$IFNDEF UseDirectPlay}
  6. // If you want to use DXPlay.pas, please enable the IFDEF UseDirectPlay in DelphiXcfg.inc
  7. interface
  8. implementation
  9. {$ELSE} // !UseDirectPlay
  10.  
  11. interface
  12.  
  13. uses
  14.   Windows, SysUtils, Classes, Forms, DXClass, ActiveX, DXETable,  
  15. {$IfDef StandardDX}
  16.   DirectDraw,
  17. // Delphi 2010 cannot be use DirectPlay8 because structure was not rewriten
  18. //  {$IfDef DX9}
  19. //  DirectPlay8, DX7toDX8;
  20. //  {$Else}
  21.   DirectPlay; //old wersion, current in directory
  22. //  {$EndIf}
  23. {$Else}
  24.   DirectX;
  25. {$EndIf}
  26.  
  27. type
  28.   {$IfDef DX9}
  29.   TDPID = DWORD;
  30.   {$EndIf}
  31.  
  32.   {  TDXPlayPlayer  }
  33.  
  34.   TDXPlayPlayer = class(TCollectionItem)
  35.   private
  36.     FData: Pointer;
  37.     FID: TDPID;
  38.     FName: string;
  39.     FRemotePlayer: Boolean;
  40.   public
  41.     property Data: Pointer read FData write FData;
  42.     property ID: TDPID read FID;
  43.     property Name: string read FName;
  44.     property RemotePlayer: Boolean read FRemotePlayer;
  45.   end;
  46.  
  47.   {  TDXPlayPlayers  }
  48.  
  49.   TDXPlayPlayers = class(TCollection)
  50.   private
  51.     function GetPlayer(Index: Integer): TDXPlayPlayer;
  52.   public
  53.     constructor Create;
  54.     function Find(ID: TDPID): TDXPlayPlayer;
  55.     function IndexOf(ID: TDPID): Integer;
  56.     property Players[Index: Integer]: TDXPlayPlayer read GetPlayer; default;
  57.   end;
  58.  
  59.   {  TDXPlayModemSetting  }
  60.  
  61.   TDXPlayModemSetting = class(TPersistent)
  62.   private
  63.     FEnabled: Boolean;
  64.     FPhoneNumber: string;
  65.     FModemName: string;
  66.     FModemNames: TStrings;
  67.     function GetModemNames: TStrings;
  68.   public
  69.     destructor Destroy; override;
  70.     procedure Assign(Source: TPersistent); override;
  71.     property ModemName: string read FModemName write FModemName;
  72.     property ModemNames: TStrings read GetModemNames;
  73.   published
  74.     property Enabled: Boolean read FEnabled write FEnabled;
  75.     property PhoneNumber: string read FPhoneNumber write FPhoneNumber;
  76.   end;
  77.  
  78.   {  TDXPlayTCPIPSetting  }
  79.  
  80.   TDXPlayTCPIPSetting = class(TPersistent)
  81.   private
  82.     FEnabled: Boolean;
  83.     FHostName: string;
  84.     FPort: Word;
  85.   public
  86.     procedure Assign(Source: TPersistent); override;
  87.   published
  88.     property Enabled: Boolean read FEnabled write FEnabled;
  89.     property HostName: string read FHostName write FHostName;
  90.     property Port: Word read FPort write FPort;
  91.   end;
  92.  
  93.   {  EDXPlayError  }
  94.  
  95.   EDXPlayError = class(Exception);
  96.  
  97.   {  TCustomDXPlay  }
  98.  
  99.   TDXPlayEvent = procedure(Sender: TObject; Player: TDXPlayPlayer) of object;
  100.  
  101.   TDXPlayMessageEvent = procedure(Sender: TObject; From: TDXPlayPlayer;
  102.     Data: Pointer; DataSize: Integer) of object;
  103.  
  104.   TDXPlaySendCompleteResult = (crOk, crAbort, crGeneric);
  105.  
  106.   TDXPlaySendCompleteEvent = procedure(Sender: TObject; MessageID: DWORD;
  107.     Result: TDXPlaySendCompleteResult; SendTime: Integer) of object;
  108.  
  109.   TCustomDXPlay = class(TComponent)
  110.   private
  111.     FDPlay: //{$IfDef DX7}
  112.       IDirectPlay4A;//{$Else}IDirectPlay8Address{$EndIf};
  113.     FGUID: string;
  114.     FIsHost: Boolean;
  115.     FLocalPlayer: TDXPlayPlayer;
  116.     FMaxPlayers: Integer;
  117.     FPlayers: TDXPlayPlayers;
  118.     FCalledDoOpen: Boolean;
  119.     FOnAddPlayer: TDXPlayEvent;
  120.     FOnClose: TNotifyEvent;
  121.     FOnDeletePlayer: TDXPlayEvent;
  122.     FOnMessage: TDXPlayMessageEvent;
  123.     FOnOpen: TNotifyEvent;
  124.     FOnSendComplete: TDXPlaySendCompleteEvent;
  125.     FOnSessionLost: TNotifyEvent;
  126.     FOpened: Boolean;
  127.     FRecvEvent: array[0..1] of THandle;
  128.     FRecvThread: TThread;
  129.     FInThread: Boolean;
  130.     FProviderName: string;
  131.     FProviders: TStrings;
  132.     FSessionName: string;
  133.     FSessions: TStrings;
  134.     FReadSessioned: Boolean;
  135.     FModemSetting: TDXPlayModemSetting;
  136.     FTCPIPSetting: TDXPlayTCPIPSetting;
  137.     FAsync: Boolean;
  138.     FAsyncSupported: Boolean;
  139.     procedure ChangeDPlay;
  140.     procedure CreateDPlayWithoutDialog(out DPlay:
  141.      //{$IfDef DX7}
  142.      IDirectPlay4A;
  143.      //{$Else}IDirectPlay8Address{$EndIf};
  144.       const ProviderName: string);
  145.     function OpenDPlayWithLobby(out Name: string): Boolean;
  146.     function OpenDPlayWithoutLobby(out Name: string): Boolean;
  147.     function OpenDPlayWithoutLobby2(const NewSession: Boolean; const ProviderName, SessionName, PlayerName: string): Boolean;
  148.     procedure Open_(NameS: string);
  149.     procedure ReceiveMessage;
  150.     function GetProviders: TStrings;
  151.     function GetSessionsPty: TStrings;
  152.     procedure ClearSessionList;
  153.     procedure SetGUID(const Value: string);
  154.     procedure SetModemSetting(Value: TDXPlayModemSetting);
  155.     procedure SetProviderName(const Value: string);
  156.     procedure SetTCPIPSetting(Value: TDXPlayTCPIPSetting);
  157.   protected
  158.     procedure DoAddPlayer(Player: TDXPlayPlayer); virtual;
  159.     procedure DoClose; virtual;
  160.     procedure DoDeletePlayer(Player: TDXPlayPlayer); virtual;
  161.     procedure DoMessage(From: TDXPlayPlayer; Data: Pointer; DataSize: Integer); virtual;
  162.     procedure DoOpen; virtual;
  163.     procedure DoSessionLost; virtual;
  164.     procedure DoSendComplete(MessageID: DWORD; Result: TDXPlaySendCompleteResult;
  165.       SendTime: Integer); virtual;
  166.   public
  167.     constructor Create(AOwner: TComponent); override;
  168.     destructor Destroy; override;
  169.     procedure Close;
  170.     procedure Open;
  171.     procedure Open2(NewSession: Boolean; const SessionName, PlayerName: string);
  172.     function GetProviderNameFromGUID(const ProviderGUID: TGUID): string;
  173.     procedure GetSessions;
  174.     procedure SendMessage(ToID: TDPID; Data: Pointer; DataSize: Integer);
  175.     function SendMessageEx(ToID: TDPID; Data: Pointer; DataSize: Integer;
  176.       dwFlags: DWORD): DWORD;
  177.     property GUID: string read FGUID write SetGUID;
  178.     property IsHost: Boolean read FIsHost;
  179.     property LocalPlayer: TDXPlayPlayer read FLocalPlayer;
  180.     property MaxPlayers: Integer read FMaxPlayers write FMaxPlayers;
  181.     property OnAddPlayer: TDXPlayEvent read FOnAddPlayer write FOnAddPlayer;
  182.     property OnClose: TNotifyEvent read FOnClose write FOnClose;
  183.     property OnDeletePlayer: TDXPlayEvent read FOnDeletePlayer write FOnDeletePlayer;
  184.     property OnMessage: TDXPlayMessageEvent read FOnMessage write FOnMessage;
  185.     property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
  186.     property OnSendComplete: TDXPlaySendCompleteEvent read FOnSendComplete write FOnSendComplete;
  187.     property OnSessionLost: TNotifyEvent read FOnSessionLost write FOnSessionLost;
  188.     property Opened: Boolean read FOpened;
  189.     property Players: TDXPlayPlayers read FPlayers;
  190.     property ProviderName: string read FProviderName write SetProviderName;
  191.     property Providers: TStrings read GetProviders;
  192.     property SessionName: string read FSessionName;
  193.     property Sessions: TStrings read GetSessionsPty;
  194.     property ModemSetting: TDXPlayModemSetting read FModemSetting write SetModemSetting;
  195.     property TCPIPSetting: TDXPlayTCPIPSetting read FTCPIPSetting write SetTCPIPSetting;
  196.     property Async: Boolean read FAsync write FAsync;
  197.     property AsyncSupported: Boolean read FAsyncSupported;
  198.   end;
  199.  
  200.   TDXPlay = class(TCustomDXPlay)
  201.   published
  202.     property Async;
  203.     property GUID;
  204.     property MaxPlayers;
  205.     property ModemSetting;
  206.     property TCPIPSetting;
  207.     property OnAddPlayer;
  208.     property OnClose;
  209.     property OnDeletePlayer;
  210.     property OnMessage;
  211.     property OnOpen;
  212.     property OnSendComplete;
  213.     property OnSessionLost;
  214.   end;
  215.  
  216. function DXPlayMessageType(P: Pointer): DWORD;
  217.  
  218. function DXPlayStringToGUID(const S: string): TGUID;
  219. function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
  220.   //{$IfDef DX7}
  221.   IDirectPlay;
  222.   //{$Else}IDirectPlay8Server{$EndIf};
  223.   pUnk: IUnknown): HRESULT;
  224.  
  225. implementation
  226.  
  227. uses DXPlayFm, DXConsts;
  228.  
  229. function DXPlayMessageType(P: Pointer): DWORD;
  230. begin
  231.   Result := PDPMSG_GENERIC(P)^.dwType;
  232. end;
  233.  
  234. function DXPlayStringToGUID(const S: string): TGUID;
  235. var
  236.   ErrorCode: Integer;
  237. begin
  238.   ErrorCode := CLSIDFromString(PWideChar(WideString(S)), Result);
  239.   if ErrorCode<0 then
  240.     raise EDXPlayError.Create(WindowsErrorMsg(ErrorCode));
  241. end;
  242.  
  243. function GUIDToString(const ClassID: TGUID): string;
  244. var
  245.   ErrorCode: Integer;
  246.   P: PWideChar;
  247. begin
  248.   ErrorCode := StringFromCLSID(ClassID, P);
  249.   if ErrorCode<0 then
  250.     raise EDXPlayError.Create(WindowsErrorMsg(ErrorCode));
  251.   Result := P;
  252.   CoTaskMemFree(P);
  253. end;
  254.  
  255. function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
  256.   //{$IfDef DX7}
  257.   IDirectPlay;
  258.   //{$Else}IDirectPlay8Server{$EndIf};
  259.   pUnk: IUnknown): HRESULT;
  260. type
  261.   TDirectPlayCreate= function(const lpGUID: TGUID; out lplpDP: IDirectPlay; pUnk: IUnknown): HRESULT; stdcall;
  262. begin
  263.   Result := TDirectPlayCreate(DXLoadLibrary('DPlayX.dll', 'DirectPlayCreate'))
  264.     (lpGUID, lplpDP, pUnk);
  265. end;
  266. {$IFDEF UNICODE}
  267. function DXDirectPlayEnumerate(lpEnumDPCallback: TDPEnumDPCallbackW; lpContext: Pointer): HRESULT;
  268. type
  269.   TDirectPlayEnumerateW= function(lpEnumDPCallback: TDPEnumDPCallbackW; lpContext: Pointer): HRESULT; stdcall;
  270. begin
  271.   Result := TDirectPlayEnumerateW(DXLoadLibrary('DPlayX.dll', 'DirectPlayEnumerateW'))
  272.     (lpEnumDPCallback, lpContext);
  273. end;
  274.  
  275. function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyW;
  276.   lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT;
  277. type
  278.   TDirectPlayLobbyCreateW = function(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyW;
  279.     lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT; stdcall;
  280. begin
  281.   Result := TDirectPlayLobbyCreateW(DXLoadLibrary('DPlayX.dll', 'DirectPlayLobbyCreateW'))
  282.     (lpguidSP, lplpDPL, lpUnk, lpData, dwDataSize);
  283. end;
  284. {$ELSE}
  285. function DXDirectPlayEnumerate(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT;
  286. type
  287.   TDirectPlayEnumerateA= function(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT; stdcall;
  288. begin
  289.   Result := TDirectPlayEnumerateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayEnumerateA'))
  290.     (lpEnumDPCallback, lpContext);
  291. end;
  292.  
  293. function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
  294.   lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT;
  295. type
  296.   TDirectPlayLobbyCreateA = function(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
  297.     lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT; stdcall;
  298. begin
  299.   Result := TDirectPlayLobbyCreateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayLobbyCreateA'))
  300.     (lpguidSP, lplpDPL, lpUnk, lpData, dwDataSize);
  301. end;
  302. {$ENDIF}
  303. {  TDXPlayPlayers  }
  304.  
  305. constructor TDXPlayPlayers.Create;
  306. begin
  307.   inherited Create(TDXPlayPlayer);
  308. end;
  309.  
  310. function TDXPlayPlayers.Find(ID: TDPID): TDXPlayPlayer;
  311. var
  312.   i: Integer;
  313. begin
  314.   i := IndexOf(ID);
  315.   if i=-1 then
  316.     raise EDXPlayError.Create(SDXPlayPlayerNotFound);
  317.   Result := Players[i];
  318. end;
  319.  
  320. function TDXPlayPlayers.IndexOf(ID: TDPID): Integer;
  321. var
  322.   i: Integer;
  323. begin
  324.   for i:=0 to Count-1 do
  325.     if Players[i].FID=ID then
  326.     begin
  327.       Result := i;
  328.       Exit;
  329.     end;
  330.   Result := -1;
  331. end;
  332.  
  333. function TDXPlayPlayers.GetPlayer(Index: Integer): TDXPlayPlayer;
  334. begin
  335.   Result := TDXPlayPlayer(Items[Index]);
  336. end;
  337.  
  338. {  TDXPlayModemSetting  }
  339.  
  340. destructor TDXPlayModemSetting.Destroy;
  341. begin
  342.   FModemNames.Free;
  343.   inherited Destroy;
  344. end;
  345.  
  346. procedure TDXPlayModemSetting.Assign(Source: TPersistent);
  347. begin
  348.   if Source is TDXPlayModemSetting then
  349.   begin
  350.     FEnabled := TDXPlayModemSetting(Source).FEnabled;
  351.     FPhoneNumber := TDXPlayModemSetting(Source).FPhoneNumber;
  352.     FModemName := TDXPlayModemSetting(Source).FModemName;
  353.   end else
  354.     inherited Assign(Source);
  355. end;
  356.  
  357. function TDXPlayModemSetting.GetModemNames: TStrings;
  358.  
  359.   function EnumModemAddress(const guidDataType: TGUID;
  360.     dwDataSize: DWORD; lpData: Pointer; lpContext: Pointer): BOOL; stdcall;
  361.   begin
  362.     if CompareMem(@guidDataType, @DPAID_Modem, SizeOf(TGUID)) then
  363.       TStrings(lpContext).Add( PChar(lpData));
  364.     Result := True;
  365.   end;
  366.  
  367. var
  368.   {$IFDEF UNICODE}
  369.   Lobby1: IDirectPlayLobbyW;
  370.   Lobby: IDirectPlayLobby2W;
  371.   DPlay: IDirectPlay4W;
  372.   {$ELSE}
  373.   Lobby1: IDirectPlayLobbyA;
  374.   Lobby: IDirectPlayLobby2A;
  375.   DPlay: IDirectPlay4A;
  376.   {$ENDIF}
  377.   DPlay1: IDirectPlay;
  378.   lpAddress: Pointer;
  379.   dwAddressSize: DWORD;
  380. begin
  381.   if FModemNames=nil then
  382.   begin
  383.     FModemNames := TStringList.Create;
  384.     try
  385.       if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
  386.         raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
  387.       Lobby := Lobby1 as {$IFDEF UNICODE}IDirectPlayLobby2W{$ELSE}IDirectPlayLobby2A{$ENDIF};
  388.  
  389.       if DXDirectPlayCreate(DPSPGUID_MODEM, DPlay1, nil)<>0 then
  390.         raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
  391.       DPlay := DPlay1 as {$IFDEF UNICODE}IDirectPlay4W{$ELSE}IDirectPlay4A{$ENDIF};
  392.  
  393.       {  get size of player address for all players  }
  394.       if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
  395.         raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
  396.  
  397.       GetMem(lpAddress, dwAddressSize);
  398.       try
  399.         FillChar(lpAddress^, dwAddressSize, 0);
  400.  
  401.         {  get the address  }
  402.         if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, lpAddress, dwAddressSize)<>0 then
  403.           raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
  404.  
  405.         {  get modem strings from address and put them in the combo box  }
  406.         if Lobby.EnumAddress(@EnumModemAddress, lpAddress^, dwAddressSize, FModemNames)<>0 then
  407.           raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
  408.       finally
  409.         FreeMem(lpAddress);
  410.       end;
  411.     except
  412.       FModemNames.Free; FModemNames := nil;
  413.       raise;
  414.     end;
  415.   end;
  416.  
  417.   Result := FModemNames;
  418. end;
  419.  
  420. {  TDXPlayTCPIPSetting  }
  421.  
  422. procedure TDXPlayTCPIPSetting.Assign(Source: TPersistent);
  423. begin
  424.   if Source is TDXPlayTCPIPSetting then
  425.   begin
  426.     FEnabled := TDXPlayTCPIPSetting(Source).FEnabled;
  427.     FHostName := TDXPlayTCPIPSetting(Source).FHostName;
  428.   end else
  429.     inherited Assign(Source);
  430. end;
  431.  
  432. {  TCustomDXPlay  }
  433.  
  434. constructor TCustomDXPlay.Create(AOwner: TComponent);
  435. begin
  436.   inherited Create(AOwner);
  437.   FPlayers := TDXPlayPlayers.Create;
  438.   FModemSetting := TDXPlayModemSetting.Create;
  439.   FTCPIPSetting := TDXPlayTCPIPSetting.Create;
  440.   FSessions := TStringList.Create;
  441.  
  442.   FGUID := GUIDToString(GUID_NULL);
  443.   FMaxPlayers := 0;
  444. end;
  445.  
  446. destructor TCustomDXPlay.Destroy;
  447. var
  448.   i: Integer;
  449. begin
  450.   Close;
  451.  
  452.   FPlayers.Free;
  453.  
  454.   if FProviders<>nil then
  455.   begin
  456.     for i:=0 to FProviders.Count-1 do
  457.       Dispose(PGUID(FProviders.Objects[i]));
  458.   end;
  459.   FProviders.Free;
  460.   FModemSetting.Free;
  461.   FTCPIPSetting.Free;
  462.   ClearSessionList;
  463.   FSessions.Free;
  464.   inherited Destroy;
  465. end;
  466.  
  467. type
  468.   TDXPlayRecvThread = class(TThread)
  469.   private
  470.     FDXPlay: TCustomDXPlay;
  471.     constructor Create(DXPlay: TCustomDXPlay);
  472.     destructor Destroy; override;
  473.     procedure Execute; override;
  474.   end;
  475.  
  476. constructor TDXPlayRecvThread.Create(DXPlay: TCustomDXPlay);
  477. begin
  478.   FDXPlay := DXPlay;
  479.  
  480.   FDXPlay.FRecvEvent[1] := CreateEvent(nil, False, False, nil);
  481.  
  482.   FreeOnTerminate := True;
  483.   inherited Create(True);
  484. end;
  485.  
  486. destructor TDXPlayRecvThread.Destroy;
  487. begin
  488.   FreeOnTerminate := False;
  489.   SetEvent(FDXPlay.FRecvEvent[1]);
  490.  
  491.   inherited Destroy;
  492.  
  493.   CloseHandle(FDXPlay.FRecvEvent[1]);
  494.  
  495.   FDXPlay.FRecvThread := nil;
  496.   FDXPlay.Close;
  497. end;
  498.  
  499. procedure TDXPlayRecvThread.Execute;
  500. begin
  501.   while WaitForMultipleObjects(2, @FDXPlay.FRecvEvent, False, INFINITE)=WAIT_OBJECT_0 do
  502.   begin
  503.     Synchronize(FDXPlay.ReceiveMessage);
  504.   end;
  505. end;
  506.  
  507. procedure TCustomDXPlay.ReceiveMessage;
  508. var
  509.   idFrom, idTo: DWORD;
  510.   hr: HRESULT;
  511.   lpvMsgBuffer: Pointer;
  512.   dwMsgBufferSize: DWORD;
  513.   Msg_CreatePlayerOrGroup: PDPMSG_CREATEPLAYERORGROUP;
  514.   Msg_DeletePlayerOrGroup: PDPMSG_DESTROYPLAYERORGROUP;
  515.   Msg_SendComplete: PDPMsg_SendComplete;
  516.   SendCompleteResult: TDXPlaySendCompleteResult;
  517.   Player: TDXPlayPlayer;
  518.   i: Integer;
  519. begin
  520.   FInThread := True;
  521.   try
  522.     try
  523.       lpvMsgBuffer := nil;
  524.       dwMsgBufferSize := 0;
  525.  
  526.       try
  527.         repeat
  528.           hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);
  529.  
  530.           if hr=DPERR_BUFFERTOOSMALL then
  531.           begin
  532.             ReAllocMem(lpvMsgBuffer, dwMsgBufferSize);
  533.             hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);
  534.           end;
  535.  
  536.           if (hr=0) and (dwMsgBufferSize>=SizeOf(TDPMSG_GENERIC)) then
  537.           begin
  538.             if idFrom=DPID_SYSMSG then
  539.             begin
  540.               {  System message  }
  541.               case PDPMSG_GENERIC(lpvMsgBuffer)^.dwType of
  542.                 DPSYS_CREATEPLAYERORGROUP:
  543.                   begin
  544.                     {  New player  }
  545.                     Msg_CreatePlayerOrGroup := lpvMsgBuffer;
  546.  
  547.                     if Msg_CreatePlayerOrGroup.DPID<>FLocalPlayer.FID then
  548.                     begin
  549.                       Player := TDXPlayPlayer.Create(Players);
  550.                       Player.FID := Msg_CreatePlayerOrGroup.DPID;
  551.                       Player.FRemotePlayer := True;
  552.  
  553.                       with Msg_CreatePlayerOrGroup.dpnName do
  554.                       begin
  555.                         {$IFDEF UNICODE}
  556.                         if lpszShortNameW<>nil then
  557.                           Player.FName := lpszShortNameW;
  558.                         {$ELSE}
  559.                         if lpszShortNameA<>nil then
  560.                           Player.FName := lpszShortNameA;
  561.                         {$ENDIF}
  562.                       end;
  563.  
  564.                       DoAddPlayer(Player);
  565.                     end;
  566.                   end;
  567.                 DPSYS_DESTROYPLAYERORGROUP:
  568.                   begin
  569.                     {  Player deletion  }
  570.                     Msg_DeletePlayerOrGroup := lpvMsgBuffer;
  571.  
  572.                     if Msg_DeletePlayerOrGroup.DPID<>FLocalPlayer.FID then
  573.                     begin
  574.                       i := Players.IndexOf(Msg_DeletePlayerOrGroup.DPID);
  575.                       if i<>-1 then
  576.                       begin
  577.                         Player := Players[i];
  578.                         DoDeletePlayer(Player);
  579.                         Player.Free;
  580.                       end;
  581.                     end;
  582.                   end;
  583.                 DPSYS_SESSIONLOST:
  584.                   begin
  585.                     {  The session was lost.  }
  586.                     DoSessionLost;
  587.                     Close;
  588.                   end;
  589.                 DPSYS_HOST:
  590.                   begin
  591.                     {  Here became a host.  }
  592.                     FIsHost := True;
  593.                   end;
  594.                 DPSYS_SENDCOMPLETE:
  595.                    begin
  596.                      { Send complete  }
  597.                      Msg_SendComplete := lpvMsgBuffer;
  598.                      if Msg_SendComplete.idFrom=FLocalPlayer.FID then
  599.                      begin
  600.                        case Msg_SendComplete.hr of
  601.                          DP_OK        : SendCompleteResult := crOk;
  602.                          DPERR_ABORTED: SendCompleteResult := crAbort;
  603.                          else           SendCompleteResult := crGeneric;
  604.                        end;
  605.  
  606.                        DoSendComplete(Msg_SendComplete^.dwMsgID, SendCompleteResult, Msg_SendComplete^.dwSendTime);
  607.                      end;
  608.                    end;
  609.               end;
  610.             end else
  611.             begin
  612.               {  Application definition message  }
  613.               DoMessage(Players.Find(idFrom), lpvMsgBuffer, dwMsgBufferSize);
  614.             end;
  615.           end;
  616.         until hr<>0;
  617.       finally
  618.         FreeMem(lpvMsgBuffer);
  619.       end;
  620.     except
  621.       on E: Exception do
  622.         Application.HandleException(E);
  623.     end;
  624.   finally
  625.     FInThread := False;
  626.   end;
  627. end;
  628.  
  629. procedure TCustomDXPlay.DoAddPlayer(Player: TDXPlayPlayer);
  630. begin
  631.   if Assigned(FOnAddPlayer) then FOnAddPlayer(Self, Player)
  632. end;
  633.  
  634. procedure TCustomDXPlay.DoClose;
  635. begin
  636.   if Assigned(FOnClose) then FOnClose(Self);
  637. end;
  638.  
  639. procedure TCustomDXPlay.DoDeletePlayer(Player: TDXPlayPlayer);
  640. begin
  641.   if Assigned(FOnDeletePlayer) then FOnDeletePlayer(Self, Player)
  642. end;
  643.  
  644. procedure TCustomDXPlay.DoMessage(From: TDXPlayPlayer; Data: Pointer; DataSize: Integer);
  645. begin
  646.   if Assigned(FOnMessage) then FOnMessage(Self, From, Data, DataSize);
  647. end;
  648.  
  649. procedure TCustomDXPlay.DoOpen;
  650. begin
  651.   if Assigned(FOnOpen) then FOnOpen(Self);
  652. end;
  653.  
  654. procedure TCustomDXPlay.DoSessionLost;
  655. begin
  656.   if Assigned(FOnSessionLost) then FOnSessionLost(Self);
  657. end;
  658.  
  659. procedure TCustomDXPlay.DoSendComplete(MessageID: DWORD; Result: TDXPlaySendCompleteResult;
  660.   SendTime: Integer);
  661. begin
  662.   if Assigned(FOnSendComplete) then FOnSendComplete(Self, MessageID, Result, SendTime);
  663. end;
  664.  
  665. function TCustomDXPlay.GetProviders: TStrings;
  666.  
  667.   function EnumProviderCallback(const lpguidSP: TGUID; lpSPName: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPSTR{$ENDIF};
  668.       dwMajorVersion: DWORD; dwMinorVersion: DWORD; lpContext: Pointer):
  669.       BOOL; stdcall;
  670.   var
  671.     GUID: PGUID;
  672.   begin
  673.     GUID := New(PGUID);
  674.     Move(lpguidSP, GUID^, SizeOf(TGUID));
  675.     TStrings(lpContext).AddObject(lpSPName, TObject(GUID));
  676.     Result := True;
  677.   end;
  678.  
  679. begin
  680.   if FProviders=nil then
  681.   begin
  682.     FProviders := TStringList.Create;
  683.     try
  684.       DXDirectPlayEnumerate(@EnumProviderCallback, FProviders);
  685.     except
  686.       FProviders.Free; FProviders := nil;
  687.       raise;
  688.     end;
  689.   end;
  690.  
  691.   Result := FProviders;
  692. end;
  693.  
  694. procedure TCustomDXPlay.GetSessions;
  695.  
  696.   function EnumSessionsCallback(const lpThisSD: TDPSessionDesc2;
  697.     var lpdwTimeOut: DWORD; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
  698.   var
  699.     Guid: PGUID;
  700.   begin
  701.     if dwFlags and DPESC_TIMEDOUT<>0 then
  702.     begin
  703.       Result := False;
  704.       Exit;
  705.     end;
  706.  
  707.     Guid := New(PGUID);
  708.     Move(lpThisSD.guidInstance, Guid^, SizeOf(TGUID));
  709.     {$IFDEF UNICODE}
  710.     TStrings(lpContext).AddObject(lpThisSD.lpszSessionNameW, TObject(Guid));
  711.     {$ELSE}
  712.     TStrings(lpContext).AddObject(lpThisSD.lpszSessionNameA, TObject(Guid));
  713.     {$ENDIF}
  714.     Result := True;
  715.   end;
  716.  
  717. var
  718.   dpDesc: TDPSessionDesc2;
  719.   hr: HRESULT;
  720. begin
  721.   if FDPlay=nil then
  722.     raise EDXPlayError.Create(SDXPlayNotConnectedNow);
  723.  
  724.   ClearSessionList;
  725.  
  726.   FillChar(dpDesc, SizeOf(dpDesc), 0);
  727.   dpDesc.dwSize := SizeOf(dpDesc);
  728.   dpDesc.guidApplication := DXPlayStringToGUID(FGUID);
  729.  
  730.   hr := FDPlay.EnumSessions(dpDesc, 0, @EnumSessionsCallback, FSessions, DPENUMSESSIONS_AVAILABLE);
  731.   if hr=DPERR_USERCANCEL then Abort;
  732.   if hr<>0 then
  733.     raise EDXPlayError.Create(SDXPlaySessionListCannotBeAcquired);
  734.  
  735.   FReadSessioned := True;
  736. end;
  737.  
  738. function TCustomDXPlay.GetSessionsPty: TStrings;
  739. begin
  740.   if not FReadSessioned then GetSessions;
  741.   Result := FSessions;
  742. end;
  743.  
  744. function TCustomDXPlay.GetProviderNameFromGUID(const ProviderGUID: TGUID): string;
  745. var
  746.   i: Integer;
  747. begin
  748.   for i:=0 to Providers.Count-1 do
  749.     if CompareMem(PGUID(Providers.Objects[i]), @ProviderGUID, SizeOf(TGUID)) then
  750.     begin
  751.       Result := Providers[i];
  752.       Exit;
  753.     end;
  754.  
  755.   raise EDXPlayError.Create(SDXPlayProviderSpecifiedGUIDNotFound);
  756. end;
  757.  
  758. procedure TCustomDXPlay.CreateDPlayWithoutDialog(out DPlay: IDirectPlay4A; const ProviderName: string);
  759. var
  760.   i: Integer;
  761.   ProviderGUID: TGUID;
  762.   addressElements: array[0..15] of TDPCompoundAddressElement;
  763.   dwElementCount: Integer;
  764.   {$IFDEF UNICODE}
  765.   Lobby1: IDirectPlayLobbyW;
  766.   Lobby: IDirectPlayLobby2W;
  767.   {$ELSE}
  768.   Lobby1: IDirectPlayLobbyA;
  769.   Lobby: IDirectPlayLobby2A;
  770.   {$ENDIF}
  771.   lpAddress: Pointer;
  772.   dwAddressSize: DWORD;
  773. begin
  774.   i := Providers.IndexOf(ProviderName);
  775.   if i=-1 then
  776.     raise EDXPlayError.CreateFmt(SDXPlayProviderNotFound, [ProviderName]);
  777.   ProviderGUID := PGUID(Providers.Objects[i])^;
  778.  
  779.   {  DirectPlay address making  }
  780.   if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
  781.     raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
  782.   Lobby := Lobby1 as {$IFDEF UNICODE}IDirectPlayLobby2W{$ELSE}IDirectPlayLobby2A{$ENDIF};
  783.  
  784.   FillChar(addressElements, SizeOf(addressElements), 0);
  785.   dwElementCount := 0;
  786.  
  787.   addressElements[dwElementCount].guidDataType := DPAID_ServiceProvider;
  788.   addressElements[dwElementCount].dwDataSize := SizeOf(TGUID);
  789.   addressElements[dwElementCount].lpData := @ProviderGUID;
  790.   Inc(dwElementCount);
  791.  
  792.   if CompareMem(@ProviderGUID, @DPSPGUID_MODEM, SizeOf(TGUID)) and ModemSetting.Enabled then
  793.   begin
  794.     {  Modem  }
  795.     if ModemSetting.FModemName<>'' then
  796.     begin
  797.       addressElements[dwElementCount].guidDataType := DPAID_Modem;
  798.       addressElements[dwElementCount].dwDataSize := Length(ModemSetting.FModemName)+1;
  799.       addressElements[dwElementCount].lpData := PChar(ModemSetting.FModemName);
  800.       Inc(dwElementCount);
  801.     end;
  802.  
  803.     if ModemSetting.FPhoneNumber<>'' then
  804.     begin
  805.       addressElements[dwElementCount].guidDataType := DPAID_Phone;
  806.       addressElements[dwElementCount].dwDataSize := Length(ModemSetting.FPhoneNumber)+1;
  807.       addressElements[dwElementCount].lpData := PChar(ModemSetting.FPhoneNumber);
  808.       Inc(dwElementCount);
  809.     end;
  810.   end else
  811.   if CompareMem(@ProviderGUID, @DPSPGUID_TCPIP, SizeOf(TGUID)) and TCPIPSetting.Enabled then
  812.   begin
  813.     {  TCP/IP  }
  814.     if TCPIPSetting.FHostName<>'' then
  815.     begin
  816.       addressElements[dwElementCount].guidDataType := DPAID_INet;
  817.       addressElements[dwElementCount].dwDataSize := Length(TCPIPSetting.FHostName)+1;
  818.       addressElements[dwElementCount].lpData := PChar(TCPIPSetting.FHostName);
  819.       Inc(dwElementCount);
  820.     end;
  821.  
  822.     if TCPIPSetting.Port<>0 then
  823.     begin
  824.       addressElements[dwElementCount].guidDataType := DPAID_INetPort;
  825.       addressElements[dwElementCount].dwDataSize := SizeOf(TCPIPSetting.FPort);
  826.       addressElements[dwElementCount].lpData := @TCPIPSetting.FPort;
  827.       Inc(dwElementCount);
  828.     end;
  829.   end;
  830.  
  831.   if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
  832.     raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
  833.  
  834.   GetMem(lpAddress, dwAddressSize);
  835.   try
  836.     FillChar(lpAddress^, dwAddressSize, 0);
  837.  
  838.     if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, lpAddress, dwAddressSize)<>0 then
  839.       raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
  840.  
  841.     {  DirectPlay initialization  }
  842.     if CoCreateInstance(CLSID_DirectPlay, nil, CLSCTX_INPROC_SERVER, IID_IDirectPlay4A, DPlay)<>0 then
  843.       raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
  844.     try
  845.       {  DirectPlay address initialization  }
  846.       if DPlay.InitializeConnection(lpAddress, 0)<>0 then
  847.         raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
  848.     except
  849.       DPlay := nil;
  850.       raise;
  851.     end;
  852.   finally
  853.     FreeMem(lpAddress);
  854.   end;
  855. end;
  856.  
  857. procedure TCustomDXPlay.ClearSessionList;
  858. var
  859.   i: Integer;
  860. begin
  861.   FReadSessioned := False;
  862.   for i:=0 to FSessions.Count-1 do
  863.     Dispose(PGUID(FSessions.Objects[i]));
  864.   FSessions.Clear;
  865. end;
  866.  
  867. procedure TCustomDXPlay.Open;
  868. var
  869.   PlayerName: string;
  870. begin
  871.   Close;
  872.   try
  873.     if not OpenDPlayWithLobby(PlayerName) then
  874.     begin
  875.       if not OpenDPlayWithoutLobby(PlayerName) then
  876.         Abort;
  877.     end;
  878.  
  879.     Open_(PlayerName);
  880.   except
  881.     Close;
  882.     raise;
  883.   end;
  884. end;
  885.  
  886. procedure TCustomDXPlay.Open2(NewSession: Boolean; const SessionName, PlayerName: string);
  887. begin
  888.   if not OpenDPlayWithoutLobby2(NewSession, ProviderName, SessionName, PlayerName) then
  889.     Abort;
  890.  
  891.   Open_(PlayerName);
  892. end;
  893.  
  894. procedure TCustomDXPlay.Open_(NameS: string);
  895.  
  896.   function EnumPlayersCallback2(TDPID: TDPID; dwPlayerType: DWORD;
  897.     const lpName: TDPName; dwFlags: DWORD; lpContext: Pointer): BOOL;
  898.     stdcall;
  899.   var
  900.     Player: TDXPlayPlayer;
  901.   begin
  902.     Player := TDXPlayPlayer.Create(TCustomDXPlay(lpContext).Players);
  903.     Player.FID := TDPID;
  904.     Player.FRemotePlayer := True;
  905.  
  906.     with lpName do
  907.     begin
  908.       {$IFDEF UNICODE}
  909.       if lpszShortNameW<>nil then
  910.         Player.FName := lpszShortNameW;
  911.       {$ELSE}
  912.       if lpszShortNameA<>nil then
  913.         Player.FName := lpszShortNameA;
  914.       {$ENDIF}
  915.     end;
  916.  
  917.     Result := True;
  918.   end;
  919.  
  920. var
  921.   Name2: array[0..1023] of Char;
  922.   Name: TDPName;
  923. begin
  924.   if FOpened then Close;
  925.   FOpened := True;
  926.   try
  927.     {  Player making  }
  928.     StrLCopy(@Name2, PChar(NameS), SizeOf(Name2));
  929.  
  930.     Name.lpszShortNameA := @Name2;
  931.     Name.lpszLongNameA := nil;
  932.  
  933.     FRecvEvent[0] := CreateEvent(nil, False, False, nil);
  934.  
  935.     FLocalPlayer := TDXPlayPlayer.Create(FPlayers);
  936.     FLocalPlayer.FName := NameS;
  937.  
  938.     if FDPlay.CreatePlayer(FLocalPlayer.FID, @Name, FRecvEvent[0], nil, 0, 0)<>DP_OK then
  939.       raise EDXPlayError.CreateFmt(SCannotOpened, [FSessionName]);
  940.  
  941.     {  Player enumeration  }
  942.     FDPlay.EnumPlayers(PGUID(nil), @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
  943.  
  944.     FIsHost := FPlayers.Count=1;
  945.  
  946.     FCalledDoOpen := True; DoOpen;
  947.     DoAddPlayer(FLocalPlayer);
  948.  
  949.     {  Thread start  }
  950.     FRecvThread := TDXPlayRecvThread.Create(Self);
  951.     FRecvThread.{$IFDEF VER14UP}Start{$ELSE}Resume{$ENDIF};
  952.   except
  953.     Close;
  954.     raise;
  955.   end;
  956. end;
  957.  
  958. procedure TCustomDXPlay.ChangeDPlay;
  959. var
  960.   caps: TDPCAPS;
  961. begin
  962.   FAsyncSupported := False;
  963.   if FDPlay<>nil then
  964.   begin
  965.     FillChar(caps, SizeOf(caps), 0);
  966.     caps.dwSize := SizeOf(caps);
  967.     FDPlay.GetCaps(caps, 0);
  968.  
  969.     FAsyncSupported := caps.dwFlags and DPCAPS_ASYNCSUPPORTED<>0;
  970.   end;
  971. end;
  972.  
  973. function TCustomDXPlay.OpenDPlayWithLobby(out Name: string): Boolean;
  974. var
  975.   DPlay1: IDirectPlay2;
  976.   {$IFDEF UNICODE}
  977.   Lobby: IDirectPlayLobbyW;
  978.   {$ELSE}
  979.   Lobby: IDirectPlayLobbyA;
  980.   {$ENDIF}
  981.   dwSize: DWORD;
  982.   ConnectionSettings: PDPLConnection;
  983. begin
  984.   Result := False;
  985.  
  986.   if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby, nil, nil, 0)<>0 then
  987.     Exit;
  988.  
  989.   if Lobby.GetConnectionSettings(0, PDPLConnection(nil), dwSize)<>DPERR_BUFFERTOOSMALL then
  990.     Exit;
  991.  
  992.   GetMem(ConnectionSettings, dwSize);
  993.   try
  994.     if Lobby.GetConnectionSettings(0, ConnectionSettings, dwSize)<>0 then
  995.       Exit;
  996.  
  997.     with ConnectionSettings^.lpSessionDesc^ do
  998.     begin
  999.       dwFlags := DPSESSION_MIGRATEHOST or DPSESSION_KEEPALIVE or DPSESSION_DIRECTPLAYPROTOCOL;
  1000.       dwMaxPlayers := FMaxPlayers;
  1001.     end;
  1002.  
  1003.     if Lobby.SetConnectionSettings(0, 0, ConnectionSettings^)<>0 then
  1004.       Exit;
  1005.  
  1006.     if Lobby.Connect(0, DPlay1, nil)<>0 then
  1007.       Exit;
  1008.     FDPlay := DPlay1 as IDirectPlay4A;
  1009.     ChangeDPlay;
  1010.  
  1011.     with ConnectionSettings.lpSessionDesc^ do
  1012.     begin
  1013.       {$IFDEF UNICODE}
  1014.       if lpszSessionNameW<>nil then
  1015.         FSessionName := lpszSessionNameW;
  1016.       {$ELSE}
  1017.       if lpszSessionNameA<>nil then
  1018.         FSessionName := lpszSessionNameA;
  1019.       {$ENDIF}
  1020.     end;
  1021.  
  1022.     with ConnectionSettings.lpPlayerName^ do
  1023.     begin
  1024.       {$IFDEF UNICODE}
  1025.       if lpszShortNameW<>nil then
  1026.         Name := lpszShortNameW;
  1027.       {$ELSE}
  1028.       if lpszShortNameA<>nil then
  1029.         Name := lpszShortNameA;
  1030.       {$ENDIF}
  1031.     end;
  1032.   finally
  1033.     FreeMem(ConnectionSettings);
  1034.   end;
  1035.  
  1036.   Result := True;
  1037. end;
  1038.  
  1039. function TCustomDXPlay.OpenDPlayWithoutLobby(out Name: string): Boolean;
  1040. var
  1041.   Form: TDelphiXDXPlayForm;
  1042. begin
  1043.   Form := TDelphiXDXPlayForm.Create(Application);
  1044.   try
  1045.     Form.DXPlay := Self;
  1046.     Form.ShowModal;
  1047.  
  1048.     Result := Form.Tag<>0;
  1049.  
  1050.     FDPlay := Form.DPlay;
  1051.     ChangeDPlay;
  1052.  
  1053.     Name := Form.PlayerName;
  1054.     FProviderName := Form.ProviderName;
  1055.     FSessionName := Form.SessionName;
  1056.   finally
  1057.     Form.Free;
  1058.   end;
  1059. end;
  1060.  
  1061. function TCustomDXPlay.OpenDPlayWithoutLobby2(const NewSession: Boolean;
  1062.   const ProviderName, SessionName, PlayerName: string): Boolean;
  1063. var
  1064.   dpDesc: TDPSessionDesc2;
  1065.   i: Integer;
  1066.   hr: HRESULT;
  1067. begin
  1068.   Result := False;
  1069.  
  1070.   if FDPlay=nil then
  1071.     raise EDXPlayError.Create(SDXPlayNotConnectedNow);
  1072.  
  1073.   if SessionName='' then
  1074.     raise EDXPlayError.Create(SDXPlaySessionNameIsNotSpecified);
  1075.  
  1076.   if PlayerName='' then
  1077.     raise EDXPlayError.Create(SDXPlayPlayerNameIsNotSpecified);
  1078.  
  1079.   if NewSession then
  1080.   begin
  1081.     {  Session connection  }
  1082.     FillChar(dpDesc, SizeOf(dpDesc), 0);
  1083.     dpDesc.dwSize := SizeOf(dpDesc);
  1084.     dpDesc.dwFlags := DPSESSION_MIGRATEHOST or DPSESSION_KEEPALIVE;
  1085.     {$IFDEF UNICODE}
  1086.     dpDesc.lpszSessionNameW := {$IFDEF VER12UP}PChar{$ELSE}PWideChar{$ENDIF}(SessionName);
  1087.     {$ELSE}
  1088.     dpDesc.lpszSessionNameA := PAnsiChar(SessionName);
  1089.     {$ENDIF}
  1090.     dpDesc.guidApplication := DXPlayStringToGUID(GUID);
  1091.     dpDesc.dwMaxPlayers := MaxPlayers;
  1092.  
  1093.     hr := FDPlay.Open(dpDesc, DPOPEN_CREATE);
  1094.     if hr=DPERR_USERCANCEL then Exit;
  1095.     if hr<>0 then
  1096.       raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [FSessionName]);
  1097.   end else
  1098.   begin
  1099.     {  Session connection  }
  1100.     {  Enum session  }
  1101.     i := Sessions.IndexOf(SessionName);
  1102.     if i=-1 then raise EDXPlayError.CreateFmt(SDXPlaySessionNotFound, [SessionName]);
  1103.  
  1104.     FillChar(dpDesc, SizeOf(dpDesc), 0);
  1105.     dpDesc.dwSize := SizeOf(dpDesc);
  1106.     dpDesc.guidInstance := PGUID(Sessions.Objects[i])^;
  1107.     dpDesc.guidApplication := DXPlayStringToGUID(GUID);
  1108.  
  1109.     hr := FDPlay.Open(dpDesc, DPOPEN_JOIN);
  1110.     if hr=DPERR_USERCANCEL then Exit;
  1111.     if hr<>0 then
  1112.       raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [FSessionName]);
  1113.   end;
  1114.  
  1115.   Result := True;
  1116.  
  1117.   FSessionName := SessionName;
  1118. end;
  1119.  
  1120. procedure TCustomDXPlay.Close;
  1121. begin
  1122.   FOpened := False;
  1123.   FReadSessioned := False;
  1124.  
  1125.   try
  1126.     if FCalledDoOpen then
  1127.     begin
  1128.       FCalledDoOpen := False;
  1129.       DoClose;
  1130.     end;
  1131.   finally
  1132.     if FDPlay<>nil then
  1133.     begin
  1134.       if FLocalPlayer<>nil then FDPlay.DestroyPlayer(FLocalPlayer.FID);
  1135.       FDPlay.Close;
  1136.     end;
  1137.  
  1138.     FProviderName := '';
  1139.     FSessionName := '';
  1140.     FAsyncSupported := False;
  1141.  
  1142.     ClearSessionList;
  1143.  
  1144.     FDPlay := nil;
  1145.     ChangeDPlay;
  1146.  
  1147.     if FInThread then
  1148.       SetEvent(FRecvEvent[1])
  1149.     else
  1150.       FRecvThread.Free;
  1151.  
  1152.     CloseHandle(FRecvEvent[0]); FRecvEvent[0] := 0;
  1153.  
  1154.     FPlayers.Clear;
  1155.  
  1156.     FLocalPlayer := nil;
  1157.   end;
  1158. end;
  1159.  
  1160. procedure TCustomDXPlay.SendMessage(ToID: TDPID; Data: Pointer; DataSize: Integer);
  1161. begin
  1162.   if not Opened then Exit;
  1163.  
  1164.   if DataSize<SizeOf(TDPMSG_GENERIC) then
  1165.     raise EDXPlayError.Create(SDXPlayMessageIllegal);
  1166.  
  1167.   if ToID=FLocalPlayer.ID then
  1168.   begin
  1169.     {  Message to me  }
  1170.     DoMessage(FLocalPlayer, Data, DataSize);
  1171.   end else
  1172.   if FAsync and FAsyncSupported then
  1173.     FDPlay.SendEx(FLocalPlayer.ID, ToID, DPSEND_GUARANTEED or DPSEND_ASYNC, Data, DataSize, 0, 0, nil, nil)
  1174.   else
  1175.     FDPlay.Send(FLocalPlayer.ID, ToID, DPSEND_GUARANTEED, Data^, DataSize);
  1176. end;
  1177.  
  1178. function TCustomDXPlay.SendMessageEx(ToID: TDPID; Data: Pointer; DataSize: Integer;
  1179.   dwFlags: DWORD): DWORD;
  1180. begin
  1181.   if not Opened then Exit;
  1182.  
  1183.   if DataSize<SizeOf(TDPMSG_GENERIC) then
  1184.     raise EDXPlayError.Create(SDXPlayMessageIllegal);
  1185.  
  1186.   Result := 0;
  1187.   if ToID=FLocalPlayer.ID then
  1188.   begin
  1189.     {  Ž©•ªˆ¶‚̃ƒbƒZ[ƒW  }
  1190.     DoMessage(FLocalPlayer, Data, DataSize);
  1191.   end else
  1192.     FDPlay.SendEx(FLocalPlayer.ID, ToID, dwFlags, Data, DataSize,
  1193.       0, 0, nil, @Result); // 0 ˆÈŠO‚̓Tƒ|[ƒg‚µ‚È‚¢ƒfƒoƒCƒX‚ ‚é‚Ì‚ÅŽg‚í‚È‚¢
  1194. end;
  1195.  
  1196. procedure TCustomDXPlay.SetGUID(const Value: string);
  1197. begin
  1198.   if Value<>FGUID then
  1199.   begin
  1200.     if Value='' then
  1201.     begin
  1202.       FGUID := GUIDToString(GUID_NULL);
  1203.     end else
  1204.     begin
  1205.       FGUID := GUIDToString(DXPlayStringToGUID(Value));
  1206.     end;
  1207.   end;
  1208. end;
  1209.  
  1210. procedure TCustomDXPlay.SetModemSetting(Value: TDXPlayModemSetting);
  1211. begin
  1212.   FModemSetting.Assign(Value);
  1213. end;
  1214.  
  1215. procedure TCustomDXPlay.SetProviderName(const Value: string);
  1216. begin
  1217.   Close;
  1218.   FProviderName := Value;
  1219.   if FProviderName='' then Exit;
  1220.   try
  1221.     CreateDPlayWithoutDialog(FDPlay, Value);
  1222.   except
  1223.     FProviderName := '';
  1224.     raise;
  1225.   end;
  1226. end;
  1227.  
  1228. procedure TCustomDXPlay.SetTCPIPSetting(Value: TDXPlayTCPIPSetting);
  1229. begin
  1230.   FTCPIPSetting.Assign(Value);
  1231. end;
  1232.  
  1233. initialization
  1234.   CoInitialize(nil);
  1235. finalization
  1236.   CoUninitialize;
  1237. {$ENDIF} // UseDirectPlay
  1238.  
  1239. end.