unit udp_rcon;

interface

uses
 IdComponent, IdException, IdGlobal, IdSocketHandle, IdStackConsts,
 IdThread, IdUDPBase, IdUDPserver,IdStack,IdWinsock2,
 types,classes,windows,kontrol_types;


type Tudp_rcon = class

  UDP:           tIdUDPserver;   // our UDP connection for rcon data
  bufferOut:     Tlist;          // used for outgoing packet storage

  pinglist:      Tlist;          // used to determine packet ping responses times

 private
  owner:         hwnd;           // destination for sending packet data / comms specific messages
  control:       hwnd;           // destination for sending every other message
  perffreq:      int64;          // used for high resolution timers

  procedure      Debug(thestatus:integer;thetext:string);
                 // used to send debug messages back to the main program
  procedure      UDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle);
                 // actually reads in the data from the socket
  procedure      storeping(theip:string;theport:integer);
                 // stores small information about packet data so we can work out ping times
  function       findpingfromip(theip:string;theport:integer):pping;
                 // searches pinglist for matching packet data to work out ping times
 public

  constructor    Create(theowner:hwnd;MyClientInterface,MyClientPort:integer);overload;
                 // this constructor is used to create a UDP socket on a specific interface and port number
                 // theowner refers to the 'owner' handle that the class should send messages to.
                 // thecontrol resfers to the control class that all UDP based messages should be sent.

  destructor     Destroy; override;
                 // this destructor is used to make sure the UDP socket is closed safely

  procedure      send(host:string;port:integer;text:string);
                 // sends a packet with specified data

  procedure      bufferadd(thepacket:ppacket);

 end;

   {
   This is our thread that we use for our data sending. Recieving data is already
   threaded by indy, we're writing one for sending so we can do stuff like queue
   prioritising and packet rate limiting.
  }

 type
  TThreadSend = class(TThread)
   udpobject:Tudp_rcon;      // we use this to access the current udp object.
                             // this is automatically set on tgameudp construction.
   packetspersecond:integer;
   bytespersecond:integer;
   suspendrequest:boolean;
  private
   owner:Hwnd;               // for sendmessage calls
   packettosend:Tpacket;     // for internal use.
   packetsthissecond:integer;// for internal use in calculating packets/sec
   bytesthissecond:integer;  // for internal use in calculating bytes/sec
  protected
    procedure Execute; override;
    procedure sendnextpacket;
  public
   constructor create(theowner:hwnd;startpaused:boolean);       // sets initial values APART FROM UDPOBJECT WHICH NEEDS TO BE SET!
  end;



 // ******************
      implementation
 // ******************

 uses sysutils;

const
 UDP_RECIEVETIMEOUT = 5000; // milliseconds

var
  senderthread:   tthreadsend;


constructor Tudp_rcon.create(theowner:hwnd;MyClientInterface,MyClientPort:integer);
var
Binding : TIdSocketHandle;
count:integer;
adapterlist:tstringlist;
begin

 // set message destinations
 owner:=theowner;
 control:=theowner;//thecontrol;

 Debug(0,'Tudp_rcon initialising'); // send debug message

  try
   UDP:=TIdudpServer.create(nil); // main serverlist query port
   UDP.Active:=false;
   UDP.Bindings.Clear;
   UDP.ReceiveTimeout:=UDP_RECIEVETIMEOUT;
   UDP.DefaultPort:=MyClientPort;
   UDP.BroadcastEnabled:=true;
  except
   SendMessage(control, WM_ERRORHANDLER, wparam(-1), lparam(-1));
  end;


 try
  // this section binds the UDP component to the appropriate network interface
  if myclientinterface=-1 then begin
   // no adapter specified - bind UDP to all available network adapters

   adapterlist := tstringlist.create;
   adapterlist.AddStrings(gstack.LocalAddresses);

   for count:=0 to adapterlist.count-1 do begin
    Debug(0,'Tudp_rcon is binding itself to interface '+inttostr(count)+' with IP : '+adapterlist.strings[count]+' on port '+inttostr(myclientport));
    Binding := UDP.Bindings.Add;
    Binding.IP := adapterlist.strings[count];
    Binding.Port := myclientport;
   end;
   adapterlist.Destroy;

  end else begin
  // bind to a specific network adapter

   adapterlist := tstringlist.create;
   adapterlist.AddStrings(gstack.LocalAddresses);

   Debug(0,'Tudp_rcon binding to specific interface : '+adapterlist.strings[myclientinterface]);
   Binding := UDP.Bindings.Add;
   Binding.IP := adapterlist.strings[myclientinterface];
   Binding.Port := myclientport;
   adapterlist.Destroy;

  end;

  UDP.OnUDPRead:=UdpRead;     // set procedure which deals with UDP when data is available
  UDP.Active:=true;           // enable UDP device

 except
  SendMessage(control, WM_ERRORHANDLER, wparam(-1), lparam(-2));
 end;


 try
  // setup Pointer stores
  bufferOut:=Tlist.create;
  pinglist:=tlist.create;
  QueryPerformanceFrequency(perffreq); // used for high resolution timings
 except
  SendMessage(owner, WM_ERRORHANDLER, wparam(-1), lparam(-3));
 end;

 try
  senderthread:=Tthreadsend.Create(owner,true); // don't start the thread yet, we need to assign the udpobject
  senderthread.udpobject:=self;
 except
 end;


  // START THREADS
  senderthread.Resume; // start the thread!


