(*******
(c)2002 Ruben Chaer, rch@todo.com.uy

******)

unit uwinmsgs;

interface
uses
{$IFDEF LINUX}
  ERRORS,
  baseunix,
  ipc,
  uKeyDir,
{$ELSE}
  windows,
{$ENDIF}
  SysUtils;

{$IFNDEF WINDOWS}
const
  WM_USER = 1024;
{$ENDIF}

type
  PWinMsg= ^TWinMsg;

{$IFDEF LINUX}
  TWinMsg= packed record
    msgCode: cardinal;
    wParam: word;
    lParam: longint;
  end;
  TMessage= TWinMsg;
{$ELSE}
  TWinMSg= TMsg;
{$ENDIF}

{$IFDEF LINUX}
{ Al iniciar el modulo se debe crear la variable ColaDeMensajes
realizando un Create(idReceptor) dónde la aplicación está anunciando
cual es su identificador de recepción de mensajes.
Una vez inicializada, la variable ColaDeMensajes puede ser
accedida desde los demás módulos de la misma aplicación.
Generalmente será accedida en el loop de recolección de mensajes para
chequear la existencia de mensajes y por cualquier parte de la aplicación
para enviar mensajes. }


type
  PVIpcPermission = ^TVIpcPermission;
  TVIpcPermission = TIpc_Perm;

  TVMsgQueueIdDesc = TMSQid_ds;

Type

   TColaDeMensajes = class
    public
      FQueueId : Integer;
      idReceptor: LongWord;

      { Create: Crea el objeto y lo conecta a la cola de
      mensajes (comunes a todos los programas que usan esta
      unidad. El idReceptor es el código con el que se identifican
      los mensajes que son para este objeto. Los demás objetos que
      quieran enviar mensajes a este deben conocer su código.
      El primer objeto de este tipo (en el conjunto de aplicaciones)
      que utilicen esta unidada) es el que efectivamente crea la cola
      común de mensajes. La cola común no es destruida por ninguno de
      los objetos, por lo que queda en memoria hasta que se reinicia
      el sistema o sea elminada expresamente con otra utilidad.
      Este comportamiento se implemnto así porque esta unidad está
      pensada para la utilizar en aplicaciones como la del 0900 que
      son demonios que están siempre corriendo.}
      constructor Create( idReceptor: LongWord );


      {GetMessage: Lee un mensaje de la cola, si no hay ninguno epera,
      el resultado es 0 si volvio con mensaje o -1 sin no.
      Puede volver sin mensaje si ocurre una señal que deba
      ser atendida }
      function GetMessage( var msg: TWinMsg): integer;


      { PostMessage: Ingresa en la cola común el mensaje con los
      parámetros especificados. idDestino es el código del objeto
      destino. }
      function PostMessage(
            idDestino: integer;
            msgCode: cardinal;
            wParam: word;
            lParam: longint): integer;

      {GetMessageNoWait: Intenta leer un mensaje para este objeto de la
      cola común. Si no hay ningún mensaje cuyo código de destino sea el
      idReceptor de este objeto, vuelve inmediatamente con resultado -1
      Si logra leer un mensaje retorna el mensaje en el parámetro msg y
      el resultado de la función es 0}
      function GetMessageNoWait(
         var msg: TWinMsg ): integer;


      {Clear: borra mensajes pendietes para este objeto de la cola
      común. }
      procedure Clear;

      procedure Free;

      function GetStat( var ds:TVMsgQueueIdDesc): integer;

      {Elimina la cola global de mensajes. Si hay otras colas activas}
      function EliminarGlobal: integer;
   end;
{$ELSE}
Type

   TColaDeMensajes = class
      idReceptor: LongWord;
      constructor Create( idReceptor: LongWord );

      {GetMessage: Lee un mensaje de la cola, si no hay ninguno espera,
      el resultado es 0 si volvio con mensaje o -1 sin no.
      Puede volver sin mensaje si ocurre una señal que deba
      ser atendida }
      function GetMessage( var msg: TWinMsg): integer;

      { PostMessage: Ingresa en la cola común el mensaje con los
      parámetros especificados. idDestino es el código del objeto
      destino. }
      function PostMessage(
            idDestino: integer;
            msgCode: cardinal;
            wParam: word;
            lParam: longint): integer;

      {GetMessageNoWait: Intenta leer un mensaje para este objeto de la
      cola común. Si no hay ningún mensaje cuyo código de destino sea el
      idReceptor de este objeto, vuelve inmediatamente con resultado -1
      Si logra leer un mensaje retorna el mensaje en el parámetro msg y
      el resultado de la función es 0}
      function GetMessageNoWait(
         var msg: TWinMsg ): integer;


      {Clear: borra mensajes pendietes para este objeto de la cola
      común. }
      procedure Clear;
      procedure Free;
//      function GetStat( var ds: TVMsgQueueIdDesc): integer;
      {Elimina la cola global de mensajes. Si hay otras colas activas}
//      function EliminarGlobal: integer;
   end;
{$ENDIF}

var
  ColaDeMensajes: TColaDeMensajes;

implementation

{$IFDEF LINUX}
type
{$ALIGN 4}
  TWinMsgRec= record
    //mtype: longWord;
    mtype: clong;
    msgData: TWinMsg;
  end;

const
//  AccessMode = S_IREAD or S_IWRITE or S_IRGRP or S_IWGRP;
  AccessMode = S_IRUSR or S_IWUSR or S_IRGRP or S_IWGRP;
  SizeOfMSgData: size_t = SizeOf( TWinMSg );

