dxplay.pas

传奇源代码的delphi版本

    inherited Assign(Source);
end;

{  TCustomDXPlay  }

constructor TCustomDXPlay.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPlayers := TDXPlayPlayers.Create;
  FModemSetting := TDXPlayModemSetting.Create;
  FTCPIPSetting := TDXPlayTCPIPSetting.Create;
  FSessions := TStringList.Create;

  FGUID := GUIDToString(GUID_NULL);
  FMaxPlayers := 0;
end;

destructor TCustomDXPlay.Destroy;
var
  i: Integer;
begin
  Close;

  FPlayers.Free;

  if FProviders<>nil then
  begin
    for i:=0 to FProviders.Count-1 do
      Dispose(PGUID(FProviders.Objects[i]));
  end;
  FProviders.Free;
  FModemSetting.Free;
  FTCPIPSetting.Free;
  ClearSessionList;
  FSessions.Free;
  inherited Destroy;
end;

type
  TDXPlayRecvThread = class(TThread)
  private
    FDXPlay: TCustomDXPlay;
    constructor Create(DXPlay: TCustomDXPlay);
    destructor Destroy; override;
    procedure Execute; override;
  end;

constructor TDXPlayRecvThread.Create(DXPlay: TCustomDXPlay);
begin
  FDXPlay := DXPlay;

  FDXPlay.FRecvEvent[1] := CreateEvent(nil, False, False, nil);

  FreeOnTerminate := True;
  inherited Create(True);
end;

destructor TDXPlayRecvThread.Destroy;
begin
  FreeOnTerminate := False;
  SetEvent(FDXPlay.FRecvEvent[1]);

  inherited Destroy;

  CloseHandle(FDXPlay.FRecvEvent[1]);

  FDXPlay.FRecvThread := nil;
  FDXPlay.Close;
end;

procedure TDXPlayRecvThread.Execute;
begin
  while WaitForMultipleObjects(2, @FDXPlay.FRecvEvent, False, INFINITE)=WAIT_OBJECT_0 do
  begin
    Synchronize(FDXPlay.ReceiveMessage);
  end;
end;

procedure TCustomDXPlay.ReceiveMessage;
var
  idFrom, idTo: DWORD;
  hr: HRESULT;
  lpvMsgBuffer: Pointer;
  dwMsgBufferSize: DWORD;
  Msg_CreatePlayerOrGroup: PDPMSG_CREATEPLAYERORGROUP;
  Msg_DeletePlayerOrGroup: PDPMSG_DESTROYPLAYERORGROUP;
  Msg_SendComplete: PDPMsg_SendComplete;
  SendCompleteResult: TDXPlaySendCompleteResult;
  Player: TDXPlayPlayer;
  i: Integer;
begin
  FInThread := True;
  try
    try
      lpvMsgBuffer := nil;
      dwMsgBufferSize := 0;

      try
        repeat
          hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);

          if hr=DPERR_BUFFERTOOSMALL then
          begin
            ReAllocMem(lpvMsgBuffer, dwMsgBufferSize);
            hr := FDPlay.Receive(idFrom, idTo, DPRECEIVE_ALL, lpvMsgBuffer, dwMsgBufferSize);
          end;

          if (hr=0) and (dwMsgBufferSize>=SizeOf(TDPMSG_GENERIC)) then
          begin
            if idFrom=DPID_SYSMSG then
            begin
              {  System message  }
              case PDPMSG_GENERIC(lpvMsgBuffer)^.dwType of
                DPSYS_CREATEPLAYERORGROUP:
                  begin
                    {  New player  }
                    Msg_CreatePlayerOrGroup := lpvMsgBuffer;

                    if Msg_CreatePlayerOrGroup.DPID<>FLocalPlayer.FID then
                    begin
                      Player := TDXPlayPlayer.Create(Players);
                      Player.FID := Msg_CreatePlayerOrGroup.DPID;
                      Player.FRemotePlayer := True;

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

                      DoAddPlayer(Player);
                    end;
                  end;
                DPSYS_DESTROYPLAYERORGROUP:
                  begin
                    {  Player deletion  }
                    Msg_DeletePlayerOrGroup := lpvMsgBuffer;

                    if Msg_DeletePlayerOrGroup.DPID<>FLocalPlayer.FID then
                    begin
                      i := Players.IndexOf(Msg_DeletePlayerOrGroup.DPID);
                      if i<>-1 then
                      begin
                        Player := Players[i];
                        DoDeletePlayer(Player);
                        Player.Free;
                      end;
                    end;
                  end;
                DPSYS_SESSIONLOST:
                  begin
                    {  The session was lost.  }
                    DoSessionLost;
                    Close;
                  end;
                DPSYS_HOST:
                  begin
                    {  Here became a host.  }
                    FIsHost := True;
                  end;
                DPSYS_SENDCOMPLETE:
                   begin
                     { Send complete  }
                     Msg_SendComplete := lpvMsgBuffer;
                     if Msg_SendComplete.idFrom=FLocalPlayer.FID then
                     begin
                       case Msg_SendComplete.hr of
                         DP_OK        : SendCompleteResult := crOk;
                         DPERR_ABORTED: SendCompleteResult := crAbort;
                         else           SendCompleteResult := crGeneric;
                       end;

                       DoSendComplete(Msg_SendComplete^.dwMsgID, SendCompleteResult, Msg_SendComplete^.dwSendTime);
                     end;
                   end;
              end;
            end else
            begin
              {  Application definition message  }
              DoMessage(Players.Find(idFrom), lpvMsgBuffer, dwMsgBufferSize);
            end;
          end;
        until hr<>0;
      finally
        FreeMem(lpvMsgBuffer);
      end;
    except
      on E: Exception do
        Application.HandleException(E);
    end;
  finally
    FInThread := False;
  end;
