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

Rev	Author	Line No.	Line
1	daniel-mar	1	unit DXPlay;
		2
57	daniel-mar	3	{$INCLUDE DelphiXcfg.inc}
		4
		5	{$IFNDEF UseDirectPlay}
		6	// If you want to use DXPlay.pas, please enable the IFDEF UseDirectPlay in DelphiXcfg.inc
1	daniel-mar	7	interface
57	daniel-mar	8	implementation
		9	{$ELSE} // !UseDirectPlay
1	daniel-mar	10
57	daniel-mar	11	interface
1	daniel-mar	12
		13	uses
4	daniel-mar	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
1	daniel-mar	27	type
4	daniel-mar	28	{$IfDef DX9}
		29	TDPID = DWORD;
		30	{$EndIf}
1	daniel-mar	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
4	daniel-mar	111	FDPlay: //{$IfDef DX7}
		112	IDirectPlay4A;//{$Else}IDirectPlay8Address{$EndIf};
1	daniel-mar	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;
4	daniel-mar	140	procedure CreateDPlayWithoutDialog(out DPlay:
		141	//{$IfDef DX7}
		142	IDirectPlay4A;
		143	//{$Else}IDirectPlay8Address{$EndIf};
		144	const ProviderName: string);
1	daniel-mar	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;
4	daniel-mar	219	function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
		220	//{$IfDef DX7}
		221	IDirectPlay;
		222	//{$Else}IDirectPlay8Server{$EndIf};
1	daniel-mar	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
4	daniel-mar	255	function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
		256	//{$IfDef DX7}
		257	IDirectPlay;
		258	//{$Else}IDirectPlay8Server{$EndIf};
1	daniel-mar	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;
4	daniel-mar	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;
1	daniel-mar	274
4	daniel-mar	275	function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyW;
		276	lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT;
1	daniel-mar	277	type
4	daniel-mar	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
1	daniel-mar	287	TDirectPlayEnumerateA= function(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT; stdcall;
		288	begin
		289	Result := TDirectPlayEnumerateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayEnumerateA'))
		290	(lpEnumDPCallback, lpContext);
		291	end;
		292
4	daniel-mar	293	function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
1	daniel-mar	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;
4	daniel-mar	302	{$ENDIF}
1	daniel-mar	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
4	daniel-mar	368	{$IFDEF UNICODE}
		369	Lobby1: IDirectPlayLobbyW;
		370	Lobby: IDirectPlayLobby2W;
		371	DPlay: IDirectPlay4W;
		372	{$ELSE}
1	daniel-mar	373	Lobby1: IDirectPlayLobbyA;
		374	Lobby: IDirectPlayLobby2A;
4	daniel-mar	375	DPlay: IDirectPlay4A;
		376	{$ENDIF}
1	daniel-mar	377	DPlay1: IDirectPlay;
		378	lpAddress: Pointer;
		379	dwAddressSize: DWORD;
		380	begin
		381	if FModemNames=nil then
		382	begin
		383	FModemNames := TStringList.Create;
		384	try
4	daniel-mar	385	if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
1	daniel-mar	386	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
4	daniel-mar	387	Lobby := Lobby1 as {$IFDEF UNICODE}IDirectPlayLobby2W{$ELSE}IDirectPlayLobby2A{$ENDIF};
1	daniel-mar	388
		389	if DXDirectPlayCreate(DPSPGUID_MODEM, DPlay1, nil)<>0 then
		390	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
4	daniel-mar	391	DPlay := DPlay1 as {$IFDEF UNICODE}IDirectPlay4W{$ELSE}IDirectPlay4A{$ENDIF};
1	daniel-mar	392
		393	{ get size of player address for all players }
4	daniel-mar	394	if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
1	daniel-mar	395	raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
		396
		397	GetMem(lpAddress, dwAddressSize);
		398	try
		399	FillChar(lpAddress^, dwAddressSize, 0);
		400
		401	{ get the address }
4	daniel-mar	402	if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, lpAddress, dwAddressSize)<>0 then
1	daniel-mar	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
4	daniel-mar	528	hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);
1	daniel-mar	529
		530	if hr=DPERR_BUFFERTOOSMALL then
		531	begin
		532	ReAllocMem(lpvMsgBuffer, dwMsgBufferSize);
4	daniel-mar	533	hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);
1	daniel-mar	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
4	daniel-mar	555	{$IFDEF UNICODE}
		556	if lpszShortNameW<>nil then
		557	Player.FName := lpszShortNameW;
		558	{$ELSE}
1	daniel-mar	559	if lpszShortNameA<>nil then
		560	Player.FName := lpszShortNameA;
4	daniel-mar	561	{$ENDIF}
1	daniel-mar	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
4	daniel-mar	576	begin
1	daniel-mar	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
4	daniel-mar	667	function EnumProviderCallback(const lpguidSP: TGUID; lpSPName: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPSTR{$ENDIF};
1	daniel-mar	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
4	daniel-mar	684	DXDirectPlayEnumerate(@EnumProviderCallback, FProviders);
1	daniel-mar	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));
4	daniel-mar	709	{$IFDEF UNICODE}
		710	TStrings(lpContext).AddObject(lpThisSD.lpszSessionNameW, TObject(Guid));
		711	{$ELSE}
1	daniel-mar	712	TStrings(lpContext).AddObject(lpThisSD.lpszSessionNameA, TObject(Guid));
4	daniel-mar	713	{$ENDIF}
1	daniel-mar	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;
4	daniel-mar	764	{$IFDEF UNICODE}
		765	Lobby1: IDirectPlayLobbyW;
		766	Lobby: IDirectPlayLobby2W;
		767	{$ELSE}
