Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement