unit uglobsharedmem;
{$MODE Delphi}

interface
uses
{$IFDEF HEAPMANAGER}
  uHeapManager,
{$ENDIF}

{$IFDEF WINDOWS}
  ipcthrd,
  windows,
{$ELSE}
  uEmuladorWinIPC, uKeyDir,
{$ENDIF}
  unettopostypes,
  SysUtils, uconstantes_nettopos;

type
  TSharedMemRec = record
    idTopoLocal: cardinal;
    idNodoLocal: cardinal;
    nombreMaquina: ShortString;

    NextNIDPeticion: integer;

    CntDBG: Integer;

    aplicacionesLocales : TAplicaciones;

    peticiones : TPeticiones;

    nextIdTareaSincrona: Cardinal;
    tareasSincronas: TTareasSincronas;

{$IFDEF HEAPMANAGER}
    heapRec: THeapRec;
    heapBuff: THeapBuffer;
{$ENDIF}
  end;

  PSharedMemRec = ^TSharedMemRec;

(* VARIABLES GLOBALES EN LA DLL POR PROCESO *)
var
  pm: PSharedMemRec; // puntero a la memoria compatida
  idAplicYo: cardinal; // id de la aplicación que está corriendo
{$IFDEF HEAPMANAGER}
  heapManager: THeapManager;
{$ENDIF}

var
  UltimoError_x: integer;
  DlgInterShareMem: TSharedMem;

{*************************************************************** }
// Conecata al share, retorna -1 si hay error,
// 1 si conectó y el Share ya existía y
// 0 si lo tuvo que crear
function ConectarShareMem: integer;
procedure DesconectarShareMem;

(*-------------------------------------------*)
// Agrega una línea al archivo de logs
// Utilizan un semáforo para ordenar el acceso al archivo entre los procesos
procedure dbglog( const s: shortstring ); stdcall;

// agrega una línea al archivo de logs de errores
// Utilizan un semáforo para ordenar el acceso al archivo entre los procesos
procedure logError( const s: shortstring ); stdcall;


(* Ojo, estas funciones son para ser usadas por llamadas que realicen el bloqueo
con el semáforo primero *)

// El resultado es un puntero a la ficha de la aplicación.
// si no encuentra la aplicación retorna NIL
function getAplicById( idAplic: HWND ): PFichaAplicacion;

// El resultado es el handle de la aplicación si la encuentra
// y CERO en caso contrario.
function getAplicIdByName( const nombreAplic: pchar  ): cardinal;

//Retorna el nombre de la aplicación registrada con el id especificado
function getAplicNameById( idAplic: Cardinal ): ShortString;


// El resultado es el puntero a la primer ficha de aplicacion libre
// si no hay más fichas libres retorna NIL
function getPrimerFichaAplicacionLibre: PFichaAplicacion;


// El resultado es un puntero a la ficha de la petición
// si no encuentra la petición retorna NIL
function getPeticionById( idPeticion: Cardinal ): PFichaPeticion;

// El resultado es el puntero a la primer ficha de petición libre
// si no hay más fichas libres retorna NIL
function getPrimerFichaPeticionLibre: PFichaPeticion;

// El resultado es el puntero a la primer ficha de tarea sincrona libre
// si no hay más fichas libres retorna NIL
function getPrimerFichaTSinLibre: PRecFichaTareaSincrona;
function buscarTareaSincro( idTareaSincrona: cardinal): PRecFichaTareaSincrona;

function getMaxSizeBufferChico: cardinal; stdcall;

// Retorna el número de aplicaciones actualemente regisgtradas
// El topo debe llamar esta función para saber la cantidad de aplics
// registradas y pueda crear el espacio de memoria para llamar
// dumpFichasAplics
function GetNAplicsRegistradas: integer; stdcall;

// Esta función copia hasta NFichasACopiar en el área de datos
// apuntada por pdatos. El resultado de la función es el número
// de aplicaciones actualemente registradas.
// El resultado pude diferir del valor devuelto por GetNAplics si
// entre una llamada y otra cambió el número de aplicaciones registradas
function dumpFichasAplics( pdatos: pointer; NFichasAcopiar: integer ): integer; stdcall;

function nombreEvento( idPeticion: cardinal ): string;

(*+doc
Crear un string representando el contenido de una TFichaComunicado para
propósitos de debug y log de errores.
-doc*)
function GenFCStr( pfc: PFichaComunicado; pdatosbuff: PLArrOfBytes ): ShortString;

function nombre_shmPeticion( idPeticion:cardinal ): shortstring;

procedure liberarPeticion( pfp: PFichaPeticion );


implementation

function ConectarShareMem: integer;
var
  pvar, pbase: integer;
  kpos: cardinal;


