dxplay.pas

传奇源代码的delphi版本

  end;

  if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, nil, dwAddressSize)<>DPERR_BUFFERTOOSMALL then
    raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);

  GetMem(lpAddress, dwAddressSize);
  try
    FillChar(lpAddress^, dwAddressSize, 0);

    if Lobby.CreateCompoundAddress(addressElements[0], dwElementCount, lpAddress, dwAddressSize)<>0 then
      raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);

    {  DirectPlay initialization  }
    if CoCreateInstance(CLSID_DirectPlay, nil, CLSCTX_INPROC_SERVER, IID_IDirectPlay4A, DPlay)<>0 then
      raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
    try
      {  DirectPlay address initialization  }
      if DPlay.InitializeConnection(lpAddress, 0)<>0 then
        raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
    except
      DPlay := nil;
      raise;
    end;
  finally
    FreeMem(lpAddress);
  end;
end;

procedure TCustomDXPlay.ClearSessionList;
var
  i: Integer;
begin
  FReadSessioned := False;
  for i:=0 to FSessions.Count-1 do
    Dispose(PGUID(FSessions.Objects[i]));
  FSessions.Clear;
end;

procedure TCustomDXPlay.Open;
var
  PlayerName: string;
begin
  Close;
  try
    if not OpenDPlayWithLobby(PlayerName) then
    begin
      if not OpenDPlayWithoutLobby(PlayerName) then
        Abort;
    end;

    Open_(PlayerName);
  except
    Close;
    raise;
  end;
end;

procedure TCustomDXPlay.Open2(NewSession: Boolean; const SessionName, PlayerName: string);
begin
  if not OpenDPlayWithoutLobby2(NewSession, ProviderName, SessionName, PlayerName) then
    Abort;

  Open_(PlayerName);
end;

procedure TCustomDXPlay.Open_(NameS: string);

  function EnumPlayersCallback2(TDPID: TDPID; dwPlayerType: DWORD;
    const lpName: TDPName; dwFlags: DWORD; lpContext: Pointer): BOOL;
    stdcall;
  var
    Player: TDXPlayPlayer;
  begin
    Player := TDXPlayPlayer.Create(TCustomDXPlay(lpContext).Players);
    Player.FID := TDPID;
    Player.FRemotePlayer := True;

    with lpName do
    begin
      if lpszShortNameA<>nil then
        Player.FName := lpszShortNameA;
    end;

    Result := True;
  end;

var
  Name2: array[0..1023] of Char;
  Name: TDPName;
begin
  if FOpened then Close;
  FOpened := True;
  try
    {  Player making  }
    StrLCopy(@Name2, PChar(NameS), SizeOf(Name2));

    Name.lpszShortNameA := @Name2;
    Name.lpszLongNameA := nil;

    FRecvEvent[0] := CreateEvent(nil, False, False, nil);

    FLocalPlayer := TDXPlayPlayer.Create(FPlayers);
    FLocalPlayer.FName := NameS;

    if FDPlay.CreatePlayer(FLocalPlayer.FID, @Name, FRecvEvent[0], nil, 0, 0)<>DP_OK then
      raise EDXPlayError.CreateFmt(SCannotOpened, [FSessionName]);

    {  Player enumeration  }
    FDPlay.EnumPlayers(PGUID(nil), @EnumPlayersCallback2, Self, DPENUMPLAYERS_REMOTE);

    FIsHost := FPlayers.Count=1;

    FCalledDoOpen := True; DoOpen;
    DoAddPlayer(FLocalPlayer);

    {  Thread start  }
    FRecvThread := TDXPlayRecvThread.Create(Self);
    FRecvThread.Resume;
  except
    Close;
    raise;
  end;
end;

procedure TCustomDXPlay.ChangeDPlay;
var
  caps: TDPCAPS;
begin
  FAsyncSupported := False;
  if FDPlay<>nil then
  begin
    FillChar(caps, SizeOf(caps), 0);
    caps.dwSize := SizeOf(caps);
    FDPlay.GetCaps(caps, 0);

    FAsyncSupported := caps.dwFlags and DPCAPS_ASYNCSUPPORTED<>0;
  end;
