{Copyright or © or Copr. :

CNRS - Laboratoire Mouvement & Perception
franck.buloup@univmed.fr

This software is a computer program whose purpose is to highly simplify  
the use of ADwinPro realtime systems when you develop experimental
protocols  on life's sciences area.

This software is governed by the CeCILL  license under French law and
abiding by the rules of distribution of free software.  You can  use, 
modify and/ or redistribute the software under the terms of the CeCILL
license as circulated by CEA, CNRS and INRIA at the following URL
"http://www.cecill.info". 

As a counterpart to the access to the source code and  rights to copy,
modify and redistribute granted by the license, users are provided only
with a limited warranty  and the software's author,  the holder of the
economic rights,  and the successive licensors  have only  limited
liability. 

In this respect, the user's attention is drawn to the risks associated
with loading,  using,  modifying and/or developing or reproducing the
software by the user in light of its specific status of free software,
that may mean  that it is complicated to manipulate,  and  that  also
therefore means  that it is reserved for developers  and  experienced
professionals having in-depth computer knowledge. Users are therefore
encouraged to load and test the software's suitability as regards their
requirements in conditions enabling the security of their systems and/or 
data to be ensured and,  more generally, to use and operate it in the 
same conditions as regards security. 

The fact that you are presently reading this means that you have had
knowledge of the CeCILL license and that you accept its terms.}
unit UServerThread;

interface

uses
  Classes, Winsock, Dialogs, SysUtils, windows, Forms, UClientFrame;

type
  TClientState = class
  public
    Active : boolean;
    ClientFrame : TClientFrame;
  end;
  TServerThread = class(TThread)
  private
    { Déclarations privées }
    ServerSocket : TSocket;
    fsin : TSockAddrIn;
    fsinsize : integer;
    ClientList : TStringList;
    ClientRequest : Char;
    numLockerClient : integer;
    ADWinLocked : boolean;
    procedure NextLockerClient;
    function passiveUDP(IP : string; Port : integer) : TSocket;
    procedure UpdateIHM;
  protected
    procedure Execute; override;
  public
    TerminateThread : boolean;
    constructor Create(Suspended : boolean; IP : string; Port : integer);
    procedure OnClientConnection;
    procedure OnClientDisconnection;
    procedure OnClientLockRequest;
    procedure OnClientEndLock;
    procedure OnClientActivate;
    procedure OnClientInactivate;
    procedure ErrorExit(Msg : string);
  end;

implementation

{ Important : les méthodes et propriétés des objets de la VCL peuvent uniquement
  être utilisés dans une méthode appelée en utilisant Synchronize, comme :

      Synchronize(UpdateCaption);

  où UpdateCaption serait de la forme 

    procedure TNetworkThread.UpdateCaption;
    begin
      Form1.Caption := 'Mis à jour dans un thread';
    end; }

{ TNetworkThread }

uses UServer;

var YES : char = '1';
    NO : char = '0';

procedure TServerThread.ErrorExit(Msg : string);
begin
  showmessage(Msg);
  WSACleanup();
  Terminate;
end;

function TServerThread.passiveUDP(IP : string; Port : integer) : TSocket;
var sin : TSockAddrIn;
    s : TSocket;
    ppe : PProtoEnt;
    iMode : integer;
begin
  //Configure parametre socket
  sin.sin_family := AF_INET;
  sin.sin_addr.S_addr := inet_addr(PAnsiChar(IP));//INADDR_ANY;
  sin.sin_port := Port;

  //Protocole UDP
  ppe := getprotobyname(PChar('UDP'));

  //Creation de la socket
  s := socket(PF_INET,SOCK_DGRAM,ppe.p_proto);
  if (s = INVALID_SOCKET)
  then ErrorExit('SOCKET - Impossible de créer le socket ' + inttostr(getLastError()));

  //Bind
  if (bind(s,sin,sizeof(sin)) = SOCKET_ERROR)
  then ErrorExit('BIND - Impossible de créer le socket ' + inttostr(getLastError()));

  //-------------------------
  // Set the socket I/O mode: In this case FIONBIO
  // enables or disables the blocking mode for the
  // socket based on the numerical value of iMode.
  // If iMode = 0, blocking is enabled;
  // If iMode != 0, non-blocking mode is enabled.
  iMode := 1;
  ioctlsocket(s, FIONBIO, iMode);

  Result := s;