{$IFDEF BUSCANDO_ERROR_SIZE}
procedure wof( s: string; var x );
begin
  pvar:= integer( addr( x ) );
  kpos:= pvar - pbase;
  writeln( s+' : ', kpos );
end;
{$ENDIF}

begin
writeln( '->uglobsharedmem.ConectarShareMem' );

{$IFDEF BUSCANDO_ERROR_SIZE}
(**** OJO imprimimos offset de las variables y tamaño del share para
chequear errores de tamaño según compilado ***)
new(pm);
pbase:= integer( addr( pm^ ) );
wof( 'idToposLocal', pm^.idTopoLocal );
wof( 'idNodoLocal', pm^.idNodoLocal );
wof( 'nombreMaquina', pm^.nombreMaquina );
wof( 'NextNIDPeticion', pm^.NextNIDPeticion );
wof( 'CntDBG', pm^.CntDBG );
wof( 'aplicacionesLocales', pm^.aplicacionesLocales );
wof( 'peticiones', pm^.peticiones );
wof( 'peticiones->idPeticion', pm^.peticiones[1].idPeticion );
wof( 'peticiones->dtInicio', pm^.peticiones[1].dtInicio );
wof( 'peticiones->dtInicio', pm^.peticiones[1].dtInicio );
wof( 'peticiones->fc', pm^.peticiones[1].fc );
wof( 'peticiones->bufferDatosChico', pm^.peticiones[1].bufferDatosChico );
wof( 'peticiones->kBloqueLongBuffer', pm^.peticiones[1].kBloqueLongBuffer );
wof( 'peticiones[2]->idPeticion', pm^.peticiones[2].idPeticion );
wof( 'nextIdTareaSincrona', pm^.nextIdTareaSincrona );
wof( 'tareasSincronas', pm^.tareasSincronas );
{$IFDEF HEAPMANAGER}
wof( 'heapRec', pm^.heapRec );
wof( 'heapBuff', pm^.heapBuff );
{$ENDIF}
dispose( pm );
{$ENDIF}

writeln( 'SizeOf( TSharedMemRec ): '+ IntToStr( SizeOf( TSharedMemRec ) ) );

{$IFDEF LINUX}
    DlgInterShareMem:= TSharedMem.Create( keyDlginterSharedMem, SizeOf(TSharedMemRec ), 1);
    pm:= DlgInterShareMem.pm;
{$ELSE}
    DlgInterShareMem:= TSharedMem.Create( nom_SharedMem, SizeOf(TSharedMemRec ));
    pm:= DlgInterShareMem.Buffer;
{$ENDIF}
    if pm <> nil then
{$IFDEF LINUX}
      if DlgInterShareMem.YaExistia then
{$ELSE}
      if not DlgInterShareMem.Created then
{$ENDIF}
         result:= 1
      else
         result:= 0
    else
      begin
        raise Exception.Create('ConectarShareMem Fallo, pm=nil');
        result:= -1;
      end;
writeln( 'uglobsharedmem.CnectarSharedMem->' );
writeln( ' RESULT: ', result);
end;

procedure DesconectarShareMem;
begin
   pm:= nil;
   DlgInterShareMem.Free;
end;

function nombre_shmPeticion( idPeticion: cardinal ): shortstring;
begin
  result:= 'nettoposLongBuff'+IntToStr( idPeticion );
end;

procedure liberarPeticion( pfp: PFichaPeticion );
begin
  pfp^.idPeticion:= 0;
end;

function GenFCStr( pfc: PFichaComunicado; pdatosbuff: PLArrOfBytes ): ShortString;
var
  res: ShortString;
  k, n, m: Cardinal;
begin
  if pfc= nil then
  begin
    result:= 'OJO; GenFCStr, pfc= nil';
    exit;
  end;

  with pfc^ do
  begin
    res:= '['+IntToStr( idNodoOrigen )+'.'+IntToStr( idOrigen )+'] -> ['+
        IntToStr( idNodoDestino )+'.'+IntToStr( idDestino )+'],Msg:'+
        IntToStr( codigoMsg ) + ',lParam:'+IntToStr(lParam)+',idTarea:'+intToStr(idTarea )+
        ', nb:'+IntToStr( nBytesDatos );
    if (nBytesDatos > 0 ) and (pdatosbuff <> nil) then
    begin
      if nBytesDatos > 10 then
      begin
        n:= 5;
        m:= 5;
      end
      else
      begin
        n:= nBytesDatos;
        m:= 0;
      end;

      res:= res+', datos(';
      for k:= 0 to n-1 do
        res:= res + IntToStr(pdatosbuff^[k])+',';
      if m > 0  then
      begin
        res:= res+'...';
        for k:= nBytesDatos-m to nBytesDatos-1 do
          res:= res+ IntToStr( pdatosbuff^[k] )+',';
      end;
      res:= res+')';
    end;
  end;
  result:= res;
end;