end;

function TCustomDXPlay.OpenDPlayWithLobby(out Name: string): Boolean;
var
  DPlay1: IDirectPlay2;
  Lobby: IDirectPlayLobbyA;
  dwSize: DWORD;
  ConnectionSettings: PDPLConnection;
begin
  Result := False;

  if DXDirectPlayLobbyCreateA(PGUID(nil)^, Lobby, nil, nil, 0)<>0 then
    Exit;

  if Lobby.GetConnectionSettings(0, PDPLConnection(nil), dwSize)<>DPERR_BUFFERTOOSMALL then
    Exit;

  GetMem(ConnectionSettings, dwSize);
  try
    if Lobby.GetConnectionSettings(0, ConnectionSettings, dwSize)<>0 then
      Exit;

    with ConnectionSettings^.lpSessionDesc^ do
    begin
      dwFlags := DPSESSION_MIGRATEHOST or DPSESSION_KEEPALIVE or DPSESSION_DIRECTPLAYPROTOCOL;
      dwMaxPlayers := FMaxPlayers;
    end;

    if Lobby.SetConnectionSettings(0, 0, ConnectionSettings^)<>0 then
      Exit;

    if Lobby.Connect(0, DPlay1, nil)<>0 then
      Exit;
    FDPlay := DPlay1 as IDirectPlay4A;
    ChangeDPlay;

    with ConnectionSettings.lpSessionDesc^ do
    begin
      if lpszSessionNameA<>nil then
        FSessionName := lpszSessionNameA;
    end;

    with ConnectionSettings.lpPlayerName^ do
    begin
      if lpszShortNameA<>nil then
        Name := lpszShortNameA;
    end;
  finally
    FreeMem(ConnectionSettings);
  end;

  Result := True;
end;

function TCustomDXPlay.OpenDPlayWithoutLobby(out Name: string): Boolean;
var
  Form: TDelphiXDXPlayForm;
begin
  Form := TDelphiXDXPlayForm.Create(Application);
  try
    Form.DXPlay := Self;
    Form.ShowModal;

    Result := Form.Tag<>0;

    FDPlay := Form.DPlay;
    ChangeDPlay;

    Name := Form.PlayerName;
    FProviderName := Form.ProviderName;
    FSessionName := Form.SessionName;
  finally
    Form.Free;
  end;
end;

function TCustomDXPlay.OpenDPlayWithoutLobby2(const NewSession: Boolean;
  const ProviderName, SessionName, PlayerName: string): Boolean;
var
  dpDesc: TDPSessionDesc2;
  i: Integer;
  hr: HRESULT;
begin
  Result := False;

  if FDPlay=nil then
    raise EDXPlayError.Create(SDXPlayNotConnectedNow);

  if SessionName='' then
    raise EDXPlayError.Create(SDXPlaySessionNameIsNotSpecified);

  if PlayerName='' then
    raise EDXPlayError.Create(SDXPlayPlayerNameIsNotSpecified);

  if NewSession then
  begin
    {  Session connection  }
    FillChar(dpDesc, SizeOf(dpDesc), 0);
    dpDesc.dwSize := SizeOf(dpDesc);
    dpDesc.dwFlags := DPSESSION_MIGRATEHOST or DPSESSION_KEEPALIVE;
    dpDesc.lpszSessionNameA := PChar(SessionName);
    dpDesc.guidApplication := DXPlayStringToGUID(GUID);
    dpDesc.dwMaxPlayers := MaxPlayers;

    hr := FDPlay.Open(dpDesc, DPOPEN_CREATE);
    if hr=DPERR_USERCANCEL then Exit;
    if hr<>0 then
      raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [FSessionName]);
  end else
  begin
    {  Session connection  }
    {  Enum session  }
    i := Sessions.IndexOf(SessionName);
    if i=-1 then raise EDXPlayError.CreateFmt(SDXPlaySessionNotFound, [SessionName]);

    FillChar(dpDesc, SizeOf(dpDesc), 0);
    dpDesc.dwSize := SizeOf(dpDesc);
    dpDesc.guidInstance := PGUID(Sessions.Objects[i])^;
    dpDesc.guidApplication := DXPlayStringToGUID(GUID);

    hr := FDPlay.Open(dpDesc, DPOPEN_JOIN);
    if hr=DPERR_USERCANCEL then Exit;
    if hr<>0 then
      raise EDXPlayError.CreateFmt(SDXPlaySessionCannotOpened, [FSessionName]);
  end;

  Result := True;

  FSessionName := SessionName;