1	daniel-mar	768	Lobby1: IDirectPlayLobbyA;
		769	Lobby: IDirectPlayLobby2A;
4	daniel-mar	770	{$ENDIF}
1	daniel-mar	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 }
4	daniel-mar	780	if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
1	daniel-mar	781	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
4	daniel-mar	782	Lobby := Lobby1 as {$IFDEF UNICODE}IDirectPlayLobby2W{$ELSE}IDirectPlayLobby2A{$ENDIF};
1	daniel-mar	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
4	daniel-mar	823	begin
1	daniel-mar	824	addressElements[dwElementCount].guidDataType := DPAID_INetPort;
		825	addressElements[dwElementCount].dwDataSize := SizeOf(TCPIPSetting.FPort);
		826	addressElements[dwElementCount].lpData := @TCPIPSetting.FPort;
4	daniel-mar	827	Inc(dwElementCount);
1	daniel-mar	828	end;
		829	end;
		830
4	daniel-mar	831	if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
1	daniel-mar	832	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
		833
		834	GetMem(lpAddress, dwAddressSize);
		835	try
		836	FillChar(lpAddress^, dwAddressSize, 0);
		837
4	daniel-mar	838	if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, lpAddress, dwAddressSize)<>0 then
1	daniel-mar	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;
4	daniel-mar	899	var
1	daniel-mar	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
4	daniel-mar	908	{$IFDEF UNICODE}
		909	if lpszShortNameW<>nil then
		910	Player.FName := lpszShortNameW;
		911	{$ELSE}
1	daniel-mar	912	if lpszShortNameA<>nil then
		913	Player.FName := lpszShortNameA;
4	daniel-mar	914	{$ENDIF}
1	daniel-mar	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
4	daniel-mar	938	if FDPlay.CreatePlayer(FLocalPlayer.FID, @Name, FRecvEvent[0], nil, 0, 0)<>DP_OK then
1	daniel-mar	939	raise EDXPlayError.CreateFmt(SCannotOpened, [FSessionName]);
		940
		941	{ Player enumeration }
4	daniel-mar	942	FDPlay.EnumPlayers(PGUID(nil), @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
1	daniel-mar	943
		944	FIsHost := FPlayers.Count=1;
		945
		946	FCalledDoOpen := True; DoOpen;
		947	DoAddPlayer(FLocalPlayer);
		948
		949	{ Thread start }
		950	FRecvThread := TDXPlayRecvThread.Create(Self);
16	daniel-mar	951	FRecvThread.{$IFDEF VER14UP}Start{$ELSE}Resume{$ENDIF};
1	daniel-mar	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;
4	daniel-mar	976	{$IFDEF UNICODE}
		977	Lobby: IDirectPlayLobbyW;
		978	{$ELSE}
1	daniel-mar	979	Lobby: IDirectPlayLobbyA;
4	daniel-mar	980	{$ENDIF}
1	daniel-mar	981	dwSize: DWORD;
		982	ConnectionSettings: PDPLConnection;
		983	begin
		984	Result := False;
		985
4	daniel-mar	986	if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby, nil, nil, 0)<>0 then
1	daniel-mar	987	Exit;
		988
4	daniel-mar	989	if Lobby.GetConnectionSettings(0, PDPLConnection(nil), dwSize)<>DPERR_BUFFERTOOSMALL then
1	daniel-mar	990	Exit;
		991
		992	GetMem(ConnectionSettings, dwSize);
		993	try
4	daniel-mar	994	if Lobby.GetConnectionSettings(0, ConnectionSettings, dwSize)<>0 then
1	daniel-mar	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
4	daniel-mar	1013	{$IFDEF UNICODE}
		1014	if lpszSessionNameW<>nil then
		1015	FSessionName := lpszSessionNameW;
		1016	{$ELSE}
1	daniel-mar	1017	if lpszSessionNameA<>nil then
		1018	FSessionName := lpszSessionNameA;
4	daniel-mar	1019	{$ENDIF}
1	daniel-mar	1020	end;
		1021
		1022	with ConnectionSettings.lpPlayerName^ do
		1023	begin
4	daniel-mar	1024	{$IFDEF UNICODE}
		1025	if lpszShortNameW<>nil then
		1026	Name := lpszShortNameW;
		1027	{$ELSE}
1	daniel-mar	1028	if lpszShortNameA<>nil then
		1029	Name := lpszShortNameA;
4	daniel-mar	1030	{$ENDIF}
1	daniel-mar	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;
4	daniel-mar	1085	{$IFDEF UNICODE}
		1086	dpDesc.lpszSessionNameW := {$IFDEF VER12UP}PChar{$ELSE}PWideChar{$ENDIF}(SessionName);
		1087	{$ELSE}
		1088	dpDesc.lpszSessionNameA := PAnsiChar(SessionName);
		1089	{$ENDIF}
1	daniel-mar	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;
4	daniel-mar	1141
1	daniel-mar	1142	ClearSessionList;
		1143
		1144	FDPlay := nil;
		1145	ChangeDPlay;
		1146
		1147	if FInThread then
		1148	SetEvent(FRecvEvent[1])
		1149	else
		1150	FRecvThread.Free;
4	daniel-mar	1151
1	daniel-mar	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
4	daniel-mar	1173	FDPlay.SendEx(FLocalPlayer.ID, ToID, DPSEND_GUARANTEED or DPSEND_ASYNC, Data, DataSize, 0, 0, nil, nil)
1	daniel-mar	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
4	daniel-mar	1192	FDPlay.SendEx(FLocalPlayer.ID, ToID, dwFlags, Data, DataSize,
1	daniel-mar	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;
57	daniel-mar	1237	{$ENDIF} // UseDirectPlay
		1238
4	daniel-mar	1239	end.

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/DXPlay.pas @ 4 – Rev 57