function nombreEvento( idPeticion: cardinal ): string;
begin
  result:= 'evTopo'+intToStr( idPeticion );
end;

function getMaxSizeBufferChico: cardinal;
begin
  result:= MAX_SIZE_BUFFER_CHICO;
end;

function getAplicById( idAplic: HWND ): PFichaAplicacion;
var
  i: integer;
  res: PFichaAplicacion;
  pAplics: PAplicaciones;
begin
  res:= nil;
  pAplics:= @pm^.aplicacionesLocales;
  for i:= 1 to MAX_N_APLICACIONES do
    if (pAplics^[i].idAplic = idAplic) then
    begin
      res:= @pAplics^[i];
      break;
    end;
  result:= res;
end;

function getAplicIdByName( const nombreAplic: pchar  ): cardinal;
var
  i: Integer;
  pAplics: PAplicaciones;
  res: cardinal;
begin
    pAplics:= @pm^.aplicacionesLocales;
    res:= 0;
    for i:= 1 to MAX_N_APLICACIONES do
      if (pAplics^[i].idAplic <> 0) and (pAplics^[i].nombreAplic = nombreAplic) then
      begin
        res:= pAplics^[i].idAplic;
        break;
      end;
    result:= res;
end;

// Retorna el número de aplicaciones actualemente regisgtradas
// El topo debe llamar esta función para saber la cantidad de aplics
// registradas y pueda crear el espacio de memoria para llamar
// dumpFichasAplics
function GetNAplicsRegistradas: integer; stdcall;
var
  i: Integer;
  pAplics: PAplicaciones;
  cnt: cardinal;
  smf: TMutex;
begin
{$IFDEF LINUX}
  smf:= TMutex.Create( keySmfAplics, 1);
{$ELSE}
  smf:= TMutex.Create(nom_Smf_Aplics);
{$ENDIF}
  if not smf.Get(600) then
  begin
    result:= -1;
    exit;
  end;

  pAplics:= @pm^.aplicacionesLocales;
  cnt:= 0;
  for i:= 1 to MAX_N_APLICACIONES do
    if (pAplics^[i].idAplic <> 0) then
      inc( cnt );
  result:= cnt;
  smf.Release;
  smf.Free;
end;

// Esta función copia hasta NFichasACopiar en el área de datos
// apuntada por pdatos. El resultado de la función es el número
// de aplicaciones actualemente registradas
// El resultado pude diferir del valor devuelto por GetNAplics si
// entre una llamada y otra cambió el número de aplicaciones registradas
function dumpFichasAplics( pdatos: pointer; NFichasAcopiar: integer ): integer; stdcall;
var
  i: Integer;
  pAplics: PAplicaciones;
  cnt: Integer;
  smf: TMutex;
begin
{$IFDEF LINUX}
  smf:= TMutex.Create( keySmfAplics, 1);
{$ELSE}
  smf:= TMutex.Create(nom_Smf_Aplics);
{$ENDIF}
  if not smf.Get(600) then
  begin
    result:= -1;
    exit;
  end;
  pAplics:= @pm^.aplicacionesLocales;
  cnt:= 0;
  for i:= 1 to MAX_N_APLICACIONES do
  begin
    if (pAplics^[i].idAplic <> 0) then
    begin
      inc( cnt );
      if cnt <= NFichasACopiar then
        pAplicaciones(pdatos)^[cnt]:= pAplics^[i];
    end;
  end;
  result:= cnt;
  smf.Release;
  smf.Free;
end;

function getPeticionById( idPeticion: Cardinal ): PFichaPeticion;
var
  i: integer;
  res: PFichaPeticion;
  pPetis: PPeticiones;
begin
  res:= nil;
  pPetis:= @pm^.peticiones;
  for i:= 1 to MAX_N_PETICIONES do
    if (pPetis^[i].idPeticion = idPeticion) then
    begin
      res:= @pPetis^[i];
      break;
    end;
  result:= res;
end;

function getPrimerFichaAplicacionLibre: PFichaAplicacion;
var
  i: integer;
  res: PFichaAplicacion;
  pAplics: PAplicaciones;
begin
  res:= nil;
  pAplics:= @pm^.AplicacionesLocales;
  for i:= 1 to MAX_N_APLICACIONES do
    if (pAplics^[i].idAplic = 0) then
    begin
      res:= @pAplics^[i];
      break;
    end;
  result:= res;
end;


(* Recorre las peticiones en busca de aquellas que tengan un TimeOut > 0
y que teniendo idPeticion > 0 estén vencidas. Libera las que encuentre
y retorna un puntero a una liberada para que pueda ser usada *)
function LiberarVencidasNoLiberadas( pPetis: PPeticiones ): PFichaPeticion;
var
  pres: PFichaPeticion;
  dtAhora: TDateTime;
  i: integer;
