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

Rev	Author	Line No.	Line
1	daniel-mar	1	unit DXPlay;
		2
		3	interface
		4
		5	{$INCLUDE DelphiXcfg.inc}
		6
		7	uses
4	daniel-mar	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
1	daniel-mar	21	type
4	daniel-mar	22	{$IfDef DX9}
		23	TDPID = DWORD;
		24	{$EndIf}
1	daniel-mar	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
4	daniel-mar	105	FDPlay: //{$IfDef DX7}
		106	IDirectPlay4A;//{$Else}IDirectPlay8Address{$EndIf};
1	daniel-mar	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;
4	daniel-mar	134	procedure CreateDPlayWithoutDialog(out DPlay:
		135	//{$IfDef DX7}
		136	IDirectPlay4A;
		137	//{$Else}IDirectPlay8Address{$EndIf};
		138	const ProviderName: string);
1	daniel-mar	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;
4	daniel-mar	213	function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
		214	//{$IfDef DX7}
		215	IDirectPlay;
		216	//{$Else}IDirectPlay8Server{$EndIf};
1	daniel-mar	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
4	daniel-mar	249	function DXDirectPlayCreate(const lpGUID: TGUID; out lplpDP:
		250	//{$IfDef DX7}
		251	IDirectPlay;
		252	//{$Else}IDirectPlay8Server{$EndIf};
1	daniel-mar	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;
4	daniel-mar	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;
1	daniel-mar	268
4	daniel-mar	269	function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyW;
		270	lpUnk: IUnknown; lpData: Pointer; dwDataSize: DWORD): HRESULT;
1	daniel-mar	271	type
4	daniel-mar	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
1	daniel-mar	281	TDirectPlayEnumerateA= function(lpEnumDPCallback: TDPEnumDPCallbackA; lpContext: Pointer): HRESULT; stdcall;
		282	begin
		283	Result := TDirectPlayEnumerateA(DXLoadLibrary('DPlayX.dll', 'DirectPlayEnumerateA'))
		284	(lpEnumDPCallback, lpContext);
		285	end;
		286
4	daniel-mar	287	function DXDirectPlayLobbyCreate(const lpguidSP: TGUID; out lplpDPL: IDirectPlayLobbyA;
1	daniel-mar	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;
4	daniel-mar	296	{$ENDIF}
1	daniel-mar	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
4	daniel-mar	362	{$IFDEF UNICODE}
		363	Lobby1: IDirectPlayLobbyW;
		364	Lobby: IDirectPlayLobby2W;
		365	DPlay: IDirectPlay4W;
		366	{$ELSE}
1	daniel-mar	367	Lobby1: IDirectPlayLobbyA;
		368	Lobby: IDirectPlayLobby2A;
4	daniel-mar	369	DPlay: IDirectPlay4A;
		370	{$ENDIF}
1	daniel-mar	371	DPlay1: IDirectPlay;
		372	lpAddress: Pointer;
		373	dwAddressSize: DWORD;
		374	begin
		375	if FModemNames=nil then
		376	begin
		377	FModemNames := TStringList.Create;
		378	try
4	daniel-mar	379	if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
1	daniel-mar	380	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
4	daniel-mar	381	Lobby := Lobby1 as {$IFDEF UNICODE}IDirectPlayLobby2W{$ELSE}IDirectPlayLobby2A{$ENDIF};
1	daniel-mar	382
		383	if DXDirectPlayCreate(DPSPGUID_MODEM, DPlay1, nil)<>0 then
		384	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
4	daniel-mar	385	DPlay := DPlay1 as {$IFDEF UNICODE}IDirectPlay4W{$ELSE}IDirectPlay4A{$ENDIF};
1	daniel-mar	386
		387	{ get size of player address for all players }
4	daniel-mar	388	if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
1	daniel-mar	389	raise EDXPlayError.Create(SDXPlayModemListCannotBeAcquired);
		390
		391	GetMem(lpAddress, dwAddressSize);
		392	try
		393	FillChar(lpAddress^, dwAddressSize, 0);
		394
		395	{ get the address }
4	daniel-mar	396	if DPlay.GetPlayerAddress(DPID_ALLPLAYERS, lpAddress, dwAddressSize)<>0 then
1	daniel-mar	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
4	daniel-mar	522	hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);
1	daniel-mar	523
		524	if hr=DPERR_BUFFERTOOSMALL then
		525	begin
		526	ReAllocMem(lpvMsgBuffer, dwMsgBufferSize);
4	daniel-mar	527	hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);
1	daniel-mar	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
4	daniel-mar	549	{$IFDEF UNICODE}
		550	if lpszShortNameW<>nil then
		551	Player.FName := lpszShortNameW;
		552	{$ELSE}
1	daniel-mar	553	if lpszShortNameA<>nil then
		554	Player.FName := lpszShortNameA;
4	daniel-mar	555	{$ENDIF}
1	daniel-mar	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
4	daniel-mar	570	begin
1	daniel-mar	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
4	daniel-mar	661	function EnumProviderCallback(const lpguidSP: TGUID; lpSPName: {$IFDEF UNICODE}LPCTSTR{$ELSE}LPSTR{$ENDIF};
1	daniel-mar	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
4	daniel-mar	678	DXDirectPlayEnumerate(@EnumProviderCallback, FProviders);
1	daniel-mar	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));
4	daniel-mar	703	{$IFDEF UNICODE}
		704	TStrings(lpContext).AddObject(lpThisSD.lpszSessionNameW, TObject(Guid));
		705	{$ELSE}
