Subversion Repositories spacemission

Rev

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

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