begin
  pres:= nil;
  dtAhora:= now;
  for i:= 1 to MAX_N_PETICIONES do
    if (pPetis^[i].idPeticion<> 0) then
      if dtAhora > pPetis^[i].dtVencimiento then
      begin
        pres:= @pPetis^[i];
        liberarPeticion( pres );
        logerror('LiberandoFichaPeticionVencida: '+IntToStr( i ) );
      end;

  result:= pres;
end;

function getPrimerFichaPeticionLibre: PFichaPeticion;
var
  i: integer;
  res: PFichaPeticion;
  pPetis: PPeticiones;
{$IFDEF DBGLOG}
  ahora: Double;
  s: string;
{$ENDIF}
begin
  res:= nil;
  pPetis:= @pm^.peticiones;

{$IFDEF DBGLOG}
  ahora:= Now;
  s:= '';
  for i:= 1 to MAX_N_PETICIONES do
    if (pPetis^[i].idPeticion<> 0) then
      begin
        if ( ahora > pPetis^[i].dtVencimiento )  then
          s:= s+'2'
        else
        s:= s+'1';
      end
    else
      s:= s+'0';
{$ENDIF}

  for i:= 1 to MAX_N_PETICIONES do
    if (pPetis^[i].idPeticion = 0)  then
    begin
      res:= @pPetis^[i];
{$IFDEF DBGLOG}
      s:= s+', res:'+IntToStr( i );
{$ENDIF}
      break;
    end;

  if res = nil then
    res:= LiberarVencidasNoLiberadas( pPetis );

{$IFDEF DBGLOG}
  dbglog( s );
{$ENDIF}
  result:= res;
end;

function getPrimerFichaTSinLibre: PRecFichaTareaSincrona;
var
  i: Integer;
  res: PRecFichaTareaSincrona;
begin
  res:= NIL;
  for i:= 1 to MAX_N_TAREAS_SINCRONAS do
    if pm^.tareasSincronas[i].idPeticion = 0 then
    begin
      res:= @pm^.tareasSincronas[i];
      break;
    end;
  result:= res;
end;

function buscarTareaSincro( idTareaSincrona: cardinal): PRecFichaTareaSincrona;
var
  i: Integer;
  res: PRecFichaTareaSincrona;
begin
  res:= NIL;
  for i:= 1 to MAX_N_TAREAS_SINCRONAS do
    if (pm^.tareasSincronas[i].idPeticion <> 0) and
       (pm^.tareasSincronas[i].idTareaSincrona = idTareaSincrona) then
    begin
      res:= @pm^.tareasSincronas[i];
      break;
    end;
  result:= res;
end;

{*************************************************************** }
procedure logError( const s: shortstring );
var
	 f: TextFile;
	 mf: TMutex;
   serr: string;
begin
{$IFDEF LINUX}
  mf:= TMutex.Create( keySmfErrLog, 1);
{$ELSE}
  mf:= TMutex.Create(nom_Smf_ErrLog);
{$ENDIF}
	if mf.get( 1000 ) then
  begin
  	try
	    assign( f, ARCHI_ERRLOG);
	    {$I-}
  	  append(f);
	    {$I+}
		  if ioresult <> 0 then
		    rewrite(f);
      serr:=DateTimeToStr(Now)+': '+GetAplicNameById( idAplicYo )+': '+s;
	    writeln(f, serr );
	    close(f);
      writeln('****ERROR**** ', serr);
{$IFDEF DBGLOG}
      dbglog( '****ERROR****'+serr );
{$ENDIF}
	  finally
	    mf.Release;
      mf.Free;
	  end;
  end
  else
  begin
    mf.Free;
  end;
end;

{$IFDEF DBGLOG}
procedure dbglog( const s: shortstring );
var
  f: TextFile;
	mf: TMutex;
begin
{$IFDEF LINUX}
	mf:= TMutex.Create( keySmfDbgLog, 1);
{$ELSE}
  mf:= TMutex.Create(nom_Smf_DbgLog);
{$ENDIF}
	if mf.get( 1000 ) then
  begin
  	try
	    assign( f, ARCHI_DBGLOG);
	    {$I-}
  	  append(f);
	    {$I+}

		  if ioresult <> 0 then
		    rewrite(f);
  	  writeln(f, DateTimeToStr(Now):12, GetAplicNameById( idAplicYo ),': ',  s );
	    close(f);
  	finally
      mf.Release;
      mf.Free;
  	end;
  end
  else
  begin
    mf.Free;
  end;
end;
{$ELSE}
procedure dbglog( const s: shortstring );
begin
end;
{$ENDIF}

function getAplicNameById( idAplic: Cardinal ): ShortString;
var
  pfa: PFichaAplicacion;
begin
  pfa:= getAplicById( idAplic );
  if pfa<> nil then
    result:= pfa^.nombreAplic
  else
    result:= '';
end;

end.