end;


destructor Tudp_rcon.destroy;
begin
 try
  senderthread.Resume;
  senderthread.Terminate;
  senderthread.WaitFor;
  senderthread.Free;

  UDP.active:=false;
  UDP.Destroy;
  Inherited;
 except
  SendMessage(owner, WM_ERRORHANDLER, wparam(-1), lparam(-4));
 end;
end;


procedure Tudp_rcon.Debug(thestatus:integer;thetext:string);
var
 debug:Pdebugmessage;
begin
 try

  debug:=new(Pdebugmessage);
  debug^.category:=thestatus;
  debug^.text:=thetext;

  SendMessage(control, WM_UPDATEDEBUG, wparam(debug), lparam(-1));
 except
 end;

end;


function Tudp_rcon.findpingfromip(theip:string;theport:integer):pping;
var
search,found:pping;
count,index:integer;
dofind:boolean;
begin

 try
 found:=nil;
 index:=-1;
 if pinglist.count>0 then dofind:=true else dofind:=false;
     while (dofind) and (found=nil) do begin
      for count:=pinglist.count-1 downto 0 do begin
       search:=PPing(pinglist[count]);
       if (search^.ip=theip) and (search^.port=theport) then begin
        found:=search;
        index:=count;
        end;
      end;
     dofind:=false;
     end;
     if index<>-1 then pinglist.Delete(index);    /// delete the pinglist entry
  result:=found;
 except
  result:=nil;
 end;

end;


procedure Tudp_rcon.storeping(theip:string;theport:integer);
var
newping:Pping;
begin

try  // restrict pinglist size so it's not too big
 if pinglist.count>PING_CACHESIZE then
  while pinglist.Count>round(PING_CACHESIZE/2) do begin
   dispose(pinglist.Items[0]);
   pinglist.Delete(0);
  end;
 except
  SendMessage(owner, WM_ERRORHANDLER, wparam(-1), lparam(-8));
 end;


 try // store ping
    newping:=new(PPing);
     with newping^ do begin
      QueryPerformanceCounter(sent);
      ip:=theip;
      port:=theport;
     end;
    pinglist.Add(newping);
 except
  SendMessage(owner, WM_ERRORHANDLER, wparam(-1), lparam(-9));
 end;

end;




procedure Tudp_rcon.UDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle);
var
  DataStringStream: TStringStream;
  Packet:Ppacket;
  calculatedping:integer;
  oldping:Pping;
  perftime:int64;
begin
  packet:=nil;

  QueryPerformanceCounter(perftime);
  DataStringStream := TStringStream.Create('');
  try
   DataStringStream.CopyFrom(AData, AData.Size);
   // store data from the socket
  except
   SendMessage(owner, WM_ERRORHANDLER, wparam(-1), lparam(-5));
  end;

  try

   // work out packet ping
    oldping:=findpingfromip(ABinding.PeerIP,ABinding.PeerPort);

     if oldping<>nil then begin
       calculatedping:=round((perftime-oldping^.sent) /(perffreq div 1000));
       // ping was found so delete ping from list.
       dispose(oldping);
      end else calculatedping:=9999;
     if calculatedping>9999 then calculatedping:=9999;

  except
   calculatedping:=9999;
   SendMessage(owner, WM_ERRORHANDLER, wparam(-1), lparam(-6));
  end;

  try
   // store packet in our own format
   packet:=new(Ppacket);
   with packet^ do begin
     data := datastringstream.datastring;
     ip:=ABinding.PeerIP;
     port:=ABinding.PeerPort;
     ping:=calculatedping;
     datetime:=time;
    end;
  except
   SendMessage(owner, WM_ERRORHANDLER, wparam(-1), lparam(-7));
  end;

  DataStringStream.Free;

  // send this packet back to the component owner who will hopefully know what to do with it
  SendMessage(owner, WM_PACKETDATA, wparam(-1), lparam(packet));