end;

procedure TCustomDXPlay.DoAddPlayer(Player: TDXPlayPlayer);
begin
  if Assigned(FOnAddPlayer) then FOnAddPlayer(Self, Player)
end;

procedure TCustomDXPlay.DoClose;
begin
  if Assigned(FOnClose) then FOnClose(Self);
end;

procedure TCustomDXPlay.DoDeletePlayer(Player: TDXPlayPlayer);
begin
  if Assigned(FOnDeletePlayer) then FOnDeletePlayer(Self, Player)
end;

procedure TCustomDXPlay.DoMessage(From: TDXPlayPlayer; Data: Pointer; DataSize: Integer);
begin
  if Assigned(FOnMessage) then FOnMessage(Self, From, Data, DataSize);
end;

procedure TCustomDXPlay.DoOpen;
begin
  if Assigned(FOnOpen) then FOnOpen(Self);
end;

procedure TCustomDXPlay.DoSessionLost;
begin
  if Assigned(FOnSessionLost) then FOnSessionLost(Self);
end;

procedure TCustomDXPlay.DoSendComplete(MessageID: DWORD; Result: TDXPlaySendCompleteResult;
  SendTime: Integer);
begin
  if Assigned(FOnSendComplete) then FOnSendComplete(Self, MessageID, Result, SendTime);
end;

function TCustomDXPlay.GetProviders: TStrings;

  function EnumProviderCallback(const lpguidSP: TGUID; lpSPName: LPSTR;
      dwMajorVersion: DWORD; dwMinorVersion: DWORD; lpContext: Pointer):
      BOOL; stdcall;
  var
    GUID: PGUID;
  begin
    GUID := New(PGUID);
    Move(lpguidSP, GUID^, SizeOf(TGUID));
    TStrings(lpContext).AddObject(lpSPName, TObject(GUID));
    Result := True;
  end;

begin
  if FProviders=nil then
  begin
    FProviders := TStringList.Create;
    try
      DXDirectPlayEnumerateA(@EnumProviderCallback, FProviders);
    except
      FProviders.Free; FProviders := nil;
      raise;
    end;
  end;

  Result := FProviders;
end;

procedure TCustomDXPlay.GetSessions;

  function EnumSessionsCallback(const lpThisSD: TDPSessionDesc2;
    var lpdwTimeOut: DWORD; dwFlags: DWORD; lpContext: Pointer): BOOL; stdcall;
  var
    Guid: PGUID;
  begin
    if dwFlags and DPESC_TIMEDOUT<>0 then
    begin
      Result := False;
      Exit;
    end;

    Guid := New(PGUID);
    Move(lpThisSD.guidInstance, Guid^, SizeOf(TGUID));
    TStrings(lpContext).AddObject(lpThisSD.lpszSessionNameA, TObject(Guid));

    Result := True;
  end;

var
  dpDesc: TDPSessionDesc2;
  hr: HRESULT;