end;

procedure TCustomDXPlay.Close;
begin
  FOpened := False;
  FReadSessioned := False;

  try
    if FCalledDoOpen then
    begin
      FCalledDoOpen := False;
      DoClose;
    end;
  finally
    if FDPlay<>nil then
    begin
      if FLocalPlayer<>nil then FDPlay.DestroyPlayer(FLocalPlayer.FID);
      FDPlay.Close;
    end;

    FProviderName := '';
    FSessionName := '';
    FAsyncSupported := False;

    ClearSessionList;

    FDPlay := nil;
    ChangeDPlay;

    if FInThread then
      SetEvent(FRecvEvent[1])
    else
      FRecvThread.Free;

    CloseHandle(FRecvEvent[0]); FRecvEvent[0] := 0;

    FPlayers.Clear;

    FLocalPlayer := nil;
  end;
end;

procedure TCustomDXPlay.SendMessage(ToID: TDPID; Data: Pointer; DataSize: Integer);
begin
  if not Opened then Exit;

  if DataSize<SizeOf(TDPMSG_GENERIC) then
    raise EDXPlayError.Create(SDXPlayMessageIllegal);

  if ToID=FLocalPlayer.ID then
  begin
    {  Message to me  }
    DoMessage(FLocalPlayer, Data, DataSize);
  end else
  if FAsync and FAsyncSupported then
    FDPlay.SendEx(FLocalPlayer.ID, ToID, DPSEND_GUARANTEED or DPSEND_ASYNC, Data, DataSize, 0, 0, nil, nil)
  else
    FDPlay.Send(FLocalPlayer.ID, ToID, DPSEND_GUARANTEED, Data^, DataSize);
end;

function TCustomDXPlay.SendMessageEx(ToID: TDPID; Data: Pointer; DataSize: Integer;
  dwFlags: DWORD): DWORD;
begin
  if not Opened then Exit;

  if DataSize<SizeOf(TDPMSG_GENERIC) then
    raise EDXPlayError.Create(SDXPlayMessageIllegal);

  Result := 0;
  if ToID=FLocalPlayer.ID then
  begin
    {  帺暘埗偺儊僢僙乕僕  }
    DoMessage(FLocalPlayer, Data, DataSize);
  end else
    FDPlay.SendEx(FLocalPlayer.ID, ToID, dwFlags, Data, DataSize,
      0, 0, nil, @Result); // 0 埲奜偼僒億乕僩偟側偄僨僶僀僗偁傞偺偱巊傢側偄
end;

procedure TCustomDXPlay.SetGUID(const Value: string);
begin
  if Value<>FGUID then
  begin
    if Value='' then
    begin
      FGUID := GUIDToString(GUID_NULL);
    end else
    begin
      FGUID := GUIDToString(DXPlayStringToGUID(Value));
    end;
  end;
end;

procedure TCustomDXPlay.SetModemSetting(Value: TDXPlayModemSetting);
begin
  FModemSetting.Assign(Value);
end;

procedure TCustomDXPlay.SetProviderName(const Value: string);
begin
  Close;
  FProviderName := Value;
  if FProviderName='' then Exit;
  try
    CreateDPlayWithoutDialog(FDPlay, Value);
  except
    FProviderName := '';
    raise;
  end;
end;

procedure TCustomDXPlay.SetTCPIPSetting(Value: TDXPlayTCPIPSetting);
begin
  FTCPIPSetting.Assign(Value);
end;

initialization
  CoInitialize(nil);
finalization
  CoUninitialize;
end.