end;

procedure Tudp_rcon.send(host:string;port:integer;text:string);
var
theip:string;
temptext:string;
begin

 // dump packet output to window
 temptext:=text; while pos(chr(0),temptext)<>0 do temptext[pos(chr(0),temptext)]:=' ';
 debug(11,'-> RCON OUT ['+host+':'+inttostr(port)+'] '+inttostr(length(temptext))+' bytes : '+pchar(temptext));


  { We use 'resolvehost' which has an inbuilt 'check if this is an ip' function
    so if it's not an ip address then it calls WSGetHostByName(AHost).
    Really, the calling code should convert all domain based names into IPs first
    this is just here as a precuationary measure.
  }
  try
   theip:=Gstack.ResolveHost(host);
  except
   SendMessage(owner, WM_ERRORHANDLER, wparam(-1), lparam(-10));
  end;

  // send the packet
  try
   if theip='255.255.255.255' then udp.Broadcast(text,port) else udp.Send(theip,port,text);
  except
   SendMessage(owner, WM_ERRORHANDLER, wparam(-1), lparam(-11));
  end;

  // store the packet's ping information
  try
   storeping(theip,port);
  except
   SendMessage(owner, WM_ERRORHANDLER, wparam(-1), lparam(-12));
  end;

end;

procedure Tudp_rcon.bufferadd(thepacket:ppacket);
begin
 bufferout.add(thepacket);
end;


// ************ THREAD ***************

constructor TThreadSend.create(theowner:hwnd;startpaused:boolean);
begin
   owner:=theowner;
   packetspersecond:=DEFAULT_PACKETLIMIT;
   bytespersecond:=DEFAULT_BYTELIMIT;
   suspendrequest:=false;
   inherited Create(startpaused); // actually go and create the thread
end;


procedure TThreadSend.Execute;
var
mypointer:Ppacket;
begin

 repeat
  try
  // cycle through the buffer sending each packet

  while udpobject.bufferout.count<>0 do begin
   if terminated then exit;
   if SuspendRequest then abort;

    mypointer:=udpobject.bufferout.Extract(udpobject.bufferOut.first);
    packettosend:=(mypointer)^;

    inc(PacketsThisSecond);
    bytesthissecond:=bytesthissecond + length(packettosend.data);
     if (PacketsThisSecond<=PacketsPerSecond) and // checks packets per second rate limit
        (BytesThisSecond<=BytesPerSecond) then begin   // checks bytes per second limit

       synchronize(sendnextpacket);

      sleep(round(1000 div packetspersecond));         // space out packets according to ratelimit, helps keep pings and modems happy
                                                       // possible win9x compatability problems with sleep<15ms ?
     end else begin                             {if limits are hit, which shouldn't be hit due to above}

      synchronize(sendnextpacket);
      sleep(round(1000 div packetspersecond)+10); // wait a bit longer
      packetsthissecond:=1;                    // re-init packets this second
      BytesThisSecond:=1;                      // re-init bytes this second
     end;
                                               {  Note, we are sending the packet in either case whether it hits the limit or not
                                                  this is to avoid deadlock caused by setting the limits extremely low (for instance
                                                  setting the byte limit BELOW the size of the next packet's data is not good!).
                                                  In this case, our code will send it but limited to one send per second.
                                                  We do not reccomend limiting the byterate below 1500bytes (max packet length for UDP)
                                               }
     dispose(mypointer);     // remove packet data from memory
     
     if SuspendRequest then begin
      suspend;
      suspendrequest:=false;
     end;
     
  end;  // while bufferout is not empty

 sleep(SLEEPTIME); // if we don't sleep, we'll end up using all the cpu cycles!!!

 except
  //SendMessage(owner, WM_ERRORHANDLER, wparam(-1), lparam(-7));
  udpobject.Debug(1,'KUDP TThreadSend.Execute caused an exception trying to process bufferout (non-fatal)');
  //udpobject.bufferout.UnlockList;
 end;

 until Terminated;

end;

procedure TThreadSend.sendnextpacket;
begin

 try
  udpobject.send(packettosend.ip,packettosend.port,packettosend.data);
 except
  SendMessage(owner, WM_ERRORHANDLER, wparam(@packettosend), lparam(-39));
 end;

end;


end.