begin
  if FDPlay=nil then
    raise EDXPlayError.Create(SDXPlayNotConnectedNow);

  ClearSessionList;

  FillChar(dpDesc, SizeOf(dpDesc), 0);
  dpDesc.dwSize := SizeOf(dpDesc);
  dpDesc.guidApplication := DXPlayStringToGUID(FGUID);

  hr := FDPlay.EnumSessions(dpDesc, 0, @EnumSessionsCallback, FSessions, DPENUMSESSIONS_AVAILABLE);
  if hr=DPERR_USERCANCEL then Abort;
  if hr<>0 then
    raise EDXPlayError.Create(SDXPlaySessionListCannotBeAcquired);

  FReadSessioned := True;
end;

function TCustomDXPlay.GetSessionsPty: TStrings;
begin
  if not FReadSessioned then GetSessions;
  Result := FSessions;
end;

function TCustomDXPlay.GetProviderNameFromGUID(const ProviderGUID: TGUID): string;
var
  i: Integer;
begin
  for i:=0 to Providers.Count-1 do
    if CompareMem(PGUID(Providers.Objects[i]), @ProviderGUID, SizeOf(TGUID)) then
    begin
      Result := Providers[i];
      Exit;
    end;

  raise EDXPlayError.Create(SDXPlayProviderSpecifiedGUIDNotFound);
end;

procedure TCustomDXPlay.CreateDPlayWithoutDialog(out DPlay: IDirectPlay4A; const ProviderName: string);
var
  i: Integer;
  ProviderGUID: TGUID;
  addressElements: array[0..15] of TDPCompoundAddressElement;
  dwElementCount: Integer;
  Lobby1: IDirectPlayLobbyA;
  Lobby: IDirectPlayLobby2A;
  lpAddress: Pointer;
  dwAddressSize: DWORD;
begin
  i := Providers.IndexOf(ProviderName);
  if i=-1 then
    raise EDXPlayError.CreateFmt(SDXPlayProviderNotFound, [ProviderName]);
  ProviderGUID := PGUID(Providers.Objects[i])^;

  {  DirectPlay address making  }
  if DXDirectPlayLobbyCreateA(PGUID(nil)^, Lobby1, nil, nil, 0)<>0 then
    raise EDXPlayError.CreateFmt(SCannotInitialized, [SDirectPlay]);
  Lobby := Lobby1 as IDirectPlayLobby2A;

  FillChar(addressElements, SizeOf(addressElements), 0);
  dwElementCount := 0;

  addressElements[dwElementCount].guidDataType := DPAID_ServiceProvider;
  addressElements[dwElementCount].dwDataSize := SizeOf(TGUID);
  addressElements[dwElementCount].lpData := @ProviderGUID;
  Inc(dwElementCount);

  if CompareMem(@ProviderGUID, @DPSPGUID_MODEM, SizeOf(TGUID)) and ModemSetting.Enabled then
  begin
    {  Modem  }
    if ModemSetting.FModemName<>'' then
    begin
      addressElements[dwElementCount].guidDataType := DPAID_Modem;
      addressElements[dwElementCount].dwDataSize := Length(ModemSetting.FModemName)+1;
      addressElements[dwElementCount].lpData := PChar(ModemSetting.FModemName);
      Inc(dwElementCount);
    end;

    if ModemSetting.FPhoneNumber<>'' then
    begin
      addressElements[dwElementCount].guidDataType := DPAID_Phone;
      addressElements[dwElementCount].dwDataSize := Length(ModemSetting.FPhoneNumber)+1;
      addressElements[dwElementCount].lpData := PChar(ModemSetting.FPhoneNumber);
      Inc(dwElementCount);
    end;
  end else
  if CompareMem(@ProviderGUID, @DPSPGUID_TCPIP, SizeOf(TGUID)) and TCPIPSetting.Enabled then
  begin
    {  TCP/IP  }
    if TCPIPSetting.FHostName<>'' then
    begin
      addressElements[dwElementCount].guidDataType := DPAID_INet;
      addressElements[dwElementCount].dwDataSize := Length(TCPIPSetting.FHostName)+1;
      addressElements[dwElementCount].lpData := PChar(TCPIPSetting.FHostName);
      Inc(dwElementCount);
    end;

    if TCPIPSetting.Port<>0 then
    begin
      addressElements[dwElementCount].guidDataType := DPAID_INetPort;
      addressElements[dwElementCount].dwDataSize := SizeOf(TCPIPSetting.FPort);
      addressElements[dwElementCount].lpData := @TCPIPSetting.FPort;
      Inc(dwElementCount);
    end;