end;

constructor TServerThread.Create(Suspended : boolean; IP : string; Port : integer);
var WSVERS : word ;
    AWSAData : TWSAData;
begin
  inherited Create(Suspended);

  //Load winsock DLL
  WSVERS := MAKEWORD(2,2);
  if WSAStartup(WSVERS,AWSAData) > 0
  then ErrorExit('Erreur au chargement de la dll winsock');

  //Configuration server socket UDP
  ServerSocket := passiveUDP(IP,Port);

  fsinsize := sizeof(fsin);

  //Liste IP des clients
  ClientList := TStringList.Create;

  TerminateThread := false;
  numLockerClient := 0;
  ADWinLocked := false;

  Priority := tpTimeCritical;
  freeOnTerminate := true;
end;

procedure TServerThread.OnClientConnection;
var AClientState : TClientState;
    index,i,n : integer;
    fin : boolean;
    //HostEnt: PHostEnt;
begin
  sendto(ServerSocket,YES,sizeof(YES),0,fsin,fsinsize);

  AClientState := TClientState.Create;
  AClientState.Active := false;

  AClientState.ClientFrame := TClientFrame.Create(ServerForm);
  AClientState.ClientFrame.Visible := true;
  AClientState.ClientFrame.Parent := ServerForm.ClientScrollBox;

  n := 0;
  repeat
    fin := true;
    for i := 0 to ClientList.Count - 1 do
    begin
      if (ClientList.Objects[i] as TClientState).ClientFrame.Name = 'ClientFrame' + inttostr(n) then
      begin
        fin := false;
        inc(n);
        break;
      end;
    end;
  until fin;

  AClientState.ClientFrame.Name := 'ClientFrame' + inttostr(n);

  //HostEnt:= GetHostByAddr(@fsin.sin_addr.S_addr, 4, AF_INET);
  //index := ClientList.Add( StrPas(Hostent^.h_name) + ' - ' + inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));
  index := ClientList.Add(inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));
  AClientState.ClientFrame.Panel.Caption := ClientList[index];

  ClientList.Objects[index] := AClientState;
end;

procedure TServerThread.OnClientDisconnection;
var index : integer;
    //HostEnt: PHostEnt;
begin
  sendto(ServerSocket,YES,sizeof(YES),0,fsin,fsinsize);

  //HostEnt:= GetHostByAddr(@fsin.sin_addr.S_addr, 4, AF_INET);
  //index := ClientList.IndexOf(StrPas(Hostent^.h_name) + ' - ' + inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));
  index := ClientList.IndexOf(inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));
  (ClientList.Objects[index] as TClientState).ClientFrame.Free;
  ClientList.Objects[index].Free;
  ClientList.Delete(index);
  if numLockerClient = ClientList.Count then numLockerClient := 0
end;

procedure TServerThread.NextLockerClient;
begin
  inc(numLockerClient);
  if numLockerClient = ClientList.Count then numLockerClient := 0;
end;

procedure TServerThread.OnClientLockRequest;
var numClient : integer;
    //HostEnt: PHostEnt;
