kam-mobile/vendor/kam_remake/src/net/KM_NetUDP.pas

unit KM_NetUDP;
{$I KaM_Remake.inc}
interface
uses
  Classes, Math, SysUtils, KM_CommonClasses, KM_Defaults
  {$IFDEF WDC} ,KM_NetUDPOverbyte {$ENDIF}
  {$IFDEF FPC} ,KM_NetUDPLNet {$ENDIF}
  ;


type
  TNotifyServerDetectedEvent = procedure(const aAddress: string; const aPort: Word; const aName: string) of object;

  TKMNetUDP = class
  private
    {$IFDEF WDC} fUDP: TKMNetUDPOverbyte; {$ENDIF}
    {$IFDEF FPC} fUDP: TKMNetUDPLNet;     {$ENDIF}

    fOnError: TGetStrProc;
    procedure HandleReceive(const aAddress: string; aData: Pointer; aLength: Cardinal); virtual; abstract;
    procedure HandleError(const aMsg: string);
  protected
    fScanPort: Word;
  public
    constructor Create(aScanPort: Word);
    destructor Destroy; override;
    procedure UpdateStateIdle;
    property OnError: TGetStrProc write fOnError;
  end;

  TKMNetUDPAnnounce = class(TKMNetUDP)
  private
    fServerName: AnsiString;
    fGamePort: Word;
    procedure HandleReceive(const aAddress: string; aData: Pointer; aLength: Cardinal); override;
  public
    procedure StartAnnouncing(const aGamePort: Word; const aName: AnsiString; aAnnounce: Boolean);
    procedure StopAnnouncing;
    procedure UpdateSettings(const aName: AnsiString; aScanPort: Word);
  end;

  TKMNetUDPScan = class(TKMNetUDP)
  private
    fOnServerDetected: TNotifyServerDetectedEvent;
    procedure HandleReceive(const aAddress: String; aData: Pointer; aLength: Cardinal); override;
  public
    procedure ScanForServers;
    procedure TerminateScan;
    property OnServerDetected: TNotifyServerDetectedEvent write fOnServerDetected;
  end;


implementation


{ TKMNetUDP }
constructor TKMNetUDP.Create(aScanPort: Word);
begin
  inherited Create;
  {$IFDEF WDC} fUDP := TKMNetUDPOverbyte.Create; {$ENDIF}
  {$IFDEF FPC} fUDP := TKMNetUDPLNet.Create;     {$ENDIF}
  fScanPort := aScanPort;
  fUDP.OnError := HandleError;
  fUDP.OnRecieveData := HandleReceive;
end;


destructor TKMNetUDP.Destroy;
begin
  fUDP.Free;

  inherited;
end;


procedure TKMNetUDP.HandleError(const aMsg: String);
begin
  if Assigned(fOnError) then fOnError(aMsg);
end;


procedure TKMNetUDP.UpdateStateIdle;
begin
  {$IFDEF FPC} fUDP.UpdateStateIdle; {$ENDIF}
end;


{ TKMNetUDPAnnounce }
procedure TKMNetUDPAnnounce.StartAnnouncing(const aGamePort: Word; const aName: AnsiString; aAnnounce: Boolean);
begin
  fServerName := aName;
  fGamePort := aGamePort;
  fUDP.StopListening;
  if aAnnounce then
    try
      fUDP.Listen(SERVER_DEFAULT_UDP_ANNOUNCE_PORT);
    except
      //UDP announce is not that important, and will fail whenever you start more than 1 server per machine
      on E: Exception do
        if Assigned(fOnError) then fOnError('UDP listen for local server detection failed to start: ' + E.Message);
    end;
end;


procedure TKMNetUDPAnnounce.StopAnnouncing;
begin
  fUDP.StopListening;
end;


procedure TKMNetUDPAnnounce.UpdateSettings(const aName: AnsiString; aScanPort: Word);
begin
  fServerName := aName;
  fScanPort := aScanPort;
end;


procedure TKMNetUDPAnnounce.HandleReceive(const aAddress: string; aData: Pointer; aLength: Cardinal);
var
  M: TKMemoryStream;
  S: AnsiString;
begin
  M := TKMemoryStreamBinary.Create;
  try
    M.WriteBuffer(aData^, aLength);
    M.Position := 0;

    //Check header
    M.ReadA(S);
    if S <> 'KaM Remake' then Exit;
    M.ReadA(S);
    if S <> NET_PROTOCOL_REVISON then Exit;

    //Only care about scan packets
    M.ReadA(S);
    if S <> 'scan' then Exit;

    //Send a response to this scanner
    M.Free;
    M := TKMemoryStreamBinary.Create;
    M.WriteA('KaM Remake');
    M.WriteA(NET_PROTOCOL_REVISON);
    M.WriteA('announce');
    M.Write(fGamePort);
    M.WriteA(fServerName);

    fUDP.SendPacket(aAddress, fScanPort, M.Memory, M.Size);
  finally
    M.Free;
  end;
end;


{ TKMNetUDPDetect }
procedure TKMNetUDPScan.ScanForServers;
var
  M: TKMemoryStream;
begin
  //Prepare to receive responses
  fUDP.StopListening;
  try
    fUDP.Listen(fScanPort);
  except
    //UDP scan is not that important, and could fail during debugging if running two KaM Remake instances
    on E: Exception do
    begin
      if Assigned(fOnError) then fOnError('UDP scan failed to listen: ' + E.Message);
      Exit;
    end;
  end;

  M := TKMemoryStreamBinary.Create;
  try
    M.WriteA('KaM Remake');
    M.WriteA(NET_PROTOCOL_REVISON);
    M.WriteA('scan');
    try
      //Broadcast
      fUDP.SendPacket('255.255.255.255', 56789, M.Memory, M.Size);
    except
      on E: Exception do
      begin
        if Assigned(fOnError) then fOnError('UDP broadcast failed: ' + E.Message);
        Exit;
      end;
    end;
  finally
    M.Free;
  end;
end;


procedure TKMNetUDPScan.TerminateScan;
begin
  fUDP.StopListening;
end;


procedure TKMNetUDPScan.HandleReceive(const aAddress: String; aData: Pointer; aLength: Cardinal);
var
  M: TKMemoryStream;
  S, ServerName: AnsiString;
  serverPort: Word;
begin
  M := TKMemoryStreamBinary.Create;
  try
    M.WriteBuffer(aData^, aLength);
    M.Position := 0;

    M.ReadA(S);
    if S <> 'KaM Remake' then Exit;
    M.ReadA(S);
    if S <> NET_PROTOCOL_REVISON then Exit;
    //Only care about announce packets
    M.ReadA(S);
    if S <> 'announce' then Exit;

    //Read the server's game port and report it
    M.Read(serverPort);
    M.ReadA(ServerName);
    fOnServerDetected(aAddress, serverPort, UnicodeString(ServerName));
  finally
    M.Free;
  end;
end;


end.