unit Ficheros;
(*
Asignatura: Ficheros y Base de Datos
Curso: 2005-06
1er cuatrimetre
Práctica 1 - Ficheros
(c) 2005 Juan I. Perea - jiperea@inf.uc3m.es
Este módulo es para soporte de la práctica 1 (Ficheros).
No puede ser modificado por los alumnos bajo ningún concepto.
Es posible que se suministren pequeñas modificaciones durante el desarrollo de
la práctica.
Histórico de versiones
01.00 | 30-09-2005 | Versión inicial
01.01 | 03-10-2005 | Modificaciones reunión de profesores
01.02 | 14-10-2005 | Separación OO / no OO
*)
// ***************************************************************************
interface
uses SysUtils;
// ***************************************************************************
// *** TamanoBloque ***
// Valor por defecto para el tamaño del bloque.
const TamanoBloque = 1024;
// ***************************************************************************
// *** TBloque ***
// Estructura formada por 'TamanoBloque' bytes que se lee y escribe en un
// fichero.
// - Mostrar: Muestra en consola el contenido del bloque.
// - RellenarCero: Pone a 0 todos los bytes del bloque.
// - RellenarRandom: Rellena el bloque con valores aleatorios.
type TBloque = object
public
data : array[0..TamanoBloque-1] of byte;
public
procedure Mostrar ( );
procedure RellenarCero ( );
procedure RellenarRandom ( );
end;
function Bloque_GetByte ( var bloque : TBloque; i : Integer ) : Byte;
procedure Bloque_SetByte ( var bloque : TBloque; i : Integer; valor : Byte );
procedure Bloque_Mostrar ( var bloque : TBloque );
procedure Bloque_RellenarCero ( var bloque : TBloque );
procedure Bloque_RellenarRandom ( var bloque : TBloque );
// ***************************************************************************
// *** TFichero ***
// Clase abstracta para soporte de los demás tipos de ficheros.
// No podrá ser usada directamente.
// Encapsula la funcionalidad de ficheros de Delphi.
// Tiene funcionalidades añadidas a la de Delphi (p.ej. estadísticas).
// Las demás clases expondrán sólo cierto métodos disponible en esta clase,
// proporcionando funcionalidades reducidas que ilustren cada tipo de fichero.
// Las funciones de lectura de bloque exigen que el bloque exista.
// Las funciones de escritura extienden el tamaño del fichero si es necesario.
// Sus miembros y métodos no están visibles, a excepción de:
// - MostrarEstadisticas: Muestra en consola la estadísticas del fichero.
type TFichero = object
protected
// m_file : File of TBloque;
m_file : File;
m_error : LongInt;
m_contDesplazar : LongInt;
m_contLeer : LongInt;
m_contEscribir : LongInt;
m_contError : LongInt;
protected
procedure Abrir ( nombre : String );
procedure Cerrar ( );
private
procedure TratarIOResult ( );
procedure TratarInOutError ( func : String; e : EInOutError );
protected
procedure IrAPosicion ( posicion : LongInt );
function PosicionActual ( ) : LongInt;
function FinDeFichero ( ) : Boolean;
function NumeroDeBloques ( ) : LongInt;
procedure LeerBloque ( var bloque : TBloque );
procedure EscribirBloque ( const bloque : TBloque );
public
procedure MostrarEstadisticas ( );
end;
// ***************************************************************************
// *** TFicheroSerial ***
// Clase que implementa la funcionalidad reducida de un fichero serial.
// - Abrir: Abre el fichero en modo lectura-escritura.
// - Cerrar: Cierra el fichero.
// - IrAPosicionInicial: Mueve el puntero del fichero al comienzo (reset).
// - LeerBloque: Lee el bloque situado en el puntero.
// - EscribirBloque: Escribe un bloque sobre la posición del puntero.
// Además, hereda de TFichero:
// - MostrarEstadisticas: Muestra en consola la estadísticas del fichero.
type TFicheroSerial= object (TFichero)
public
procedure Abrir ( nombre : String );
procedure Cerrar ( );
public
procedure IrAPosicionInicial ( );
procedure LeerBloque ( var bloque : TBloque );
procedure EscribirBloque ( const bloque : TBloque );
end;
procedure FicheroSerial_Abrir ( var fichero : TFicheroSerial; nombre : String );
procedure FicheroSerial_Cerrar ( var fichero : TFicheroSerial );
procedure FicheroSerial_IrAPosicionInicial ( var fichero : TFicheroSerial );
procedure FicheroSerial_LeerBloque ( var fichero : TFicheroSerial; var bloque : TBloque );
procedure FicheroSerial_EscribirBloque ( var fichero : TFicheroSerial; const bloque : TBloque );
procedure FicheroSerial_MostrarEstadisticas ( var fichero : TFicheroSerial );
// ***************************************************************************
// *** TFicheroDireccionado ***
// Clase que implementa la funcionalidad reducida de un fichero direccionado.
// - Abrir: Abre el fichero en modo lectura-escritura.
// - Cerrar: Cierra el fichero.
// - LeerBloque: Lee el bloque situado en una posición dada.
// - EscribirBloque: Escribe el bloque obre una posición dada.
// Además, hereda de TFichero:
// - MostrarEstadisticas: Muestra en consola la estadísticas del fichero.
type TFicheroDireccionado = object (TFichero)
public
procedure Abrir ( nombre : String );
procedure Cerrar ( );
public
procedure LeerBloque ( posicion : LongInt; var bloque : TBloque );
procedure EscribirBloque ( posicion : LongInt; const bloque : TBloque );
end;
procedure FicheroDireccionado_Abrir ( var fichero : TFicheroDireccionado; nombre : String );
procedure FicheroDireccionado_Cerrar ( var fichero : TFicheroDireccionado );
procedure FicheroDireccionado_LeerBloque ( var fichero : TFicheroDireccionado;
posicion : LongInt; var bloque : TBloque );
procedure FicheroDireccionado_EscribirBloque ( var fichero : TFicheroDireccionado;
posicion : LongInt; const bloque : TBloque );
procedure FicheroDireccionado_MostrarEstadisticas ( var fichero : TFicheroDireccionado );
// ***************************************************************************
// *** PropagarExcepciones ***
// Por defecto, no se propagan excepciones.
// Aquellos grupos que deseen recibir la excepciones en su código podrán poner
// esta variable a True.
// Esto debe hacerse asignándola desde el programa, nunca modificando aquí.
const PropagarExcepciones : Boolean = False;
// ***************************************************************************
// Funciones para soporte de este módulo.
function Hex ( n : LongInt; nc : Integer=0 ) : String;
function DescripcionIOResult ( error : Integer ) : String;
function DescripcionFileMode ( mode : Word ) : String;
// ***************************************************************************
implementation
{$IOCHECKS OFF} // Tratamiento con función IOResult
// *NO* {$IOCHECKS ON} // Tratamiento con excepciones EInOutError
// ***************************************************************************
// *** TBloque ***
procedure TBloque.Mostrar ( );
var i, j : Integer;
var b : Byte;
begin
for i:=0 to (TamanoBloque div 16)-1 do begin
Write(Hex(i*16,4),' ');
Write('| ');
for j:=0 to 16 do begin
b:=data[i*16+j];
Write(Hex(b,2),' ');
end;
Write('| ');
for j:=0 to 16 do begin
b:=data[i*16+j];
if b>=Ord(' ')
then Write(Chr(b))
else Write(' ');
end;
WriteLn;
end;
end;
procedure TBloque.RellenarCero ( );
var i : LongInt;
begin
for i:=0 to TamanoBloque-1 do begin
data[i]:=0;
end;
end;
procedure TBloque.RellenarRandom ( );
var i : LongInt;
begin
for i:=0 to TamanoBloque-1 do begin
data[i]:=Random(256);
end;
end;
function Bloque_GetByte ( var bloque : TBloque; i : Integer ) : Byte;
begin
Result:=bloque.data[i];
end;
procedure Bloque_SetByte ( var bloque : TBloque; i : Integer; valor : Byte );
begin
bloque.data[i]:=valor;
end;
procedure Bloque_Mostrar ( var bloque : TBloque );
begin
bloque.Mostrar;
end;
procedure Bloque_RellenarCero ( var bloque : TBloque );
begin
bloque.RellenarCero;
end;
procedure Bloque_RellenarRandom ( var bloque : TBloque );
begin
bloque.RellenarRandom;
end;
// ***************************************************************************
// *** TFichero ***
procedure TFichero.Abrir ( nombre : String );
begin
m_error:=0;
m_contDesplazar:=0;
m_contLeer:=0;
m_contEscribir:=0;
m_contError:=0;
try
// FileMode:=fmCreate+fmShareCompat;
FileMode:=fmOpenReadWrite; // +fmShareCompat;
AssignFile(m_file,nombre);
if FileExists(nombre)
then Reset(m_file,TamanoBloque)
else Rewrite(m_file,TamanoBloque);
TratarIOResult();
except
on e : EInOutError do begin
TratarInOutError('Abrir',e);
raise;
end;
end;
end;
procedure TFichero.Cerrar ( );
begin
try
CloseFile(m_file);
TratarIOResult();
except
on e : EInOutError do begin
TratarInOutError('Cerrar',e);
raise;
end;
end;
end;
//procedure TFichero.TratarIOResult ( );
// var e : EInOutError;
// error : Integer;
//begin
// error:=IOResult();
// if error<>0 then begin
// e:=EInOutError.Create(DescripcionIOResult(error));
// e.ErrorCode:=error;
// raise e;
// end;
//end;
procedure TFichero.TratarIOResult ( );
begin
m_error:=IOResult();
end;
procedure TFichero.TratarInOutError ( func : String; e : EInOutError );
begin
m_error:=e.ErrorCode;
// if m_error<>0 then begin
Inc(m_contError);
WriteLn;
WriteLn('*****************************************************************************');
WriteLn(' Error en ',func,': Error=',m_error,' ',DescripcionIOResult(m_error));
WriteLn('*****************************************************************************');
// end;
end;
procedure TFichero.IrAPosicion ( posicion : LongInt );
var posicionAnterior : LongInt;
begin
try
posicionAnterior:=PosicionActual();
Seek(m_file,posicion);
TratarIOResult();
Inc(m_contDesplazar,Abs(posicionAnterior-posicion));
except
on e : EInOutError do begin
TratarInOutError('IrAPosicion',e);
raise;
end;
end;
end;
function TFichero.PosicionActual ( ) : LongInt;
begin
try
Result:=FilePos(m_file);
TratarIOResult();
except
on e : EInOutError do begin
TratarInOutError('PosicionActual',e);
raise;
end;
end;
end;
function TFichero.FinDeFichero ( ) : Boolean;
begin
try
Result:=Eof(m_file);
TratarIOResult();
except
on e : EInOutError do begin
TratarInOutError('FinDeFichero',e);
raise;
end;
end;
end;
function TFichero.NumeroDeBloques ( ) : LongInt;
begin
try
Result:=FileSize(m_file);
TratarIOResult();
except
on e : EInOutError do begin
TratarInOutError('NumeroDeBloques',e);
raise;
end;
end;
end;
procedure TFichero.LeerBloque ( var bloque : TBloque );
begin
try
BlockRead(m_file,bloque,1);
TratarIOResult();
Inc(m_contLeer);
except
on e : EInOutError do begin
TratarInOutError('LeerBloque',e);
raise;
end;
end;
end;
procedure TFichero.EscribirBloque ( const bloque : TBloque );
begin
try
BlockWrite(m_file,bloque,1);
TratarIOResult();
Inc(m_contEscribir);
except
on e : EInOutError do begin
TratarInOutError('EscribirBloque',e);
raise;
end;
end;
end;
procedure TFichero.MostrarEstadisticas ( );
begin
WriteLn;
WriteLn('*****************************************************************************');
WriteLn(' Nombre : ',TFileRec(m_file).Name);
WriteLn(' Modo : ',DescripcionFileMode(TFileRec(m_file).Mode));
WriteLn(' N. bloques : ',NumeroDeBloques():4);
WriteLn('Estadisticas del fichero');
WriteLn(' N. desplazam. : ',m_contDesplazar:4);
WriteLn(' N. lecturas : ',m_contLeer:4);
WriteLn(' N. escrituras : ',m_contEscribir:4);
WriteLn(' N. errores : ',m_contError:4);
WriteLn('*****************************************************************************');
WriteLn;
end;
// ***************************************************************************
// *** TFicheroSerial ***
procedure TFicheroSerial.Abrir ( nombre : String );
begin
try
inherited Abrir(nombre);
except
if PropagarExcepciones then raise;
end;
end;
procedure TFicheroSerial.Cerrar ( );
begin
try
inherited Cerrar();
except
if PropagarExcepciones then raise;
end;
end;
procedure TFicheroSerial.IrAPosicionInicial ( );
begin
try
inherited IrAPosicion(0);
except
if PropagarExcepciones then raise;
end;
end;
procedure TFicheroSerial.LeerBloque ( var bloque : TBloque );
begin
try
// bloque.RellenarRandom();
inherited LeerBloque(bloque);
except
if PropagarExcepciones then raise;
end;
end;
procedure TFicheroSerial.EscribirBloque ( const bloque : TBloque );
begin
try
inherited EscribirBloque(bloque);
except
if PropagarExcepciones then raise;
end;
end;
procedure FicheroSerial_Abrir ( var fichero : TFicheroSerial; nombre : String );
begin
fichero.Abrir(nombre);
end;
procedure FicheroSerial_Cerrar ( var fichero : TFicheroSerial );
begin
fichero.Cerrar();
end;
procedure FicheroSerial_IrAPosicionInicial ( var fichero : TFicheroSerial );
begin
fichero.IrAPosicionInicial();
end;
procedure FicheroSerial_LeerBloque ( var fichero : TFicheroSerial; var bloque : TBloque );
begin
fichero.LeerBloque(bloque);
end;
procedure FicheroSerial_EscribirBloque ( var fichero : TFicheroSerial; const bloque : TBloque );
begin
fichero.EscribirBloque(bloque);
end;
procedure FicheroSerial_MostrarEstadisticas ( var fichero : TFicheroSerial );
begin
end;
(*
// ***************************************************************************
// *** TFicheroSecuencial ***
procedure TFicheroSecuencial.MoverPosicion ( posicionRelativa : Longint );
begin
try
IrAPosicion(PosicionActual()+posicionRelativa);
except
end;
end;
*)
// ***************************************************************************
// ***************************************************************************
// *** TFicheroDireccionado ***
procedure TFicheroDireccionado.Abrir ( nombre : String );
begin
try
inherited Abrir(nombre);
except
if PropagarExcepciones then raise;
end;
end;
procedure TFicheroDireccionado.Cerrar ( );
begin
try
inherited Cerrar();
except
if PropagarExcepciones then raise;
end;
end;
procedure TFicheroDireccionado.LeerBloque ( posicion : LongInt; var bloque : TBloque );
begin
try
// bloque.RellenarRandom();
IrAPosicion(posicion);
inherited LeerBloque(bloque);
except
if PropagarExcepciones then raise;
end;
end;
procedure TFicheroDireccionado.EscribirBloque ( posicion : LongInt; const bloque : TBloque );
begin
try
IrAPosicion(posicion);
inherited EscribirBloque(bloque);
except
if PropagarExcepciones then raise;
end;
end;
procedure FicheroDireccionado_Abrir ( var fichero : TFicheroDireccionado; nombre : String );
begin
fichero.Abrir(nombre);
end;
procedure FicheroDireccionado_Cerrar ( var fichero : TFicheroDireccionado );
begin
fichero.Cerrar();
end;
procedure FicheroDireccionado_LeerBloque ( var fichero : TFicheroDireccionado;
posicion : LongInt; var bloque : TBloque );
begin
fichero.LeerBloque(posicion,bloque);
end;
procedure FicheroDireccionado_EscribirBloque ( var fichero : TFicheroDireccionado;
posicion : LongInt; const bloque : TBloque );
begin
fichero.EscribirBloque(posicion,bloque);
end;
procedure FicheroDireccionado_MostrarEstadisticas ( var fichero : TFicheroDireccionado );
begin
fichero.MostrarEstadisticas();
end;
// ***************************************************************************
function Hex ( n : LongInt; nc : Integer=0 ) : String;
var i : LongInt;
var c : Byte;
begin
// Result:=StringOfChar('0',nc);
Result:='';
i:=1;
while (i<=nc) or (n>0) do begin
c:=n mod 16;
n:=n div 16;
if c<10
then Result:=Chr(Ord('0')+c)+Result
else Result:=Chr(Ord('a')+c-10)+Result;
Inc(i);
end;
end;
function DescripcionIOResult ( error : Integer ) : String;
begin
case error of
100 : Result:='End of File';
101 : Result:='Disk Full';
102 : Result:='File variable not assigned';
103 : Result:='File not open';
104 : Result:='File not open for input';
105 : Result:='File not open for output';
106 : Result:='Error in formatted input';
107 : Result:='File already open';
end;
end;
function DescripcionFileMode ( mode : Word ) : String;
begin
case mode of
fmClosed : Result:='Cerrado';
fmInput : Result:='Entrada';
fmOutput : Result:='Salida';
fmInOut : Result:='Entrada/Salida';
end;
end;
// ***************************************************************************
end.