{ función para eliminar la cola global.
OJo, Vuelve inválido los objetos del tipo
TColaDeMensajes que estén creados }
function TColaDeMensajes.EliminarGlobal: integer;
var
  res: integer;
begin
  res:= MsgCtl(FQueueId, IPC_RMID, nil);
  if res <0 then
    raise Exception.Create (strerror(errno));
  result:= res;
end;

{ Métodos de TColaDeMensajes }

constructor TColaDeMensajes.Create( idReceptor: LongWord );
var
   key: key_t;
begin
   inherited Create;
   self.idReceptor:= idReceptor;
   key:= ftok( keyColaMensajes, 1);
   writeln('keyColaMensajes= ', keyColaMensajes);
   if key= key_t(-1) then
   begin
      writeln('TColaDeMensajes, Key= -1');
      halt;
   end;
   FQueueId := msgget( key, IPC_CREAT or AccessMode);
  writeln('TColaDeMensajes.Create, FQueueId= ', FQueueId);
   if FQueueID = -1 then
      raise Exception.Create (strerror (errno));
end;

function TColaDeMensajes.GetMessage(
   var msg: TWinMsg ): integer;

var
  msgRec: TWinMsgRec;
  len: Integer;
begin
  writeln('TColaDeMensajes.GetMessage(): FQueueId,= ', FQueueId, ', SizeOfMsgData= ', SizeOfMsgData, ', idReceptor= ', idReceptor, ', flags= ', MSG_NOERROR);
  len := msgrcv( FQueueId, @msgRec, SizeOfMsgData,
                  idReceptor, MSG_NOERROR);

  writeln('len ', len);
  writeln('SizeOfMsgData ',SizeOfMsgData);
  if len = Integer(SizeOfMsgData) then
  begin
    msg:= msgRec.msgData;
    result:= 0;
  end
  else
  begin
    result:= -1;
  end;

  writeln('sale');
end;

function TColaDeMensajes.GetMessageNoWait(
   var msg: TWinMsg ): integer;

var
  msgRec: TWinMsgRec;
  len: Integer;
begin
  writeln('TColaDeMensajes.GetMessage(): FQueueId,= ', FQueueId, ', SizeOfMsgData= ', SizeOfMsgData, ', idReceptor= ', idReceptor, ', flags= ', MSG_NOERROR);
  len:= msgrcv(FQueueId, @msgRec, SizeOfMsgData, idReceptor, IPC_NOWAIT or MSG_NOERROR);

writeln('len: ', len, ', SizeOfMsgData: ',SizeOfMsgData );

  if len = integer( SizeOfMsgData ) then
  begin

writeln('r0');
    msg:= msgRec.msgData;
    result:= 0;
  end
  else
  begin
writeln('r1');
    result:= -1;
  end;
end;


function TColaDeMensajes.PostMessage(
   idDestino: integer;
   msgCode: cardinal;
   wParam: word;
   lParam: longint): integer;
var
  msgRec: TWinMsgRec;
begin
  if FQueueID <> -1 then
  begin
    msgRec.mtype := idDestino;
    msgRec.msgData.msgCode:= msgCode;
    msgRec.msgData.wParam:= wParam;
    msgRec.msgData.lParam:= lParam;
    result:= msgsnd (FQueueId, @msgRec, SizeOfMsgData, IPC_NOWAIT);
  end
  else
   result:= -2;
end;

procedure TColaDeMensajes.Clear;
var
   msg: TWinMsg;
   res: integer;
begin

writeln('->TColoaDeMensajes.Clear' );
   repeat
     res:= GetMessageNoWait(msg);
writeln( 'res: ', res );
   until res < 0;
writeln('TColoaDeMensajes.Clear->' );
end;

procedure TColaDeMensajes.Free;
begin
  //msgctl(FQueueId, IPC_RMID, NIL);
  inherited Free;
end;

function TColaDeMensajes.GetStat( var ds:TVMsgQueueIdDesc): integer;
var
   Buff: packed record
      perm: TVIpcPermission; //  ipc_perm; //array[1..8] of word;
      ppm, pum: pointer;
      ltsnd, ltrcv, ltchng: cardinal;
      u1, u2: cardinal;
      nbytes: word;
      nmensajes: word;
      nmxmensajes: word;
      d: array[1..1000] of word;
   end;
begin
  result := msgctl(FQueueID, IPC_STAT, @Buff); // @ds
  ds:=TVMsgQueueIdDesc( pointer(@Buff)^ );
end;
{$ELSE}


constructor TColaDeMensajes.Create( idReceptor: LongWord );
begin
  inherited Create;
  Self.idReceptor:= idReceptor;
end;

function TColaDeMensajes.GetMessage( var msg: TWinMsg): integer;
begin
  result:= integer(windows.getmessage( msg, idreceptor, 0, 0 ));
end;

function TColaDeMensajes.PostMessage(
            idDestino: integer;
            msgCode: cardinal;
            wParam: word;
            lParam: longint): integer;
begin
  result:= integer( windows.PostMessage(idDestino, msgCode, wParam, lparam ));
end;

function TColaDeMensajes.GetMessageNoWait(
         var msg: TWinMsg ): integer;
begin
  result:= integer( windows.PeekMessage( msg, idReceptor, 0, 0, PM_REMOVE));
end;

procedure TColaDeMensajes.Clear;
var
  msg: TWinMsg;
begin
    while GetMessageNoWait( msg ) > 0 do;
end;


procedure TColaDeMensajes.Free;
begin
  inherited Free;
end;

{$ENDIF}

end.