begin
  if ADWinLocked
  then sendto(ServerSocket,NO,sizeof(NO),0,fsin,fsinsize) //adwin déja utilisé
  else begin
    //ADwin non utilisé
    //HostEnt:= GetHostByAddr(@fsin.sin_addr.S_addr, 4, AF_INET);
    //numClient := ClientList.IndexOf(StrPas(Hostent^.h_name) + ' - ' + inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));
    numClient := ClientList.IndexOf(inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));

    if numClient = numLockerClient then
    begin
      //C'est le bon client
      ADWinLocked := true;
      (ClientList.Objects[numClient] as TClientState).ClientFrame.LockAdwin;
      sendto(ServerSocket,YES,sizeof(YES),0,fsin,fsinsize)
    end else
    begin
      //C'est pas le bon client
      sendto(ServerSocket,NO,sizeof(NO),0,fsin,fsinsize);
      //Verif si bon client actif sinon passe au client suivant
      if not (ClientList.Objects[numLockerClient] as TClientState).Active
      then NextLockerClient;
    end;
  end;
end;

procedure TServerThread.OnClientEndLock;
var numClient : integer;
    //HostEnt: PHostEnt;
begin
  //Le Client utilisant l'adwin a terminé
  ADwinLocked := false;
  //HostEnt:= GetHostByAddr(@fsin.sin_addr.S_addr, 4, AF_INET);
  //numClient := ClientList.IndexOf(StrPas(Hostent^.h_name) + ' - ' + inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));
  numClient := ClientList.IndexOf(inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));

  (ClientList.Objects[numClient] as TClientState).ClientFrame.UnLockADwin;
  sendto(ServerSocket,YES,sizeof(YES),0,fsin,fsinsize);
  NextLockerClient;
end;

procedure TServerThread.OnClientActivate;
var numClient : integer;
    //HostEnt: PHostEnt;
begin
  //HostEnt:= GetHostByAddr(@fsin.sin_addr.S_addr, 4, AF_INET);
  //numClient := ClientList.IndexOf(StrPas(Hostent^.h_name) + ' - ' + inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));
  numClient := ClientList.IndexOf(inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));
  (ClientList.Objects[numClient] as TClientState).Active := true;
  sendto(ServerSocket,YES,sizeof(YES),0,fsin,fsinsize);
end;

procedure TServerThread.OnClientInactivate;
var numClient : integer;
    //HostEnt: PHostEnt;
begin
  //HostEnt:= GetHostByAddr(@fsin.sin_addr.S_addr, 4, AF_INET);
  //numClient := ClientList.IndexOf(StrPas(Hostent^.h_name) + ' - ' + inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));
  numClient := ClientList.IndexOf(inet_ntoa(fsin.sin_addr) + ' : ' + inttostr(fsin.sin_port));
  (ClientList.Objects[numClient] as TClientState).Active := false;
  sendto(ServerSocket,YES,sizeof(YES),0,fsin,fsinsize);
end;

procedure TServerThread.UpdateIHM;
begin
//
end;

procedure TServerThread.Execute;
begin
  { Placez le code du thread ici }

  while not Terminated do
  begin
    Application.ProcessMessages;
    ClientRequest := #0;
    if (recvfrom(ServerSocket,ClientRequest,sizeof(ClientRequest),0,fsin,fsinsize) = SOCKET_ERROR)
    then if WSAEWOULDBLOCK <> getLastError()
         then ErrorExit('recvfrom erreur' + inttostr(getLastError()));

    case ClientRequest of
      'C' : OnClientConnection;
      'A' : OnClientActivate;
      'L' : OnClientLockRequest;
      'E' : OnClientEndLock;
      'I' : OnClientInactivate;
      'D' : OnClientDisconnection;
    else
      //...
    end;

    Synchronize(UpdateIHM);

    if TerminateThread then
    begin
      if ClientList.Count > 0 then
      begin
        TerminateThread := false;
        ServerForm.StatePanel.Caption := 'Il y a encore des clients connectés !!!';
      end else
      begin
        shutdown(ServerSocket,1);
        if (closesocket(ServerSocket) <> 0)
        then showmessage('Impossible liberer socket' + inttostr(getLastError()));
        WSACleanup();
        ClientList.Free;
        Terminate;
      end;
    end;
  end;
end;

end.
