Global

unit u_Global;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Dialogs, Math, utiles;

const
  PATH_FICHEROS    = 'ficheros/';
  FICHERO_PRODUCTOS = PATH_FICHEROS + 'productos.dat';
  FICHERO_AUXILIAR_PRODUCTOS = PATH_FICHEROS +'auxiliar.dat';
  NO_ENCONTRADO = -1;


type
  Cadena70 = String[70]; // Tipo Cadena de 70 caracteres
  Cadena20 = String[20]; // Tipo Cadena de 20 caracteres
  TProducto = record  // Tipo Registro de producto
     codigo : integer;
     descripcion : Cadena20;
     precio : real;
     stock : integer;
  end;

  TFicheroProductos = file of TProducto;     // Tipo fichero de productos

var
  P: TProducto; //Registro de un producto
  f: TFicheroProductos;  //Fichero de productos
  n: Integer;   //Cantidad inicial de productos

procedure altaProducto(var f:TFicheroProductos; producto:TProducto);
procedure crearFichero(var f:TFicheroProductos);
function buscarProducto(var f:TFicheroProductos;codigo:longInt):longInt;
procedure modificarProducto(var f:TFicheroProductos;producto:TProducto;posicion:longInt);
procedure bajaProducto(var f:TFicheroProductos; K:String);

implementation

function buscarProducto(var f:TFicheroProductos;codigo:longInt):longInt;
var
  i,posicion : longInt;
  producto : TProducto;
begin
 try
   reset(f);
   posicion := NO_ENCONTRADO;  //NO_ENCONTRADO es una constante = -1
   i := 0;

   while not eof(f) and (posicion = NO_ENCONTRADO) do
       begin
         read(f, producto);
         if codigo = producto.codigo then
             posicion:= i
         else
            i := i + 1;
       end;
    closeFile(f);
 finally
   buscarProducto:=posicion;
 end;
end;

procedure leerFichero(var f:TFicheroProductos);
var
  producto : TProducto;
begin
 try
   reset(f);

   while not eof(f) do
       begin
         read(f, producto);
         //procear producto: por ejemplo cargar en un StringGrid
       end;
    closeFile(f);
 except
   on E: EInOutError do
   ShowMessage('NO se pudo abrir el fichero: '+E.ClassName+'/'+E.Message);
 end;
end;


procedure modificarProducto(var f:TFicheroProductos;producto:TProducto;posicion:longInt);
begin
 try
   reset(f);
   seek(f,posicion);
   write(f,producto);
 finally
   closeFile(f);
 end;
end;

procedure altaProducto(var f:TFicheroProductos; producto:TProducto);
begin
 try
   reset(f);
   seek(f,fileSize(f));
   write(f,producto);
 finally
   closeFile(f)
 end;
end;

procedure bajaProducto(var f:TFicheroProductos; K:String);
var
  R: TProducto;
  existe: boolean;
  ok,codigo: integer;
  aux: TFicheroProductos;
begin
  assignFile(aux,FICHERO_AUXILIAR_PRODUCTOS);
  try
    reset(f);
    rewrite(aux);
    val(K, codigo, ok);
    existe := false;
    while not eof(f) do
     begin
      read(f, R);
      if(R.Codigo = codigo) then
        existe := true
      else
        write(aux, R);
     end;
    closeFile(f);
    closeFile(aux);
     if(existe) then
       begin
         erase(f);
         rename(aux, FICHERO_PRODUCTOS);
       end
     else
       begin
         ShowMessage('El codigo No existe...');
         erase(aux);
       end;
  except
    on E: EInOutError do
      ShowMessage('File handling error occurred. Details: '+E.ClassName+'/'+E.Message);
  end;
end;

procedure crearFichero(var f:TFicheroProductos);
var
  P : TProducto;
  i : integer;
begin
  assignFile(f,FICHERO_PRODUCTOS);
  try
    reset(f);
  except
    rewrite(f);
    randomize;
    for i := 1 to n do
      begin
        P.codigo := i;
        P.descripcion := 'Producto ' + inttostr(i);
        P.precio := random*1000;
        P.stock := randomRange(100,999);
        write(f,P);
      end;
  end;
    closeFile(f);
end;

initialization
  n := 10;   //Cantidad de productos inicial
end.