1	daniel-mar	706	TStrings(lpContext).AddObject(lpThisSD.lpszSessionNameA, TObject(Guid));
4	daniel-mar	707	{$ENDIF}
1	daniel-mar	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;
4	daniel-mar	758	{$IFDEF UNICODE}
		759	Lobby1: IDirectPlayLobbyW;
		760	Lobby: IDirectPlayLobby2W;
		761	{$ELSE}
1	daniel-mar	762	Lobby1: IDirectPlayLobbyA;
		763	Lobby: IDirectPlayLobby2A;
4	daniel-mar	764	{$ENDIF}
1	daniel-mar	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 }
4	daniel-mar	774	if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
1	daniel-mar	775	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
4	daniel-mar	776	Lobby := Lobby1 as {$IFDEF UNICODE}IDirectPlayLobby2W{$ELSE}IDirectPlayLobby2A{$ENDIF};
1	daniel-mar	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
4	daniel-mar	817	begin
1	daniel-mar	818	addressElements[dwElementCount].guidDataType := DPAID_INetPort;
		819	addressElements[dwElementCount].dwDataSize := SizeOf(TCPIPSetting.FPort);
		820	addressElements[dwElementCount].lpData := @TCPIPSetting.FPort;
4	daniel-mar	821	Inc(dwElementCount);
1	daniel-mar	822	end;
		823	end;
		824
4	daniel-mar	825	if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
1	daniel-mar	826	raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
		827
		828	GetMem(lpAddress, dwAddressSize);
		829	try
		830	FillChar(lpAddress^, dwAddressSize, 0);
		831
4	daniel-mar	832	if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, lpAddress, dwAddressSize)<>0 then
1	daniel-mar	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;
4	daniel-mar	893	var
1	daniel-mar	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
4	daniel-mar	902	{$IFDEF UNICODE}
		903	if lpszShortNameW<>nil then
		904	Player.FName := lpszShortNameW;
		905	{$ELSE}
1	daniel-mar	906	if lpszShortNameA<>nil then
		907	Player.FName := lpszShortNameA;
4	daniel-mar	908	{$ENDIF}
1	daniel-mar	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
4	daniel-mar	932	if FDPlay.CreatePlayer(FLocalPlayer.FID, @Name, FRecvEvent[0], nil, 0, 0)<>DP_OK then
1	daniel-mar	933	raise EDXPlayError.CreateFmt(SCannotOpened, [FSessionName]);
		934
		935	{ Player enumeration }
4	daniel-mar	936	FDPlay.EnumPlayers(PGUID(nil), @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);
1	daniel-mar	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;
4	daniel-mar	970	{$IFDEF UNICODE}
		971	Lobby: IDirectPlayLobbyW;
		972	{$ELSE}
1	daniel-mar	973	Lobby: IDirectPlayLobbyA;
4	daniel-mar	974	{$ENDIF}
1	daniel-mar	975	dwSize: DWORD;
		976	ConnectionSettings: PDPLConnection;
		977	begin
		978	Result := False;
		979
4	daniel-mar	980	if DXDirectPlayLobbyCreate(PGUID(nil)^, Lobby, nil, nil, 0)<>0 then
1	daniel-mar	981	Exit;
		982
4	daniel-mar	983	if Lobby.GetConnectionSettings(0, PDPLConnection(nil), dwSize)<>DPERR_BUFFERTOOSMALL then
1	daniel-mar	984	Exit;
		985
		986	GetMem(ConnectionSettings, dwSize);
		987	try
4	daniel-mar	988	if Lobby.GetConnectionSettings(0, ConnectionSettings, dwSize)<>0 then
1	daniel-mar	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
4	daniel-mar	1007	{$IFDEF UNICODE}
		1008	if lpszSessionNameW<>nil then
		1009	FSessionName := lpszSessionNameW;
		1010	{$ELSE}
1	daniel-mar	1011	if lpszSessionNameA<>nil then
		1012	FSessionName := lpszSessionNameA;
4	daniel-mar	1013	{$ENDIF}
1	daniel-mar	1014	end;
		1015
		1016	with ConnectionSettings.lpPlayerName^ do
		1017	begin
4	daniel-mar	1018	{$IFDEF UNICODE}
		1019	if lpszShortNameW<>nil then
		1020	Name := lpszShortNameW;
		1021	{$ELSE}
1	daniel-mar	1022	if lpszShortNameA<>nil then
		1023	Name := lpszShortNameA;
4	daniel-mar	1024	{$ENDIF}
1	daniel-mar	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;
4	daniel-mar	1079	{$IFDEF UNICODE}
		1080	dpDesc.lpszSessionNameW := {$IFDEF VER12UP}PChar{$ELSE}PWideChar{$ENDIF}(SessionName);
		1081	{$ELSE}
		1082	dpDesc.lpszSessionNameA := PAnsiChar(SessionName);
		1083	{$ENDIF}
1	daniel-mar	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;
4	daniel-mar	1135
1	daniel-mar	1136	ClearSessionList;
		1137
		1138	FDPlay := nil;
		1139	ChangeDPlay;
		1140
		1141	if FInThread then
		1142	SetEvent(FRecvEvent[1])
		1143	else
		1144	FRecvThread.Free;
4	daniel-mar	1145
1	daniel-mar	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
4	daniel-mar	1167	FDPlay.SendEx(FLocalPlayer.ID, ToID, DPSEND_GUARANTEED or DPSEND_ASYNC, Data, DataSize, 0, 0, nil, nil)
1	daniel-mar	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
4	daniel-mar	1186	FDPlay.SendEx(FLocalPlayer.ID, ToID, dwFlags, Data, DataSize,
1	daniel-mar	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;
4	daniel-mar	1231	end.

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/DXPlay.pas – Rev 4