program La_Flipe;
(*
Asignatura: Ficheros y Base de Datos
Curso: 2005-06
1er cuatrimetre
Práctica 1 - Ficheros
Alumnos:
{100033768} {Grupo 5 } {M} {Vega Caridad}, {Richard}
{100033426} {Grupo 5 } {M} {Cristina Fernandez}, {Roberto}
{100029067} {Grupo 5 } {M} {Ruiz Mulas}, {Daniel}
*)
{$APPTYPE CONSOLE}
uses SysUtils, Ficheros;
TYPE
tDireccion = RECORD
Tipo:string; {incluye tipo de via}
Nombre:string;
Portal:string;
CP:string;
Localidad:string;
end;
tPublicacion = RECORD
Nombre:string;
Numero:string;
Fecha:string;
end;
tArt = RECORD
Titulo:string;
Palabras:string;
DatosPublicacion:tPublicacion;
end;
tArticulo = array [1..21] of tArt;
tCorreo = RECORD
Nickname:string;
Dominio:string;
End;
tRegistro = RECORD
Nombre:string;
Apellido1:string;
Apellido2:string;
DNI:string;
Sexo:string;
Correo:tCorreo;
Telefono1:string;
Telefono2:string;
URL:string;
Direccion:tDireccion;
Articulo:tArticulo;
end;
VAR
c1024:integer; {contador del bloque lectura}
c1024_E: integer; {contador del bloque escritura}
registroLogico:tRegistro ;
bloque,bloque_E: TBloque ;
fichero,fichero_E: TFicheroSerial;
ficheroTitulo, ficheroApellido: TFicheroDireccionado;
control:boolean;
totalCaracteres :integer ;
enumerado:array[0..20000] of string; {Contiene los apellido y los nombres}
colisiones:array[0..499] of integer;
ficheroD:TFicheroDireccionado;
desbordados: integer;
(*
Este fichero fuente es un esqueleto para la práctica, y podrá ser modificado
libremente por los alumnos.
Se suministran dos funciones de prueba:
- Test_FicheroDireccionado
- Test_FicheroSerial
El programa principal simplemente llama a estas funciones, englobéndolas en
un tratamiento de excepciones, y espera a que pulsemos la tecla ENTER.
*)
{procedure Test_FicheroDireccionado ( nombreFichero : String );
var fichero : TFicheroDireccionado;
var bloque : TBloque;
begin
fichero.Abrir(nombreFichero);
bloque.RellenarCero();
fichero.EscribirBloque(0,bloque);
fichero.EscribirBloque(3,bloque); // no devuelve error
bloque.RellenarRandom();
fichero.LeerBloque(1,bloque);
bloque.Mostrar();
// Descomentar estas líneas para obtener error
// bloque.RellenarRandom();
// fichero.LeerBloque(5,bloque); // sí devuelve error
// bloque.Mostrar();
fichero.MostrarEstadisticas();
fichero.Cerrar();
end;
procedure Test_FicheroSerial ( nombreFichero : String );
var fichero : TFicheroSerial;
var bloque : TBloque;
begin
fichero.Abrir(nombreFichero);
bloque.RellenarCero();
fichero.EscribirBloque(bloque);
fichero.IrAPosicionInicial();
bloque.RellenarRandom();
fichero.LeerBloque(bloque);
fichero.MostrarEstadisticas();
fichero.Cerrar();
end;}
FUNCTION leerCaracterD:char;
BEGIN
IF c1024_E>=1024 THEN
BEGIN
c1024_E:=0;
fichero.leerbloque(bloque_E);
End;
leerCaracterD:=chr(bloque_E.data[c1024_E]);
inc(c1024_E);
End;
Procedure leerCaracterI(fich: TFicheroDireccionado; var devol : char; var ent: integer );
BEGIN
IF c1024_E>=1023 THEN
BEGIN
c1024_E:=2;
inc (ent);
fich.leerbloque(ent ,bloque_E);
End;
devol :=chr(bloque_E.data[c1024_E]);
inc(c1024_E);
End;
FUNCTION leerCaracter:char;
BEGIN
IF c1024>=1024 THEN
BEGIN
c1024:=0;
fichero.leerbloque(bloque);
End;
leerCaracter:=chr(bloque.data[c1024]);
inc(c1024);
End;
PROCEDURE escribirCaracter ( ch : char );
BEGIN
IF c1024_E >= 1024 THEN
BEGIN
c1024_E:=0;
fichero_E.escribirbloque(bloque_E);
End;
bloque_E.data[c1024_E] := ord(ch);
inc(c1024_E);
End;
PROCEDURE escribirTamanyo(entrada:string);
BEGIN
bloque_E.data[0]:=ord(entrada[1]);
bloque_E.data[1]:=ord(entrada[2]);
End;
PROCEDURE escribirDesbordado(entrada:string);
BEGIN
bloque_E.data[2]:=ord(entrada[1]);
End;
PROCEDURE QuitarEspacios(entrada:string; VAR salida:string);
VAR indice,x,y:integer;
BEGIN
salida:='';
x:=1;
WHILE (entrada[x]=' ') AND (x<=length(entrada)) DO
inc(x);
IF x>length(entrada) THEN salida:=''
else
BEGIN
y:=length(entrada);
WHILE entrada[y]=' ' DO
dec(y);
FOR indice:=x to y DO
salida:=salida+entrada[indice];
End;
End;
PROCEDURE limpiarRegLogico;
VAR x:byte;
BEGIN
registroLogico.Nombre:='';
registroLogico.Apellido1:='';
registroLogico.Apellido2:='';
registroLogico.DNI:='';
registroLogico.Sexo:='';
registroLogico.Correo.Nickname:='';
registroLogico.Correo.Dominio:='';
registroLogico.Telefono1:='';
registroLogico.Telefono2:='';
registroLogico.URL:='';
registroLogico.Direccion.Tipo := '';
registroLogico.Direccion.Nombre :='';
registroLogico.Direccion.Portal := '';
registroLogico.Direccion.CP:='';
registroLogico.Direccion.Localidad:='';
FOR x:=1 to 20 DO
BEGIN
registroLogico.Articulo[x].Titulo:='';
registroLogico.Articulo[x].Palabras:='';
registroLogico.Articulo[x].datosPublicacion.Nombre:='';
registroLogico.Articulo[x].datosPublicacion.Numero:='';
registroLogico.Articulo[x].datosPublicacion.Fecha:='';
End; {FOR}
control := true;
End; {limpiarRegLogico}
FUNCTION potencia(base:longint; exp:integer):longint;
BEGIN
IF exp=0 THEN
potencia:=1
else
potencia:=base*potencia(base,exp-1);
End;
PROCEDURE descodificarNumero(entrada:string; VAR salida:longint);
VAR num,exp,i:integer;
sumando,pot:longint;
BEGIN
salida:=0;
pot:=0;
exp:=0;
FOR i:=1 to length(entrada) DO
BEGIN
num:=ord(entrada[i]);
sumando:=num*potencia(256,exp);
pot:=pot+sumando;
inc(exp);
End;
salida:=pot;
End;
FUNCTION descodificarLetra(entrada:longint):char;
VAR modulo:integer;
aux:char;
BEGIN
modulo:=entrada mod 23;
CASE modulo OF
0:aux:='T';
1:aux:='R';
2:aux:='W';
3:aux:='A';
4:aux:='G';
5:aux:='M';
6:aux:='Y';
7:aux:='F';
8:aux:='P';
9:aux:='D';
10:aux:='X';
11:aux:='B';
12:aux:='N';
13:aux:='J';
14:aux:='Z';
15:aux:='S';
16:aux:='Q';
17:aux:='V';
18:aux:='H';
19:aux:='L';
20:aux:='C';
21:aux:='K';
else
aux:='E';
End;
descodificarLetra:=aux;
End;
PROCEDURE descodificarDNI(entrada:string; VAR salida:string);
VAR DNI:string;
letra:char;
aux:longint;
BEGIN
descodificarNumero(entrada,aux);
letra:=descodificarLetra(aux);
str(aux,DNI);
salida:=DNI+letra;
End;
PROCEDURE descodificarPortal(entrada:string; VAR salida:string);
VAR aux:longint;
BEGIN
descodificarNumero(entrada,aux);
str(aux,salida);
End;
PROCEDURE descodificarApellidos(entrada:string; VAR salida:string);
VAR aux:longint;
// indice,error:integer;
BEGIN
descodificarNumero(entrada,aux);
//val(aux,indice,error);
salida:=enumerado[aux];
End;
PROCEDURE descodificarNombre(entrada:string; VAR salida:string);
VAR aux:longint;
BEGIN
descodificarNumero(entrada,aux);
salida:=enumerado[aux];
End;
PROCEDURE descodificarCP(entrada:string; VAR salida:string);
VAR aux:longint;
BEGIN
descodificarNumero(entrada,aux);
str(aux,salida);
End;
PROCEDURE descodificarTelefono(entrada:string; VAR salida:string);
VAR aux:longint;
BEGIN
descodificarNumero(entrada,aux);
str(aux,salida);
End;
PROCEDURE descodificarPalabras(entrada:string; VAR salida:string);
VAR aux:longint;
BEGIN
descodificarNumero(entrada,aux);
str(aux,salida);
End;
PROCEDURE descodificarNumPubli(entrada:string; VAR salida:string);
VAR aux:longint;
BEGIN
descodificarNumero(entrada,aux);
str(aux,salida);
End;
PROCEDURE codificarNumero(longitud:integer; entrada:string; VAR aux:string);
VAR error,x,auxi:integer;
salida:longint;
resto:byte;
caracter:char;
BEGIN
val(entrada,salida,error);
resto:=0;
IF error=0 THEN
BEGIN
aux:='';
WHILE salida>=256 DO
BEGIN
resto:=salida mod 256;
caracter:=chr(resto);
aux:=aux+caracter;
salida:=salida div 256;
End;{Fin WHILE}
IF salida<256 THEN resto:=salida mod 256;
caracter:=chr(resto);
aux:=aux+caracter;
x:=longitud-length(aux);
FOR auxi:=1 to x DO aux:=aux+#0;
End;{Fin IF}
End;
PROCEDURE escribirCaracter2 ( ch : char; fich : TFicheroDireccionado; var estamos:integer );
Var
aux:string;
BEGIN
IF c1024_E = 1023 THEN
BEGIN
str(c1024_E, aux);
codificarNumero(2,aux,aux);
escribirTamanyo(aux);
fich.escribirbloque(estamos,bloque_E);
inc(estamos);
bloque_E.RellenarCero;
c1024_E:=2;
End;
bloque_E.data[c1024_E] := ord(ch);
inc(c1024_E);
End;
PROCEDURE codificarDNI(entrada:string; VAR salida:string);
VAR aux:string;
x:byte;
BEGIN
aux:='';
salida:='';
FOR x:=1 to length(entrada) DO
BEGIN
IF (entrada[x]>='0') AND (entrada[x]<='9') THEN
aux:=aux+entrada[x];
End;
codificarNumero(4,aux,salida);
End;
PROCEDURE codificarCP(entrada:String; VAR salida:string);
BEGIN
salida:='';
codificarNumero(3,entrada,salida);
End;
PROCEDURE codificarTelefono(entrada:String; VAR salida:string);
BEGIN
salida:='';
codificarNumero(4,entrada,salida);
End;
PROCEDURE codificarPalabras(entrada:String; VAR salida:string);
BEGIN
salida:='';
codificarNumero(3,entrada,salida);
End;
PROCEDURE codificarNumPubli(entrada:String; VAR salida:string);
BEGIN
salida:='';
codificarNumero(2,entrada,salida);
End;
PROCEDURE codificarPortal(entrada:String; VAR salida:string);
BEGIN
salida:='';
codificarNumero(2,entrada,salida);
End;
FUNCTION codificarSexo(cadena1:string):char;
BEGIN
IF cadena1='mujer' THEN codificarSexo:='M'
else codificarSexo:='H';
End;
PROCEDURE descodificarSexo(sexo:char; VAR cadena1:string);
BEGIN
IF sexo='M' THEN cadena1:='mujer'
else cadena1:='varón';
End;
PROCEDURE codificarDia(entrada:string; VAR salida:string);
BEGIN
IF entrada=' ' THEN salida:=#0
else
BEGIN
salida:='';
quitarEspacios(entrada,entrada);
codificarNumero(1,entrada,salida);
End;
End;
PROCEDURE codificarMes (entrada : string ; VAR salida : String);
Var noMes: boolean;
begin
noMes := FALSE;
quitarEspacios(entrada,entrada);
If entrada = 'Enero' then
salida := '1'
else
If entrada = 'Febrero' then
salida := '2'
else
If entrada = 'Marzo' then
salida := '3'
else
If entrada = 'Abril' then
salida := '4'
else
If entrada = 'Mayo' then
salida := '5'
else
If entrada = 'Junio' then
salida := '6'
else
If entrada = 'Julio' then
salida := '7'
else
If entrada = 'Agosto' then
salida := '8'
else
If entrada = 'Septiembre' then
salida := '9'
else
If entrada = 'Octubre' then
salida := 'A'
else
If entrada = 'Noviembre' then
salida := 'B'
else
If entrada = 'Diciembre' then
salida := 'C'
else noMes:=TRUE;
If noMes then
salida := '0';
end;
PROCEDURE codificarAnyo(entrada:string; VAR salida:string);
BEGIN
salida:='';
codificarNumero(2,entrada,salida);
End;
PROCEDURE codificarFecha(entrada:string; VAR sal1,sal2,sal3:string);
VAR dia,mes,anyo:string;
i:integer;
BEGIN
dia:='';
mes:='';
anyo:='';
sal1:='';
sal2:='';
sal3:='';
FOR i:=1 to 2 DO dia:=dia+entrada[i];
codificarDia(dia,sal1);
FOR i:=4 to 13 DO mes:=mes+entrada[i];
codificarMes(mes,sal2);
FOR i:=15 to 18 DO anyo:=anyo+entrada[i];
codificarAnyo(anyo,sal3);
End;
PROCEDURE descodificarDia(entrada:string; VAR salida:string);
VAR aux:longint;
BEGIN
IF entrada=#0 THEN salida:=''
else
BEGIN
descodificarNumero(entrada,aux);
str(aux,salida);
End;
End;
PROCEDURE descodificarMes (entrada:string; VAR salida:string);
BEGIN
If entrada = '1' then
salida := 'Enero'
else
If entrada = '2' then
salida := 'Febrero'
else
If entrada = '3' then
salida := 'Marzo'
else
If entrada = '4' then
salida := 'Abril'
else
If entrada = '5' then
salida := 'Mayo'
else
If entrada = '6' then
salida := 'Junio'
else
If entrada = '7' then
salida := 'Julio'
else
If entrada = '8' then
salida := 'Agosto'
else
If entrada = '9' then
salida := 'Septiembre'
else
If entrada = 'A' then
salida := 'Octubre'
else
If entrada = 'B' then
salida := 'Noviembre'
else
If entrada = 'C' then
salida := 'Diciembre'
else salida:='';
End;
PROCEDURE descodificarAnyo(entrada:string; VAR salida:string);
VAR aux:longint;
BEGIN
descodificarNumero(entrada,aux);
str(aux,salida);
End;
PROCEDURE descodificarFecha(entrada:string; VAR salida:string);
VAR dia,diaD,mes,mesD,anyoD,anyo:string;
BEGIN
salida:='';
dia:=entrada[1];
mes:=entrada[2];
anyo:=entrada[3]+entrada[4];
descodificarDia(dia,diaD);
descodificarMes(mes,mesD);
descodificarAnyo(anyo,anyoD);
IF diaD<>'' THEN salida:=salida+diaD+'-';
IF mesD<>'' THEN salida:=salida+mesD+'-';
salida:=salida+anyoD;
End;
PROCEDURE cambiarGitano ( entrada : integer ; VAR salida : String);
Begin
salida := '';
if entrada < 10 THEN
Begin
str(entrada, salida);
end;
if entrada = 10 Then
begin
salida := 'A';
end;
If entrada = 11 Then
begin
salida := 'B';
end;
If entrada = 12 Then
begin
salida := 'C';
end;
If entrada = 13 Then
begin
salida := 'D';
end;
If entrada = 14 Then
begin
salida := 'E';
end;
If entrada = 15 Then
begin
salida := 'F';
end;
If entrada = 16 Then
begin
salida := 'G';
end;
If entrada = 17 Then
begin
salida := 'H';
end;
If entrada = 18 Then
begin
salida := 'I';
end;
If entrada = 19 Then
begin
salida := 'J';
end;
If entrada = 20 Then
begin
salida := 'K';
end;
End;
PROCEDURE desCambiarGitano ( entrada : string ; VAR salida : integer );
Var
retocado : boolean ;
u : integer;
Begin
retocado := False ;
if entrada = 'A' Then
begin
salida := 10;
retocado := true ;
end;
If entrada = 'B' Then
begin
salida := 11;
retocado := true ;
end;
If entrada = 'C' Then
begin
salida := 12;
retocado := true ;
end;
If entrada = 'D' Then
begin
salida := 13;
retocado := true ;
end;
If entrada = 'E' Then
begin
salida := 14;
retocado := true ;
end;
If entrada = 'F' Then
begin
salida := 15 ;
retocado := true ;
end;
If entrada = 'G' THEn
begin
salida := 16 ;
retocado := true ;
end;
If entrada = 'H' Then
begin
salida := 17;
retocado := true ;
end;
If entrada = 'I' Then
begin
salida := 18;
retocado := true ;
end;
If entrada = 'J' Then
begin
salida := 19;
retocado := true ;
end;
If entrada = 'K' Then
begin
salida := 20;
retocado := true ;
end;
If not retocado then
Begin
val(entrada, salida , u);
End ;
End;
PROCEDURE marcaFinFichero ;
BEGIN
escribirCaracter('#');
escribirCaracter('#');
escribirCaracter('#');
escribirCaracter('#');
fichero_E.escribirbloque(bloque_E);
writeln('Fichero importado.');
End;
PROCEDURE escribirCampo( aux:string );
VAR
indice:integer;
BEGIN
FOR indice:=1 to length(aux) DO
BEGIN
escribirCaracter(aux[indice]);
End;
End;
Procedure escribirCampo2(aux:string; fich : TFicheroDireccionado; var estamos: integer);
VAR
indice:integer;
BEGIN
FOR indice:=1 to length(aux) DO
BEGIN
escribirCaracter2(aux[indice],fich, estamos );
End;
End;
PROCEDURE leerCampoC(VAR cadena1:string);
VAR caracter:char;
BEGIN
caracter:=leerCaracter;
IF caracter='#' THEN
BEGIN
cadena1:=cadena1+caracter;
caracter:=leerCaracter;
IF caracter='#' THEN
BEGIN
cadena1:=cadena1+caracter;
caracter:=leerCaracter;
IF caracter='#' THEN
BEGIN
cadena1:=cadena1+caracter;
caracter:=leerCaracter;
IF caracter='#' THEN cadena1:=cadena1+caracter;
End;
End;
End
else
while(caracter <> '$') DO
BEGIN
cadena1:=cadena1+caracter;
caracter:=leerCaracter;
End; {Fin del WHILE del else}
End;
PROCEDURE leerCampo(n:integer; VAR aux:string);
VAR indice:integer;
auxCar:char;
BEGIN
aux:='';
FOR indice:=1 to n DO
BEGIN
auxCar:=leerCaracter;
aux:=aux+auxCar;
End;
End;
PROCEDURE leerCampoDN(n:integer; VAR aux:string);
VAR indice:integer;
auxCar:char;
BEGIN
aux:='';
FOR indice:=1 to n DO
BEGIN
auxCar:=leerCaracterD;
aux:=aux+auxCar;
End;
End;
PROCEDURE leerCampoIN(n:integer; fich: TFicheroDireccionado ; VAR aux:string ; var ent : integer );
VAR indice:integer;
auxCar:char;
BEGIN
aux:='';
FOR indice:=1 to n DO
BEGIN
leerCaracterI(fich, auxCar, ent);
aux:=aux+auxCar;
End;
End;
procedure leerDesbordado(Var aux:string);
begin
aux:='';
aux := chr(bloque_E.data[2]);
end;
PROCEDURE leerCampoLong( VAR aux:string);
BEGIN
aux:='';
aux:= chr(bloque_E.data[0])+ chr(bloque_E.data[1]);
{ while(auxCar <> '$') DO
BEGIN
aux := aux + chr(bloque_E.data[p]);
inc(p);
auxCar:=chr(bloque_E.data[p]) ;
End;}
End;
PROCEDURE leerCampoD( VAR aux:string);
VAR
auxCar:char;
BEGIN
aux:='';
auxCar := leerCaracterD ;
while(auxCar <> '$') DO
BEGIN
aux := aux + auxCar;
auxCar:=leerCaracterD;
End;
End;
PROCEDURE leerCampoI( fich: TFicheroDireccionado ;VAR aux:string ; var ent : integer );
VAR
auxCar:char;
BEGIN
aux:='';
auxCar := leerCaracterD ;
while(auxCar <> '$') DO
BEGIN
aux := aux + auxCar;
leerCaracterI(fich,auxCar, ent );
End;
End;
Procedure descodificarTituloPublicacion(entrada : string ; Var salida : string);
Begin
IF entrada='0' THEN
BEGIN
salida:='World News';
End
else
IF entrada='1' THEN
BEGIN
salida:='Watchung';
End
else
IF entrada='2' THEN
BEGIN
salida:='Treinta Días';
End
else
IF entrada='3' THEN
BEGIN
salida:='The High Noon Chronicles';
End
else
IF entrada='4' THEN
BEGIN
salida:='The Everywhere-News';
End
else
IF entrada='5' THEN
BEGIN
salida:='The Daily Bugle';
End
else
IF entrada='6' THEN
BEGIN
salida:='Sprites';
End
else
IF entrada='7' THEN
BEGIN
salida:='Semanario del Mes';
End
else
IF entrada='8' THEN
BEGIN
salida:='Resolutions';
End
else
IF entrada='9' THEN
BEGIN
salida:='Radio Patio Press';
End
else
IF entrada='A' THEN
BEGIN
salida:='Páginas con Tinta';
End
else
IF entrada='B' THEN
BEGIN
salida:='Nitroglicerinico';
End
else
IF entrada='C' THEN
BEGIN
salida:='New Realms';
End
else
IF entrada='D' THEN
BEGIN
salida:='New News';
End
else
IF entrada='E' THEN
BEGIN
salida:='Nebuchadnezzar';
End
else
IF entrada='F' THEN
BEGIN
salida:='Milenio3';
End
else
IF entrada='G' THEN
BEGIN
salida:='Mesenario';
End
else
IF entrada='H' THEN
BEGIN
salida:='Manamaná';
End
else
IF entrada='I' THEN
BEGIN
salida:='Letrenario';
End
else
IF entrada='J' THEN
BEGIN
salida:='Le Chauvin';
End
else
IF entrada='K' THEN
BEGIN
salida:='Las Noticias';
End
else
IF entrada='L' THEN
BEGIN
salida:='Lapso';
End
else
IF entrada='M' THEN
BEGIN
salida:='La Última Frontera';
End
else
IF entrada='N' THEN
BEGIN
salida:='Gimme Five';
End
else
IF entrada='O' THEN
BEGIN
salida:='Extra Time';
End
else
IF entrada='P' THEN
BEGIN
salida:='El puntazo';
End
else
IF entrada='Q' THEN
BEGIN
salida:='El Pisto';
End
else
IF entrada='R' THEN
BEGIN
salida:='El Pasquín';
End
else
IF entrada='S' THEN
BEGIN
salida:='El Panfleto';
End
else
IF entrada='T' THEN
BEGIN
salida:='El Heraldo Cultural';
End
else
IF entrada='U' THEN
BEGIN
salida:='El Espejo de la Verdad';
End
else
IF entrada='V' THEN
BEGIN
salida:='El Diario de Aquí';
End
else
IF entrada='W' THEN
BEGIN
salida:='El Cardinal';
End
else
IF entrada='X' THEN
BEGIN
salida:='El Boletín del Mediodia';
End
else
IF entrada='Y' THEN
BEGIN
salida:='El Australopitecus';
End
else
IF entrada='Z' THEN
BEGIN
salida:='Daily Notes on News';
End
else
IF entrada='a' THEN
BEGIN
salida:='Cantos con Bits';
End
else
IF entrada='b' THEN
BEGIN
salida:='Buena Prensa';
End
else
IF entrada='c' THEN
BEGIN
salida:='Aqua';
End
else
IF entrada='d' THEN
BEGIN
salida:='Ankí Akonkagua';
End
else
leerCampoD(salida);
End; {Codificar titulo de publicaciones}
Procedure comparar(nom:string;ap1:string;ap2:string;var iguales:boolean);
begin
if(nom=registroLogico.nombre) and (ap1=registroLogico.apellido1) and (ap2=registroLogico.apellido2) then
begin
iguales := true;
end
else
begin
iguales := false;
end;
end;
Procedure compararNombre(nom:string;var iguales:boolean);
begin
if(nom=registroLogico.nombre)then
begin
iguales := true;
end
else
begin
iguales := false;
end;
end;
Procedure compararApellido(nom:string;var iguales:boolean);
begin
if(nom=registroLogico.apellido1)then
begin
iguales := true;
end
else
begin
iguales := false;
end;
end;
Procedure compararApellido2(nom:string; nom2 : string ;var iguales:boolean);
begin
if(nom=nom2)then
begin
iguales := true;
end
else
begin
iguales := false;
end;
end;
Procedure compararDNI(nom:string;var iguales:boolean);
begin
if(nom=registroLogico.DNI)then
begin
iguales := true;
end
else
begin
iguales := false;
end;
end;
Procedure compararTitulo(nom:string;var iguales:boolean);
Var
indiceArticulo : integer;
begin
iguales := false;
FOR indiceArticulo:=1 to 20 DO
BEGIN
if(nom=registroLogico.Articulo[indiceArticulo].Titulo)then
begin
iguales := true;
end;
end;
end;
PROCEDURE desCodificarTipoDireccion(entrada:string; Var salida : string);
Begin
If entrada[1] = '1' then
Begin
salida := 'Calle'
End
else
If entrada[1] = '2' then
Begin
salida := 'Plaza'
End
else
If entrada[1] = '3' then
Begin
salida := 'Avenida'
End
else
If entrada[1] = '4' then
Begin
salida := 'Paseo'
End
else
If entrada[1] = '5' then
Begin
salida := 'Travesía'
End
else
If entrada[1] = '6' then
Begin
leerCampoD(salida);
//HACER salida := entrada[2]....entrada[length]
End
End;
PROCEDURE descodificarCorreo(entrada:string; Var salida : string);
Begin
IF entrada[1]='0' THEN
BEGIN
salida:='socios.paparazzi.org'
End
else
IF entrada[1]='1' THEN
BEGIN
salida:='users.reportajes.com'
End
else
IF entrada[1]='2' THEN
BEGIN
salida:='prensa.es'
End
else
IF entrada[1]='3' THEN
BEGIN
salida:='mimail.es'
End
else
IF entrada[1]='4' THEN
BEGIN
salida:='mimail.com'
End
else
IF entrada[1]='5' THEN
BEGIN
salida:='usuarios.arena.es'
End
else
IF entrada[1]='6' THEN
BEGIN
salida:='usuarios.arena.net'
End
else
IF entrada[1]='7' THEN
BEGIN
salida:='reports.docuteca.es'
End
else
IF entrada[1]='8' THEN
BEGIN
salida:='usuarios.portalprensa.org'
End
else
IF entrada[1]='9' THEN
BEGIN
salida:='authors.fededitores.com'
End
else
IF entrada[1]='A' THEN
BEGIN
salida:='authors.fededitores.org'
End
else
IF entrada[1]='B' THEN
BEGIN
salida:='autores.fededitores.org'
End
else
If entrada[1] = 'C' then
Begin
leerCampoD(salida)
End;
End; {Procedimiento descodificar Direccion}
PROCEDURE descodificarURL1(entrada:char; VAR salida:string);
VAR noEntra:boolean;
BEGIN
noEntra:=TRUE;
IF entrada='0' THEN
BEGIN
salida:='webpages.4free.com';
noEntra:=FALSE;
End
else
IF entrada='1' THEN
BEGIN
salida:='web.freemegabytes.com';
noEntra:=FALSE
End
else
IF entrada='2' THEN
BEGIN
salida:='www.webspace.com';
noEntra:=FALSE;
End
else
IF entrada='3' THEN
BEGIN
salida:='www.prensa.es';
noEntra:=FALSE;
End
else
IF entrada='4' THEN
BEGIN
salida:='www.mimail.es';
noEntra:=FALSE;
End
else
IF entrada='5' THEN
BEGIN
salida:='wwww.usuarios.arena.es';
noEntra:=FALSE;
End
else
IF entrada='6' THEN
BEGIN
salida:='www.portalprensa.org';
noEntra:=FALSE;
End
else
IF entrada='7' THEN
BEGIN
salida:='paginas.reportajes.com';
noEntra:=FALSE;
End
else
IF entrada='8' THEN
BEGIN
salida:='www.fededitores.com';
noEntra:=FALSE;
End
else
IF entrada='9' THEN
BEGIN
salida:='www.arena.com';
noEntra:=FALSE;
End
else
IF entrada='A' THEN
BEGIN
salida:='www.docuteca.es';
noEntra:=FALSE;
End;
If noEntra then
Begin
leerCampoD(salida)
End;
End; {Fin descodificar URL1}
PROCEDURE descodificarURL2 (entrada:char; VAR salida:string);
BEGIN
IF entrada='1' THEN salida:=registroLogico.Correo.Nickname
else
BEGIN
leerCampoD(salida);
End;
End; {Fin descodificar URL2}
PROCEDURE descodificarURL3 (entrada:string; VAR salida:string);
BEGIN
leerCampoD(salida)
End;
{PROCEDURE codificarFecha(entrada:string; VAR salida:string);
VAR dia,mes,anyo:string;
BEGIN
dia:='';
mes:='';
anyo:='';
IF entrada[1]=' ' THEN
IF entrada[2]=' ' THEN dia:='0'
else
BEGIN
dia:=dia+entrada[1]+entrada[2];
codificarDia(dia);
End;
IF entrada[4]=' ' THEN mes:='0'
else
BEGIN
WHILE x
codificarMes(mes);
codificarAnyo(anyo);
End; }
//Function codificarFechaRob(f:string):string;
//Var
// i:byte; {variable para recorrer f }
// separador:byte; {variable que separa el dia, el mes y el anyo}
// k:integer; {variable util para la funcion val }
// enterodia:integer; {recoge el entero de ese dato }
// enteroanyo:integer; {recoge el entero de ese dato }
// dia,mes,anyo:string;
// dosdigitos:string;
// recogefecha:string;
//BEGIN
// dia:='';
// mes:='';
// anyo:='';
// separador := 0;
// recogefecha:='';
// for i:=1 to length(f) do
// begin {cogemos todos los caracteres de fecha }
// if f[i]= '-' then
// inc(separador) {si hay -, no queremos guardarlo, y sirve}
// else {para saber si vamos por dia, mes o anyo }
// begin
// if separador=0 then {si separador es 0, entonces}
// dia:=dia+f[i] {guardamos en dia }
// else
// begin
// if separador=1 then {si separador es 2, entonces}
// mes:=mes+f[i] {guardamos en mes }
// else {si no es ninguno, entonces }
// anyo:=anyo+f[i] {es que vamos por anyo }
// end;
// end;
// end;
// val(dia,enterodia,k); {pasamos de char a entero el dia}
// recogefecha:=recogefecha+chr(100+enterodia); {y guardamos el caracter}
{Ahora tratamos los meses}
// if mes[1]='E' then {Enero}
// recogefecha:=recogefecha+'E'
// else
// if mes[1]='F' then {febrero}
// recogefecha:=recogefecha+'F'
// else
// if mes[1]='M' then
// begin
// if mes[4]='Z' then {marzo}
// recogefecha:=recogefecha+'M'
// else {mayo}
// recogefecha:=recogefecha+'Y'
// end
// else
// if mes[1]='A' then
// begin
// if mes[2]='B' then {abril}
// recogefecha:=recogefecha+'A'
// else {agosto}
// recogefecha:=recogefecha+'G'
// end
// else
// if mes[1]='J' then
// begin
// if mes[3]='N' then {junio}
// recogefecha:=recogefecha+'J'
// else {julio}
// recogefecha:=recogefecha+'L'
// end
// else
// if mes[1]='S' then {septiembre}
// recogefecha:=recogefecha+'S'
// else
// if mes[1]='O' then {Octubre}
// recogefecha:=recogefecha+'O'
// else
// if mes[1]='N' then {noviembre}
// recogefecha:=recogefecha+'N'
// else
// if mes[1]='D' then {Diciembre}
// recogefecha:=recogefecha+'D';
{Una vez codificamos el mes, solo queda codificar el anyo}
// dosdigitos:=anyo[1]+anyo[2]; {cogemos los dos primeros digitos}
// val(dosdigitos,enteroanyo,k); {y los pasamos a entero}
// recogefecha:=recogefecha+chr(100+enteroanyo); {los guardamos como char}
// dosdigitos:=anyo[3]+anyo[4]; {repetimos la operacion}
// val(dosdigitos,enteroanyo,k); {con los ultimos char }
// recogefecha:=recogefecha+chr(100+enteroanyo);
// codificarFecha:=recogefecha;
//end;
Procedure codificarTituloPublicacion(entrada : string ; Var salida : string);
Var noEntra:boolean;
Begin
salida := '';
NoEntra:=TRUE;
IF entrada='World News' THEN
BEGIN
salida:=salida+'0';
noEntra:=FALSE;
End
else
IF entrada='Watchung' THEN
BEGIN
salida:=salida+'1';
noEntra:=FALSE
End
else
IF entrada='Treinta Días' THEN
BEGIN
salida:=salida+'2';
noEntra:=FALSE;
End
else
IF entrada='The High Noon Chronicles' THEN
BEGIN
salida:=salida+'3';
noEntra:=FALSE;
End
else
IF entrada='The Everywhere-News' THEN
BEGIN
salida:=salida+'4';
noEntra:=FALSE;
End
else
IF entrada='The Daily Bugle' THEN
BEGIN
salida:=salida+'5';
noEntra:=FALSE;
End
else
IF entrada='Sprites' THEN
BEGIN
salida:=salida+'6';
noEntra:=FALSE;
End
else
IF entrada='Semanario del Mes' THEN
BEGIN
salida:=salida+'7';
noEntra:=FALSE;
End
else
IF entrada='Resolutions' THEN
BEGIN
salida:=salida+'8';
noEntra:=FALSE;
End
else
IF entrada='Radio Patio Press' THEN
BEGIN
salida:=salida+'9';
noEntra:=FALSE;
End
else
IF entrada='Páginas con Tinta' THEN
BEGIN
salida:='A';
noEntra:=FALSE;
End
else
IF entrada='Nitroglicerinico' THEN
BEGIN
salida:=salida+'B';
noEntra:=FALSE;
End
else
IF entrada='New Realms' THEN
BEGIN
salida:=salida+'C';
noEntra:=FALSE
End
else
IF entrada='New News' THEN
BEGIN
salida:=salida+'D';
noEntra:=FALSE;
End
else
IF entrada='Nebuchadnezzar' THEN
BEGIN
salida:=salida+'E';
noEntra:=FALSE;
End
else
IF entrada='Milenio3' THEN
BEGIN
salida:=salida+'F';
noEntra:=FALSE;
End
else
IF entrada='Mesenario' THEN
BEGIN
salida:=salida+'G';
noEntra:=FALSE;
End
else
IF entrada='Manamaná' THEN
BEGIN
salida:=salida+'H';
noEntra:=FALSE;
End
else
IF entrada='Letrenario' THEN
BEGIN
salida:=salida+'I';
noEntra:=FALSE;
End
else
IF entrada='Le Chauvin' THEN
BEGIN
salida:=salida+'J';
noEntra:=FALSE;
End
else
IF entrada='Las Noticias' THEN
BEGIN
salida:=salida+'K';
noEntra:=FALSE;
End
else
IF entrada='Lapso' THEN
BEGIN
salida:='L';
noEntra:=FALSE;
End
else
IF entrada='La Última Frontera' THEN
BEGIN
salida:=salida+'M';
noEntra:=FALSE;
End
else
IF entrada='Gimme Five' THEN
BEGIN
salida:=salida+'N';
noEntra:=FALSE;
End
else
IF entrada='Extra Time' THEN
BEGIN
salida:=salida+'O';
noEntra:=FALSE;
End
else
IF entrada='El puntazo' THEN
BEGIN
salida:=salida+'P';
noEntra:=FALSE;
End
else
IF entrada='El Pisto' THEN
BEGIN
salida:=salida+'Q';
noEntra:=FALSE;
End
else
IF entrada='El Pasquín' THEN
BEGIN
salida:=salida+'R';
noEntra:=FALSE;
End
else
IF entrada='El Panfleto' THEN
BEGIN
salida:='S';
noEntra:=FALSE;
End
else
IF entrada='El Heraldo Cultural' THEN
BEGIN
salida:=salida+'T';
noEntra:=FALSE;
End
else
IF entrada='El Espejo de la Verdad' THEN
BEGIN
salida:=salida+'U';
noEntra:=FALSE
End
else
IF entrada='El Diario de Aquí' THEN
BEGIN
salida:=salida+'V';
noEntra:=FALSE;
End
else
IF entrada='El Cardinal' THEN
BEGIN
salida:=salida+'W';
noEntra:=FALSE;
End
else
IF entrada='El Boletín del Mediodia' THEN
BEGIN
salida:=salida+'X';
noEntra:=FALSE;
End
else
IF entrada='El Australopitecus' THEN
BEGIN
salida:=salida+'Y';
noEntra:=FALSE;
End
else
IF entrada='Daily Notes on News' THEN
BEGIN
salida:=salida+'Z';
noEntra:=FALSE;
End
else
IF entrada='Cantos con Bits' THEN
BEGIN
salida:=salida+'a';
noEntra:=FALSE;
End
else
IF entrada='Buena Prensa' THEN
BEGIN
salida:=salida+'b';
noEntra:=FALSE;
End
else
IF entrada='Aqua' THEN
BEGIN
salida:=salida+'c';
noEntra:=FALSE;
End
else
IF entrada='Ankí Akonkagua' THEN
BEGIN
salida:='d';
noEntra:=FALSE;
End;
If noEntra then
Begin
salida:=salida + 'e'+ entrada + '$';
End;
End; {Codificar titulo de publicaciones}
Procedure codificarURL(entrada : string ; Var salida : string);
Var aux:string;
i,j,y : integer;
barra,noEntra:boolean;
Begin
salida := '';
aux:='';
barra:=FALSE;
{Quita http://}
//for i := 8 to length(entrada) do
// Begin
// salida := salida + entrada[i];
// end;
{Acaba aqui}
IF entrada='' THEN salida:='0'
else {existe URL}
BEGIN
salida:='1';
// FOR i:= 1 to 7 DO
// aux:=aux+entrada[i];
// entrada1:=aux;
// aux:='';
i:=8;
WHILE entrada[i]<>'/' do
BEGIN
aux:=aux+entrada[i];
inc(i);
End;
noEntra:=TRUE;
IF aux='webpages.4free.com' THEN
BEGIN
salida:=salida+'0';
noEntra:=FALSE;
End
else
IF aux='web.freemegabytes.com' THEN
BEGIN
salida:=salida+'1';
noEntra:=FALSE
End
else
IF aux='www.webspace.com' THEN
BEGIN
salida:=salida+'2';
noEntra:=FALSE;
End
else
IF aux='www.prensa.es' THEN
BEGIN
salida:=salida+'3';
noEntra:=FALSE;
End
else
IF aux='www.mimail.es' THEN
BEGIN
salida:=salida+'4';
noEntra:=FALSE;
End
else
IF aux='wwww.usuarios.arena.es' THEN
BEGIN
salida:=salida+'5';
noEntra:=FALSE;
End
else
IF aux='www.portalprensa.org' THEN
BEGIN
salida:=salida+'6';
noEntra:=FALSE;
End
else
IF aux='paginas.reportajes.com' THEN
BEGIN
salida:=salida+'7';
noEntra:=FALSE;
End
else
IF aux='www.fededitores.com' THEN
BEGIN
salida:=salida+'8';
noEntra:=FALSE;
End
else
IF aux='www.arena.com' THEN
BEGIN
salida:=salida+'9';
noEntra:=FALSE;
End
else
IF aux='www.docuteca.es' THEN
BEGIN
salida:=salida+'A';
noEntra:=FALSE;
End;
If noEntra then
Begin
salida:=salida + 'B'+ aux + '$';
End;
{Rutina para obtener la segunda parte del URL}
aux:='';
{Localizamos la ultima /}
j:=length(entrada);
WHILE entrada[j]<>'/' DO
dec(j);
//y:=j-1;
inc(i);
WHILE i<>j DO
BEGIN
aux:=aux+entrada[i];
IF entrada[i]='/' THEN barra:=TRUE;
inc(i);
End;
//WHILE entrada[i]<>'/' do
// BEGIN
// aux:=aux+entrada[i];
// inc(i);
// End;
IF registroLogico.Correo.Nickname=aux THEN salida:=salida+'1'
else salida:=salida +'0'+aux;
IF barra THEN salida:=salida+'$';
inc(i); {Rutina para obtener la ultima parte de la URL}
aux:='';
FOR y:=i to length(entrada) DO
BEGIN
aux:=aux+entrada[y];
End;
salida:=salida+aux;
End; {Fin del IF si existe la URL}
End;
{Rutina para sacar enumerados}
// h:=1;
//pp:=0
// WHILE h<1000 DO
// BEGIN
// IF enumerado[h]<>aux THEN
// BEGIN
//writeln(enumerado[h],aux,h);
// IF enumerado[h]='' THEN
// BEGIN
// enumerado[h]:=aux;
// h:=1000;
// end;
// inc(h);
// End
// else h:=1000;
// End;
// readln;
PROCEDURE CodificarTipoDireccion( entrada:string; Var salida : string);
Var
noEntra : boolean;
Begin
noEntra := true;
If entrada = 'Calle' then
Begin
salida := '1';
noEntra := false ;
End;
If entrada = 'Plaza' then
Begin
salida := '2';
noEntra := false ;
End;
If entrada = 'Avenida' then
Begin
salida := '3';
noEntra := false ;
End;
If entrada = 'Paseo' then
Begin
salida := '4';
noEntra := false ;
End;
If entrada = 'Travesía' then
Begin
noEntra := false ;
salida := '5';
End;
If noEntra then
Begin
salida:='6'+ entrada + '$';
End;
End;
PROCEDURE codificarApellido(entrada:String; VAR salida:string);
BEGIN
salida:='';
codificarNumero(2,entrada,salida);
End;
PROCEDURE codificarApellidos(apellidos1,apellido2:string; VAR sal1,sal2:string);
VAR i:integer;
aux:string;
existe:boolean;
BEGIN
{calcular enumerado}
existe:=FALSE;
FOR i:=1 to 20000 DO
BEGIN
IF enumerado[i]=registroLogico.Apellido1 THEN
BEGIN
existe:=TRUE;
str(i,aux);
codificarApellido(aux,sal1)
End;
IF (enumerado[i]='') AND (existe=FALSE) THEN
BEGIN
enumerado[i]:=registroLogico.Apellido1;
existe:=TRUE;
str(i,aux);
codificarApellido(aux,sal1);
End;
End;
existe:=FALSE;
FOR i:=1 to 20000 DO
BEGIN
IF enumerado[i]=registroLogico.Apellido2 THEN
BEGIN
existe:=TRUE;
str(i,aux);
codificarApellido(aux,sal2);
End;{IF}
IF (enumerado[i]='') AND (existe=FALSE) THEN
BEGIN
enumerado[i]:=registroLogico.Apellido2;
existe:=TRUE;
str(i,aux);
codificarApellido(aux,sal2);
End;{IF}
End;{FOR}
End;
PROCEDURE codificarNombre(entrada:string; VAR salida:string);
VAR existe:boolean;
i:integer;
aux:string;
BEGIN
existe:=FALSE;
FOR i:=1 to 20000 DO
BEGIN
IF enumerado[i]=registroLogico.Nombre THEN
BEGIN
existe:=TRUE;
str(i,aux);
salida:='';
codificarNumero(4,aux,salida);
End;
IF (enumerado[i]='') AND (existe=FALSE) THEN
BEGIN
enumerado[i]:=registroLogico.Nombre;
existe:=TRUE;
str(i,aux);
salida:='';
codificarNumero(4,aux,salida);
End;
End;
End;
PROCEDURE codificarCorreo (entrada:string);
VAR dominio,nickname:string;
x,y:byte;
BEGIN
nickname:='';
x:=1;
WHILE entrada[x]<>'@' DO
BEGIN
nickname:=nickname+entrada[x];
inc(x);
End;
registroLogico.Correo.Nickname:=nickname;
y:=x+1;
dominio:='';
FOR x:=y to length(entrada) DO
BEGIN
dominio:=dominio+entrada[x];
End;
registroLogico.Correo.Dominio:=dominio;
End;
PROCEDURE codificarTipoCorreo (entrada:string; VAR salida:string);
VAR noEntra:boolean;
aux:string;
BEGIN
noEntra:=TRUE;
aux:='';
IF entrada='socios.paparazzi.org' THEN
BEGIN
salida:='0';
noEntra:=FALSE;
End
else
IF entrada='users.reportajes.com' THEN
BEGIN
salida:='1';
noEntra:=FALSE
End
else
IF entrada='prensa.es' THEN
BEGIN
salida:='2';
noEntra:=FALSE;
End
else
IF entrada='mimail.es' THEN
BEGIN
salida:='3';
noEntra:=FALSE;
End
else
IF entrada='mimail.com' THEN
BEGIN
salida:='4';
noEntra:=FALSE;
End
else
IF entrada='usuarios.arena.es' THEN
BEGIN
salida:='5';
noEntra:=FALSE;
End
else
IF entrada='usuarios.arena.net' THEN
BEGIN
salida:='6';
noEntra:=FALSE;
End
else
IF entrada='reports.docuteca.es' THEN
BEGIN
salida:='7';
noEntra:=FALSE;
End
else
IF entrada='usuarios.portalprensa.org' THEN
BEGIN
salida:='8';
noEntra:=FALSE;
End
else
IF entrada='authors.fededitores.com' THEN
BEGIN
salida:='9';
noEntra:=FALSE;
End
else
IF entrada='authors.fededitores.org' THEN
BEGIN
salida:='A';
noEntra:=FALSE;
End
else
IF entrada='autores.fededitores.org' THEN
BEGIN
salida:='B';
noEntra:=FALSE;
End;
If noEntra then
Begin
salida:='C'+ entrada + '$';
End;
End;
PROCEDURE codificarDireccion(entrada:string);
VAR
y:byte;
x:integer ;
tipoCalle,calle,portalCalle:string;
BEGIN
{Hasta primer espacio enumerado tipo de via}
{Hasta la coma nombre de la calle}
{El final el portal}
x:=1;{contador}
tipoCalle:='';
WHILE entrada[x] <> ' ' DO {localizamos el tipo de via}
BEGIN
tipoCalle:=tipoCalle+entrada[x];
inc(x);
End;
{codificamos el tipo de via}
registroLogico.Direccion.Tipo := tipoCalle;
inc(x);
WHILE entrada[x]<>',' DO {localizamos el nombre de la calle}
BEGIN
calle:=calle+entrada[x];
inc(x);
End;
QuitarEspacios(calle,calle);
// y:=1;
// WHILE calle[y]<>',' DO
// BEGIN
// aux:=aux+calle[y];
// inc(y);
// End;
registroLogico.Direccion.Nombre:=calle; {Guardamos el nombre de la calle}
WHILE entrada[x]<>'N' DO {localizamos el numero}
BEGIN
inc(x);
End;
FOR y:=x+1 to length(entrada) DO
BEGIN
portalCalle:=portalCalle+entrada[y];
End;
quitarEspacios(portalCalle,portalCalle);
// while length(portalCalle) < 3 do
// begin
// portalCalle := ' ' + portalCalle;
// end ;
registroLogico.Direccion.Portal := portalCalle;
End; {codificarDireccion}
PROCEDURE leerRegCod;
Var aux,tipoVia,DNI,dominio,URL1,URL2,URL3,Portal,Telefono1,Telefono2: string;
CP,Palabras,Numpubli,fecha:string;
auxi,sexo,URL : char;
numero, indiceArticulo: integer;
Begin
numero := 0;
leerCampoD(registroLogico.Nombre);
IF (registroLogico.Nombre[1] = '#') and (registroLogico.Nombre[4] = '#') and (registroLogico.Nombre[2] = '#') and (registroLogico.Nombre[3] = '#') Then
Begin
control:=FALSE;
End;
IF control THEN
Begin
leerCampoD(registroLogico.Apellido1);
leerCampoD(registroLogico.Apellido2);
leerCampoDN(4,DNI);
descodificarDNI(DNI,registroLogico.DNI);
//leerCampo(9, registroLogico.DNI);
sexo := leerCaracterD;
descodificarSexo(sexo, registroLogico.Sexo);
leerCampoD(registroLogico.Correo.Nickname);
leerCampoDN(1,dominio);
descodificarCorreo(dominio,registroLogico.Correo.Dominio);
//leerCampoC(registroLogico.Correo);
leerCampoDN(1,aux);
IF aux = '2' THEN
Begin
leerCampoDN(4,Telefono1);
descodificarTelefono(Telefono1,registroLogico.Telefono1);
leerCampoDN(4,Telefono2);
descodificarTelefono(Telefono2,registroLogico.Telefono2);
End;
IF aux = '1' THEN
begin
leerCampoDN(4,Telefono1);
descodificarTelefono(Telefono1,registroLogico.Telefono1);
end;
URL:=leerCaracterD;
IF URL='1' THEN
BEGIN
URL:=leerCaracterD;
descodificarURL1(URL,URL1);
auxi:=leerCaracterD;
descodificarURL2(auxi,URL2);
leerCampoD(URL3);
registroLogico.URL:='http://'+URL1+'/'+URL2+'/'+URL3;
End
else registroLogico.URL:='';
//leerCampoC(registroLogico.URL);
//if(registroLogico.URL <> '') then
//begin
// registroLogico.URL := 'http://' + registroLogico.URL;
//end;
leerCampoDN(1,TipoVia);
desCodificarTipoDireccion(TipoVia,registroLogico.Direccion.Tipo);
leerCampoD(registroLogico.Direccion.Nombre);
leerCampoDN(2,Portal);
descodificarPortal(Portal,registroLogico.Direccion.Portal);
leerCampoDN(3,CP);
descodificarCP(CP,registroLogico.Direccion.CP);
leerCampoD(registroLogico.Direccion.Localidad);
//Leemos campo repeticion Articulos
leerCampoDN(1,aux);
desCambiarGitano(aux,numero);
FOR indiceArticulo:=1 to numero DO
BEGIN
leerCampoD(registroLogico.Articulo[indiceArticulo].Titulo);
leerCampoDN(3,Palabras);
descodificarPalabras(Palabras,registroLogico.Articulo[indiceArticulo].Palabras);
leerCampoDN(1,aux);
descodificarTituloPublicacion(aux,RegistroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre);
//leerCampoC(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre);
leerCampoDN(2,NumPubli);
descodificarNumPubli(NumPubli,registroLogico.Articulo[indiceArticulo].DatosPublicacion.Numero);
leerCampoDN(4,fecha);
descodificarFecha(fecha,registroLogico.Articulo[indiceArticulo].DatosPublicacion.Fecha);
End; {FOR articulo}
End;{If control}
End; {Metodo leerRegCod}
PROCEDURE leerRegIni;
VAR indiceArticulo: integer;
cadena:string;
//fecha:string;
BEGIN
leerCampo(35,registroLogico.Nombre);
quitarEspacios(registroLogico.Nombre,registroLogico.Nombre);
IF registroLogico.Nombre[1] = '#' THEN
Begin
IF (registroLogico.Nombre[4] = '#') and (registroLogico.Nombre[2] = '#') and (registroLogico.Nombre[3] = '#') Then
control:=FALSE;
End;
IF control THEN
BEGIN
leerCampo(15,registroLogico.Apellido1);
quitarEspacios(registroLogico.Apellido1,registroLogico.Apellido1);
leerCampo(15,registroLogico.Apellido2);
quitarEspacios(registroLogico.Apellido2,registroLogico.Apellido2);
leerCampo(9,registroLogico.DNI);
// IF registroLogico.DNI='81451600K' THEN
// writeln;
leerCampo(5,registroLogico.Sexo);
leerCampo(50,cadena);
quitarEspacios(cadena,cadena);
codificarCorreo(cadena);
leerCampo(9,registroLogico.Telefono1);
leerCampo(9,registroLogico.Telefono2);
leerCampo(70,registroLogico.URL);
leerCampo(40,cadena);
quitarEspacios(cadena,cadena);
codificarDireccion(cadena);
leerCampo(5,registroLogico.Direccion.CP);
quitarEspacios(registroLogico.Direccion.CP,registroLogico.Direccion.CP);
leerCampo(35,registroLogico.Direccion.Localidad);
quitarEspacios(registroLogico.Direccion.Localidad,registroLogico.Direccion.Localidad);
FOR indiceArticulo:=1 to 20 DO
BEGIN
leerCampo(50,registroLogico.Articulo[indiceArticulo].Titulo);
quitarEspacios(registroLogico.Articulo[indiceArticulo].Titulo,registroLogico.Articulo[indiceArticulo].Titulo);
leerCampo(5,registroLogico.Articulo[indiceArticulo].Palabras);
leerCampo(30,registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre);
leerCampo(3,registroLogico.Articulo[indiceArticulo].DatosPublicacion.Numero);
leerCampo(18,registroLogico.Articulo[indiceArticulo].DatosPublicacion.Fecha);
//fecha:=registroLogico.Articulo[indiceArticulo].DatosPublicacion.Fecha;
//codificarFecha(fecha);
End; {FOR articulo}
End; {IF control}
End; {leerRegIni}
PROCEDURE inicializarFichero;
VAR x:integer;
empieza: string;
BEGIN
codificarNumero(2,'0003',empieza);
escribirCampo(empieza);
codificarNumero(2,'0',empieza);
escribirCampo(empieza);
//escribirCampo('0$');
FOR x:=0 to 500 DO
BEGIN
ficheroD.EscribirBloque(x,Bloque_E);
End;
End;
PROCEDURE ConseguirClave(entrada1,entrada2,entrada3:string; VAR salida:integer);
var
i,aux :integer;
cad: string;
begin
cad:=entrada1+entrada2+entrada3;
aux:=0;
i:=1;
IF length(cad)<3 THEN cad:=cad+' ';
while i<=LENGTH(CAD)-2 do
begin
aux:= aux+ ((ORD(CAD[I]) - ORD(CAD[I+1])) * ORD(CAD[I+2]));
i:=i+3;
end;
if (aux >=0) and (aux <=499) then
salida:=AUX
ELSE
BEGIN
AUX:= ABS(AUX);
salida := aux MOD 499;
END;
end;
PROCEDURE ConseguirClave2(entrada1,entrada2,entrada3:string; VAR salida:integer);
VAR aux1,aux, i :integer;
cad:string;
primos:array[1..96] of integer;
encontrado:boolean;
BEGIN
encontrado:=FALSE;
{Colocamos en un array los numeros primos entre el 1 y el 499}
primos[1]:=499; primos[2]:=491;primos[3]:=487;primos[4]:=479;
primos[5]:=467;primos[6]:=463;primos[7]:=461;primos[8]:=457;
primos[9]:=449;primos[10]:=443;primos[11]:=439;primos[12]:=433;
primos[13]:=431;primos[14]:=421;primos[15]:=419;primos[16]:=409;
primos[17]:=401;primos[18]:=397;primos[19]:=389;primos[20]:=383;
primos[21]:=379;primos[22]:=373;primos[23]:=367;primos[24]:=359;
primos[25]:=353;primos[26]:=349;primos[27]:=347;primos[28]:=337;
primos[29]:=331;primos[30]:=317;primos[31]:=313;primos[32]:=311;
primos[33]:=307;primos[34]:=293;primos[35]:=283;primos[36]:=281;
primos[37]:=277;primos[38]:=271;primos[39]:=269;primos[40]:=263;
primos[41]:=257;primos[42]:=251;primos[43]:=241;primos[44]:=239;
primos[45]:=233;primos[46]:=229;primos[47]:=227;primos[48]:=223;
primos[49]:=211;primos[50]:=199;primos[51]:=197;primos[52]:=193;
primos[53]:=191;primos[54]:=181;primos[55]:=179;primos[56]:=173;
primos[57]:=167;primos[58]:=163;primos[59]:=157;primos[60]:=151;
primos[61]:=149;primos[62]:=139;primos[63]:=137;primos[64]:=131;
primos[65]:=127;primos[66]:=113;primos[67]:=109;primos[68]:=107;
primos[69]:=103;primos[70]:=101;primos[71]:=97;primos[72]:=89;
primos[73]:=83;primos[74]:=79;primos[75]:=73;primos[76]:=71;
primos[77]:=67;primos[78]:=61;primos[79]:=59;primos[80]:=53;
primos[81]:=47;primos[82]:=43;primos[83]:=41;primos[84]:=37;
primos[85]:=31;primos[86]:=29;primos[87]:=23;primos[88]:=19;
primos[89]:=17;primos[90]:=13;primos[91]:=11;primos[92]:=7;
primos[93]:=5;primos[94]:=3;primos[95]:=2;primos[96]:=1;
cad:=entrada1+entrada2+entrada3;
aux:=ord(cad[1]);
for i:= 2 to length(cad) do
begin
aux:=aux+ord(cad[i]);
end;
{Algortimo de dispersion doble}
salida:= aux mod 500;
aux1:=colisiones[salida]+totalcaracteres;
if aux1 <=1020 then
begin
colisiones[salida]:= aux1;
encontrado:=TRUE ;
end
else
begin
i:=1; {Indice del array primos}
WHILE (i<=96) AND (not encontrado) DO
BEGIN
salida:=primos[i]-(aux mod(primos[i]))-1;
aux1:=colisiones[salida]+totalcaracteres;
inc(i);
IF aux1<=1020 THEN
BEGIN
colisiones[salida]:=aux1;
encontrado:=TRUE
End; {Fin IF}
End; {Fin WHILE}
End; {Fin else}
//Si no cabe, lo introducimos en desbordados.
if not encontrado then
begin
salida := 499 + desbordados;
inc(desbordados)
end;
end;
PROCEDURE DesConseguirClave(entrada1,entrada2,entrada3:string; VAR existe : boolean);
VAR aux,i,num,bloqueAcaba:integer;
cad,aux4:string;
salida : integer;
primos:array[1..96] of integer;
encontrado, regristoIgual, iguales :boolean;
BEGIN
existe := false;
regristoIgual:= false;
{Colocamos en un array los numeros primos entre el 1 y el 499}
primos[1]:=499; primos[2]:=491;primos[3]:=487;primos[4]:=479;
primos[5]:=467;primos[6]:=463;primos[7]:=461;primos[8]:=457;
primos[9]:=449;primos[10]:=443;primos[11]:=439;primos[12]:=433;
primos[13]:=431;primos[14]:=421;primos[15]:=419;primos[16]:=409;
primos[17]:=401;primos[18]:=397;primos[19]:=389;primos[20]:=383;
primos[21]:=379;primos[22]:=373;primos[23]:=367;primos[24]:=359;
primos[25]:=353;primos[26]:=349;primos[27]:=347;primos[28]:=337;
primos[29]:=331;primos[30]:=317;primos[31]:=313;primos[32]:=311;
primos[33]:=307;primos[34]:=293;primos[35]:=283;primos[36]:=281;
primos[37]:=277;primos[38]:=271;primos[39]:=269;primos[40]:=263;
primos[41]:=257;primos[42]:=251;primos[43]:=241;primos[44]:=239;
primos[45]:=233;primos[46]:=229;primos[47]:=227;primos[48]:=223;
primos[49]:=211;primos[50]:=199;primos[51]:=197;primos[52]:=193;
primos[53]:=191;primos[54]:=181;primos[55]:=179;primos[56]:=173;
primos[57]:=167;primos[58]:=163;primos[59]:=157;primos[60]:=151;
primos[61]:=149;primos[62]:=139;primos[63]:=137;primos[64]:=131;
primos[65]:=127;primos[66]:=113;primos[67]:=109;primos[68]:=107;
primos[69]:=103;primos[70]:=101;primos[71]:=97;primos[72]:=89;
primos[73]:=83;primos[74]:=79;primos[75]:=73;primos[76]:=71;
primos[77]:=67;primos[78]:=61;primos[79]:=59;primos[80]:=53;
primos[81]:=47;primos[82]:=43;primos[83]:=41;primos[84]:=37;
primos[85]:=31;primos[86]:=29;primos[87]:=23;primos[88]:=19;
primos[89]:=17;primos[90]:=13;primos[91]:=11;primos[92]:=7;
primos[93]:=5;primos[94]:=3;primos[95]:=2;primos[96]:=1;
cad:=entrada1+entrada2+entrada3;
aux:=ord(cad[1]);
for i:= 2 to length(cad) do
begin
aux:=aux+ord(cad[i]);
end;
{Algortimo de dispersion doble}
salida:= aux mod 500;
ficheroD.LeerBloque(salida, bloque_E);
leerCampoLong(aux4);
descodificarNumero(aux4,num);
bloqueAcaba := num;
if (num = 2 ) then
begin
//No existe en direccionado, tenemos q mirar en desbordamiento
end
else
begin
c1024_E:=2;
while (c1024_E < bloqueAcaba) and not (regristoIgual) do
begin
limpiarRegLogico;
leerRegCod;
comparar(entrada1,entrada2,entrada3,iguales);
if iguales then
begin
regristoIgual := true;
existe := true;
end;
end; {while}
end;{else}
if regristoIgual = false then
begin
i:=1; {Indice del array primos}
encontrado:=FALSE;
WHILE (i<=96) AND (not encontrado) AND (NOT regristoIgual) DO
BEGIN
salida:=primos[i]-(aux mod(primos[i]))-1;
inc(i);
ficheroD.LeerBloque(salida, bloque_E);
leerCampoLong(aux4);
descodificarNumero(aux4,num);
bloqueAcaba := num;
if (num = 2 ) then
begin
writeln('Regristo no existente.');
end
else
begin
c1024_E:=2;
while (c1024_E < bloqueAcaba) and not (regristoIgual) do
begin
limpiarRegLogico;
leerRegCod;
comparar(entrada1,entrada2,entrada3,iguales);
if iguales then
regristoIgual := true;
existe := true;
end; {while}
end;{else}
End; {Fin WHILE}
//Leer de desbordamiento
//Regristo no existente.
if (not regristoIgual) then
begin
writeln;
writeln('Registro no existente.');
existe := false;
end;
End;
end;
PROCEDURE saberNumeroReg;
Var indiceArticulo,vacio,num_tlf :integer;
numArticulos,aux,DNI,TipoVia,Portal,dominio,telefono1,telefono2:string;
CP,Palabras,NumPubli,dia,mes,anyo,prueba:string;
BEGIN
totalCaracteres := 0;
num_tlf:=0;
totalCaracteres := totalCaracteres + length(registroLogico.Nombre);
totalCaracteres := totalCaracteres + 1;
quitarEspacios(registroLogico.Apellido1,registroLogico.Apellido1);
totalCaracteres := totalCaracteres + length(registroLogico.Apellido1);
totalCaracteres := totalCaracteres + 1;
quitarEspacios(registroLogico.Apellido2,registroLogico.Apellido2);
totalCaracteres := totalCaracteres + length(registroLogico.Apellido2);
totalCaracteres := totalCaracteres + 1;
codificarDNI(registroLogico.DNI,DNI);
totalCaracteres := totalCaracteres + length(DNI);
totalCaracteres := totalCaracteres + 1;
totalCaracteres := totalCaracteres + length(registroLogico.Correo.Nickname);
totalCaracteres := totalCaracteres + 1;
codificarTipoCorreo(registroLogico.Correo.Dominio,dominio);
totalCaracteres := totalCaracteres + length(dominio);
quitarEspacios(registroLogico.Telefono1,registroLogico.Telefono1);
if registroLogico.Telefono1 <> '' then
Begin
inc(num_tlf);
end;
quitarEspacios(registroLogico.Telefono2,registroLogico.Telefono2);
if registroLogico.Telefono2 <> '' then
Begin
inc(num_tlf);
end;
str(num_tlf, aux);
totalCaracteres := totalCaracteres + 1;
IF registroLogico.Telefono1 <> '' THEN
BEGIN
codificarTelefono(registroLogico.Telefono1,Telefono1);
totalCaracteres := totalCaracteres + length(Telefono1);
End;
IF registroLogico.Telefono2 <> '' THEN
BEGIN
codificarTelefono(registroLogico.Telefono2,Telefono2);
totalCaracteres := totalCaracteres + length(Telefono2);
end;
quitarEspacios(registroLogico.URL,registroLogico.URL);
if(registroLogico.URL <> '') then
begin
codificarURL(registroLogico.URL,prueba);
totalCaracteres := totalCaracteres + length(prueba);
totalCaracteres := totalCaracteres + 1;
end
else
begin
totalCaracteres := totalCaracteres + 1;
end;
CodificarTipoDireccion(registroLogico.Direccion.Tipo, TipoVia);
totalCaracteres := totalCaracteres + length(TipoVia);
quitarEspacios(registroLogico.Direccion.Nombre,registroLogico.Direccion.Nombre);
totalCaracteres := totalCaracteres + length(registroLogico.Direccion.Nombre);
totalCaracteres := totalCaracteres + 1;
codificarPortal(registroLogico.Direccion.Portal,Portal);
totalCaracteres := totalCaracteres + length(Portal);
quitarEspacios(registroLogico.Direccion.CP,registroLogico.Direccion.CP);
codificarCP(registroLogico.Direccion.CP,CP);
totalCaracteres := totalCaracteres + length(CP);
quitarEspacios(registroLogico.Direccion.Localidad,registroLogico.Direccion.Localidad);
totalCaracteres := totalCaracteres + length(registroLogico.Direccion.Localidad);
totalCaracteres := totalCaracteres + 1;
indiceArticulo := 1;
vacio:=0;
WHILE registroLogico.Articulo[indiceArticulo].Titulo<>'' DO
BEGIN
inc(indiceArticulo);
inc(vacio);
End;
cambiarGitano(vacio, numArticulos);
totalCaracteres := totalCaracteres + 1;
FOR indiceArticulo:=1 to vacio DO
BEGIN
quitarEspacios(registroLogico.Articulo[indiceArticulo].Titulo,registroLogico.Articulo[indiceArticulo].Titulo);
totalCaracteres := totalCaracteres + length(registroLogico.Articulo[indiceArticulo].Titulo);
totalCaracteres := totalCaracteres + 1;
quitarEspacios(registroLogico.Articulo[indiceArticulo].Palabras,registroLogico.Articulo[indiceArticulo].Palabras);
codificarPalabras(registroLogico.Articulo[indiceArticulo].Palabras,Palabras);
totalCaracteres := totalCaracteres + length(Palabras);
quitarEspacios(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre,registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre);
codificarTituloPublicacion(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre,registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre);
totalCaracteres := totalCaracteres + length(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre);
quitarEspacios(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Numero,registroLogico.Articulo[indiceArticulo].DatosPublicacion.Numero);
codificarNumPubli(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Numero,NumPubli);
totalCaracteres := totalCaracteres + length(NumPubli);
codificarFecha(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Fecha,dia,mes,anyo);
totalCaracteres := totalCaracteres + length(dia) + length(mes)+ length(anyo);
End; {FOR articulo}
End; {Metodo importarReg}
PROCEDURE importarReg;
Var indiceArticulo,vacio,num_tlf :integer;
numArticulos,aux,DNI,TipoVia,Portal,dominio,telefono1,telefono2:string;
CP,Palabras,NumPubli,dia,mes,anyo:string;
BEGIN
num_tlf:=0;
escribirCampo(registroLogico.Nombre);
escribirCampo('$');
quitarEspacios(registroLogico.Apellido1,registroLogico.Apellido1);
escribirCampo(registroLogico.Apellido1);
escribirCampo('$');
quitarEspacios(registroLogico.Apellido2,registroLogico.Apellido2);
escribirCampo(registroLogico.Apellido2);
escribirCampo('$');
codificarDNI(registroLogico.DNI,DNI);
escribirCampo(DNI);
escribirCampo(codificarSexo(registroLogico.Sexo));
escribirCampo(registroLogico.Correo.Nickname);
escribirCampo('$');
codificarTipoCorreo(registroLogico.Correo.Dominio,dominio);
escribirCampo(dominio);
quitarEspacios(registroLogico.Telefono1,registroLogico.Telefono1);
if registroLogico.Telefono1 <> '' then
Begin
inc(num_tlf);
end;
//quitarEspacios(registroLogico.Telefono2,registroLogico.Telefono2);
if registroLogico.Telefono2 <> '' then
Begin
inc(num_tlf);
end;
str(num_tlf, aux);
escribirCampo(aux);
IF registroLogico.Telefono1 <> '' THEN
BEGIN
codificarTelefono(registroLogico.Telefono1,Telefono1);
escribirCampo(Telefono1);
End;
IF registroLogico.Telefono2 <> '' THEN
BEGIN
codificarTelefono(registroLogico.Telefono2,Telefono2);
escribirCampo(Telefono2);
end;
//quitarEspacios(registroLogico.URL,registroLogico.URL);
if(registroLogico.URL <> '') then
begin
codificarURL(registroLogico.URL,registroLogico.URL);
escribirCampo(registroLogico.URL);
escribirCampo('$');
end
else
begin
escribirCampo('0');
end;
CodificarTipoDireccion(registroLogico.Direccion.Tipo, TipoVia);
escribirCampo(TipoVia);
quitarEspacios(registroLogico.Direccion.Nombre,registroLogico.Direccion.Nombre);
escribirCampo(registroLogico.Direccion.Nombre);
escribirCampo('$');
codificarPortal(registroLogico.Direccion.Portal,Portal);
escribirCampo(Portal);
quitarEspacios(registroLogico.Direccion.CP,registroLogico.Direccion.CP);
codificarCP(registroLogico.Direccion.CP,CP);
escribirCampo(CP);
quitarEspacios(registroLogico.Direccion.Localidad,registroLogico.Direccion.Localidad);
escribirCampo(registroLogico.Direccion.Localidad);
escribirCampo('$');
indiceArticulo := 1;
vacio:=0;
WHILE registroLogico.Articulo[indiceArticulo].Titulo<>'' DO
BEGIN
inc(indiceArticulo);
inc(vacio);
End;
cambiarGitano(vacio, numArticulos);
escribirCampo(numArticulos);
FOR indiceArticulo:=1 to vacio DO
BEGIN
quitarEspacios(registroLogico.Articulo[indiceArticulo].Titulo,registroLogico.Articulo[indiceArticulo].Titulo);
escribirCampo(registroLogico.Articulo[indiceArticulo].Titulo);
escribirCampo('$');
quitarEspacios(registroLogico.Articulo[indiceArticulo].Palabras,registroLogico.Articulo[indiceArticulo].Palabras);
codificarPalabras(registroLogico.Articulo[indiceArticulo].Palabras,Palabras);
escribirCampo(Palabras);
quitarEspacios(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre,registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre);
// codificarTituloPublicacion(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre,registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre);
escribirCampo(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre);
quitarEspacios(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Numero,registroLogico.Articulo[indiceArticulo].DatosPublicacion.Numero);
codificarNumPubli(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Numero,NumPubli);
escribirCampo(NumPubli);
codificarFecha(registroLogico.Articulo[indiceArticulo].DatosPublicacion.Fecha,dia,mes,anyo);
escribirCampo(dia);
escribirCampo(mes);
escribirCampo(anyo);
End; {FOR articulo}
End; {Metodo importarReg}
PROCEDURE mostrarRegPantalla(x:integer);
Var indiceArticulo:integer;
BEGIN
{clrscr;}
writeln;
writeln('Registro numero: ',x);
writeln('Nombre: ',registroLogico.nombre);
writeln('Primer apellido: ',registroLogico.Apellido1);
writeln('Segundo apellido: ',registroLogico.Apellido2);
writeln('DNI: ',registroLogico.DNI);
writeln('Sexo: ',registroLogico.sexo);
writeln('Correo: ',registroLogico.correo.nickname,'@',registroLogico.correo.Dominio);
writeln('Telefono 1: ',registroLogico.telefono1);
writeln('Telefono 2: ',registroLogico.telefono2);
writeln('URL: ',registroLogico.URL);
WITH registroLogico.Direccion DO
BEGIN
writeln('Direccion: ', Tipo , ' ' , Nombre , ', N ',Portal);
writeln('Codigo Postal: ',CP);
writeln('Localidad: ',Localidad);
End; {WITH direccion}
FOR indiceArticulo:=1 to 20 DO
BEGIN
IF (registroLogico.Articulo[indiceArticulo].Titulo<>' ' ) and (registroLogico.Articulo[indiceArticulo].Titulo <> '' )THEN
BEGIN
writeln;
writeln('Articulo numero: ',indiceArticulo);
writeln('Titulo del Articulo: ',registroLogico.Articulo[indiceArticulo].Titulo);
writeln('Numero de palabras: ',registroLogico.Articulo[indiceArticulo].Palabras);
writeln('Titulo de la Publicacion: ',registroLogico.Articulo[indiceArticulo].DatosPublicacion.Nombre);
writeln('Numero: ',registroLogico.Articulo[indiceArticulo].DatosPublicacion.Numero);
writeln('Fecha: ',registroLogico.Articulo[indiceArticulo].DatosPublicacion.Fecha)
End; {IF}
End {FOR articulo}
End {Mostrar x pantalla};
Procedure ficheroTituloImportacion(clave:integer; lugar: integer; var estamos2 : integer);
var
aux, entrada: String;
i : integer;
hayTitulo : boolean;
begin
hayTitulo := true;
ficheroTitulo.LeerBloque(estamos2,bloque_E);
leerCampoLong(aux);
descodificarNumero(aux,c1024_E);
i := 1;
if( c1024_E = 0 ) then
c1024_E := 2;
while hayTitulo do
begin
if registroLogico.Articulo[i].Titulo <> '' then
begin
escribirCampo2(registroLogico.Articulo[i].Titulo,ficheroTitulo, estamos2);
inc(i);
escribirCampo2('$', ficheroTitulo, estamos2);
str(clave, entrada);
codificarNumero(2,entrada ,entrada );
escribirCampo2(entrada,ficheroTitulo, estamos2);
str(lugar,entrada) ;
codificarNumero(2,entrada ,entrada );
escribirCampo2(entrada,ficheroTitulo, estamos2);
str(c1024_E, entrada) ;
codificarNumero(2,entrada,entrada);
escribirTamanyo(entrada);
end
else
begin
hayTitulo:= false;
end;
end;
ficheroTitulo.EscribirBloque(estamos2,bloque_E);
end;
Procedure ficheroApellidoImportacion(clave:integer ; lugar : integer; Var estamos: integer);
var
aux, entrada: String;
begin
ficheroApellido.LeerBloque(estamos, bloque_E);
leerCampoLong(aux);
descodificarNumero(aux,c1024_E);
if( c1024_E = 0 ) then
c1024_E := 2;
escribirCampo2(registroLogico.Apellido1,ficheroApellido, estamos);
escribirCampo2('$', ficheroApellido, estamos);
str(clave, entrada);
codificarNumero(2,entrada ,entrada );
escribirCampo2(entrada,ficheroApellido, estamos);
str(lugar,entrada) ;
codificarNumero(2,entrada ,entrada );
escribirCampo2(entrada,ficheroApellido, estamos);
str(c1024_E, entrada) ;
codificarNumero(2,entrada,entrada);
escribirTamanyo(entrada);
ficheroApellido.EscribirBloque(estamos,bloque_E);
end;
Procedure direccionar;
Var aux,cadenaNumero, aux4,desbordado, cadena: string;
estamos2, estamos, auxliar , clave, contadorDesbordamientos, contadorBloquesVacios,x, num2, num3 : integer;
desbordamiento, num:longint;
Begin
try
fichero.abrir('C:\Temp\original\antiguo.txt');
except
WriteLn('Se ha producido un error');
ExitCode:=1;
end;
estamos := 0;
estamos2 := 0;
desbordamiento := 1;
fichero.leerbloque(bloque);
bloque_E.RellenarCero;
ficheroApellido.EscribirBloque(0,bloque_E);
ficheroTitulo.EscribirBloque(0,bloque_E);
inicializarFichero;
leerRegIni;
contadorDesbordamientos:=0;
WHILE control DO
BEGIN
saberNumeroReg;
conseguirClave(registroLogico.nombre,registroLogico.apellido1,registroLogico.apellido2,clave );
bloque_E.RellenarCero;
ficheroD.LeerBloque(clave, bloque_E);
leerCampoLong(aux);
descodificarNumero(aux,num);
num:=num+totalCaracteres;
if( num > 1020 )then
begin
inc(contadorDesbordamientos);
leerDesbordado(desbordado);
descodificarNumero(desbordado,num3);
if (num3 = 0) then
begin
str( desbordamiento , cadena);
codificarNumero(1,cadena,cadena);
escribirDesbordado(cadena);
ficheroD.EscribirBloque(clave, bloque_E);
clave := 499+ desbordamiento;
ficheroD.LeerBloque(clave,bloque_E);
ficheroD.EscribirBloque(clave+1,bloque_E);
c1024_E:= 0;
codificarNumero(2,'0003',cadena);
escribirCampo(cadena);
codificarNumero(2,'0',cadena);
escribirCampo(cadena);
num := 3;
num:=num+totalCaracteres;
inc(desbordamiento);
end
else
begin
while (num3 <> 0 ) AND (num > 1020) do
begin
clave:= 499 + num3;
bloque_E.RellenarCero;
ficheroD.LeerBloque(clave, bloque_E);
leerCampoLong(aux);
descodificarNumero(aux,num);
num:=num+totalCaracteres;
leerDesbordado(desbordado);
descodificarNumero(desbordado,num3);
if (num3 = 0) and (num > 1020 ) then
begin
str( desbordamiento , cadena);
codificarNumero(1,cadena,cadena);
escribirDesbordado(cadena);
ficheroD.EscribirBloque(clave, bloque_E);
clave := 499+ desbordamiento;
ficheroD.LeerBloque(clave,bloque_E);
ficheroD.EscribirBloque(clave+1,bloque_E);
c1024_E:= 0;
codificarNumero(2,'0003',cadena);
escribirCampo(cadena);
codificarNumero(2,'0',cadena);
escribirCampo(cadena);
num := 3;
num:=num+totalCaracteres;
inc(desbordamiento);
end;
end;
end;{if num3}
end;{if num}
str(num,cadenaNumero);
codificarNumero(2,cadenaNumero,aux);
escribirTamanyo(aux);
c1024_E:=num-totalCaracteres;
if ( c1024_E < 3 )then
c1024_E:=3;
importarReg;
ficheroD.EscribirBloque(clave,bloque_E);
//Indices
auxliar := c1024_E - totalCaracteres;
ficheroApellidoImportacion(clave, auxliar, estamos);
ficheroTituloImportacion ( clave, auxliar, estamos2) ;
limpiarRegLogico;
leerRegIni;
end; {WHILE}
fichero.Cerrar;
ficheroD.Cerrar;
ficheroTitulo.Cerrar;
ficheroApellido.Cerrar;
ficheroD.abrir('C:\Temp\datos\reporter.dat');
contadorBloquesVacios:=0;
FOR x:=0 to 499 DO
BEGIN
num := 0;
ficheroD.LeerBloque(x, bloque_E);
leerCampoLong(aux4);
descodificarNumero(aux4,num2);
if num2 = 3 then
inc( contadorBloquesVacios ) ;
end;
writeln('Bloques Vacios ', contadorBloquesVacios);
writeln('Regristos Desbordados ', contadorDesbordamientos);
ficheroD.Cerrar;
try
ficheroD.abrir('C:\Temp\datos\reporter.dat');
ficheroApellido.Abrir('C:\Temp\datos\indice_apellido1.txt');
ficheroTitulo.Abrir('C:\Temp\datos\indice_titulo.txt');
except
WriteLn('Se ha producido un error');
ExitCode:=1;
end;
End;
Procedure dibujarMenu;
begin
writeln;
writeln('1. ABRIR');
writeln('2. IMPORTAR');
writeln('3. LEER');
writeln('4. SALIR');
writeln;
write('Seleccione una opcion: ');
end;
Procedure dibujarMenu2;
begin
writeln;
writeln('Que tipo de consulta desea: ');
writeln('1. Nombre y apellidos autor');
writeln('2. DNI autor');
writeln('3. Titulo de obra');
writeln('4. Nombre autor');
writeln('5. Primer apellido autor');
writeln('6. Titulos que han escrito los autores que tienen apellido');
writeln('7. Volver al primer menu') ;
writeln;
write('Seleccione una opcion: ');
end;
Procedure abrir ;
begin
try
writeln('Abriendo/Creando ficheros de datos');
ficheroD.abrir('C:\Temp\datos\reporter.dat');
ficheroTitulo.Abrir('C:\Temp\datos\indice_titulo.txt');
ficheroApellido.Abrir('C:\Temp\datos\indice_apellido1.txt');
writeln('Ficheros abiertos/creados.');
except
WriteLn('Se ha producido un error');
ExitCode:=1;
end;
end;
Procedure importar;
begin
try
writeln('Abriendo fichero antiguo.txt');
fichero.abrir('C:\Temp\original\antiguo.txt');
except
WriteLn('Se ha producido un error');
ExitCode:=1;
end;
ficheroD.leerbloque(0,bloque_E);
inicializarFichero;
ficheroD.Cerrar;
//fichero.leerbloque(bloque);
{ writeln('Importando fichero...');
leerRegIni;
WHILE control DO
BEGIN
importarReg;
leerRegIni;
end;
marcaFinFichero;
fichero_E.Cerrar;
fichero.Cerrar;}
end;
Procedure PedirInformacion(Var nom:string;var ap1:string; var ap2:string);
Begin
writeln('Introduzca el nombre del periodista que desee: ');
readln(nom);
writeln('Introduzca el primer apellido: ');
readln(ap1);
writeln('Introduzca el segundo apellido: ');
readln(ap2);
end;
Procedure PedirNombre(Var nom:string);
Begin
writeln('Introduzca el nombre del periodista que desee: ');
readln(nom);
end;
Procedure PedirApellido(Var nom:string);
Begin
writeln('Introduzca el apellido del periodista que desee: ');
readln(nom);
end;
Procedure PedirDNI(Var nom:string);
Begin
writeln('Introduzca el DNI del periodista que desee: ');
readln(nom);
end;
Procedure PedirTitulo(Var nom:string);
Begin
writeln('Introduzca el Titulo del articulo que desee: ');
readln(nom);
end;
Procedure leerRegCodDireccionadoDNI();
Var
DNI,aux : String ;
regristoIgual, final, iguales : boolean ;
clave,bloqueAcaba, contador : integer;
Begin
final := false;
contador := 0;
clave := 0;
regristoIgual := false;
DNI:= '';
PedirDNI(DNI);
while (not regristoIgual) and (not final)do
begin
c1024_E:= 3;
ficheroD.leerBloque(clave, bloque_E);
inc(contador);
leerCampoLong(aux);
descodificarNumero(aux,bloqueAcaba);
if(clave > 499 ) and (bloqueAcaba = 3)then
begin
final := true;
end
else
begin
while (c1024_E < bloqueAcaba) and not (regristoIgual) do
begin
limpiarRegLogico;
leerRegCod;
compararDNI(DNI,iguales);
if iguales then
regristoIgual:= true;
end;
inc(clave);
end;
end;
if regristoIgual then
begin
mostrarRegPantalla(1);
writeln('Leidos: ',contador,' bloques');
end;
if final then
begin
writeln('El DNI no se encuentra entre nuestros autores.');
writeln('Leidos: ',contador,' bloques');
end;
end;
procedure leerRegApellidoIndice(Var apellido : string ; var clave : string; var pos : string; var ent: integer);
begin
leerCampoI(ficheroApellido, apellido, ent);
leerCampoIN(2,ficheroApellido,clave, ent);
leerCampoIN(2,ficheroApellido,pos, ent );
end;
procedure leerRegTituloIndice(Var apellido : string ; var clave : string; var pos : string; var ent: integer);
begin
leerCampoI(ficheroTitulo, apellido, ent);
leerCampoIN(2,ficheroTitulo,clave, ent);
leerCampoIN(2,ficheroTitulo,pos, ent );
end;
procedure leerRegCodDireccionadoTituloIndice();
var
clav1,pos1,ape, clav, pos, encontrado,DNI: String ;
iguales : boolean ;
aux2, position, i, ent, contador : integer;
begin
ent := 0;
ficheroTitulo.LeerBloque(ent, bloque_E);
i := 1 ;
encontrado := '';
contador:=1;
iguales := false;
position := 0;
DNI:= '';
PedirTitulo(DNI);
c1024_E:=2;
pos1:='';
clav1:='';
while (not iguales) and (contador<999) do
begin
leerRegTituloIndice(ape, clav, pos, ent);
if(pos <> pos1 ) or (clav1 <> clav) then
begin
pos1:= pos;
clav1:=clav;
inc(contador);
end;
compararApellido2(DNI,ape,iguales);
if iguales then
begin
iguales := true;
encontrado := encontrado + clav + pos;
end;
end;
while( i <= length(encontrado) ) do
begin
inc(position);
clav := '';
clav := encontrado[i]+encontrado[i+1];
i:=i+2;
descodificarNumero(clav,aux2);
str(aux2, clav);
ficheroD.leerBloque(aux2, bloque_E);
pos := '';
pos := encontrado[i]+encontrado[i+1];
i:=i+2;
descodificarNumero(pos,aux2);
c1024_E:= aux2;
limpiarRegLogico;
leerRegCod;
mostrarRegPantalla(position);
writeln('Leidos: ',( position + ent +1 ) ,' bloques');
end;
if not iguales then
writeln('Titulo no encontrado');
end;
Procedure leerRegCodDireccionadoTitulo();
Var
DNI,aux : String ;
regristoIgual, final, iguales : boolean ;
clave,bloqueAcaba, contador : integer;
Begin
final := false;
contador := 0;
clave := 0;
regristoIgual := false;
DNI:= '';
PedirTitulo(DNI);
while (not regristoIgual) and (not final)do
begin
c1024_E:= 3;
ficheroD.leerBloque(clave, bloque_E);
inc(contador);
leerCampoLong(aux);
descodificarNumero(aux,bloqueAcaba);
if(clave > 499 ) and (bloqueAcaba = 3)then
begin
final := true;
end
else
begin
while (c1024_E < bloqueAcaba) and not (regristoIgual) do
begin
limpiarRegLogico;
leerRegCod;
compararTitulo(DNI,iguales);
if iguales then
regristoIgual:= true;
end;
inc(clave);
end;
end;
if regristoIgual then
begin
mostrarRegPantalla(1);
writeln('Leidos: ',contador,' bloques');
end;
if final then
begin
writeln('El Titulo no se encuentra entre nuestros articulos.');
writeln('Leidos: ',contador,' bloques');
end;
end;
Procedure leerRegCodDireccionadoApellido1Indice();
var
aux2: longint;
DNI,pos,ape, clav, encontrado : String ;
iguales : boolean ;
ent, contador,position, i : integer;
begin
ent := 0;
ficheroApellido.LeerBloque(ent, bloque_E);
i := 1 ;
encontrado := '';
contador:=1;
iguales := false;
position := 0;
DNI:= '';
PedirApellido(DNI);
c1024_E:=2;
while ( contador < 1000 ) do
begin
leerRegApellidoIndice(ape, clav, pos, ent);
compararApellido2(DNI,ape,iguales);
inc(contador);
if iguales then
begin
encontrado := encontrado + clav + pos;
end;
iguales := false;
end;
while( i <= length(encontrado) ) do
begin
inc(position);
clav := '';
clav := encontrado[i]+encontrado[i+1];
i:=i+2;
descodificarNumero(clav,aux2);
str(aux2, clav);
ficheroD.leerBloque(aux2, bloque_E);
pos := '';
pos := encontrado[i]+encontrado[i+1];
i:=i+2;
descodificarNumero(pos,aux2);
c1024_E:= aux2;
limpiarRegLogico;
leerRegCod;
mostrarRegPantalla(position);
writeln('Leidos: ',( position + ent ) ,' bloques');
writeln('Pulse enter para el siguiente autor.');
readln;
end;
writeln('No existen mas autores con ese apellido.');
end;
Procedure leerRegCodDireccionadoApellido1Titulo();
var
clav2, pos2, DNI,pos,ape, clav, encontrado : String ;
iguales : boolean ;
p, o, ent, contador,position, i : integer;
begin
ent := 0;
ficheroApellido.LeerBloque(ent, bloque_E);
i := 1 ;
encontrado := '';
contador:=1;
iguales := false;
DNI:= '';
PedirApellido(DNI);
c1024_E:=2;
while ( contador < 1000 ) do
begin
leerRegApellidoIndice(ape, clav, pos, ent);
compararApellido2(DNI,ape,iguales);
inc(contador);
if iguales then
begin
encontrado := encontrado + clav + pos;
end;
iguales := false;
end;
position := ent;
ent := 0;
ficheroTitulo.LeerBloque(ent, bloque_E);
c1024_E:=2;
o:=0;
while( i <= length(encontrado) ) do
begin
inc(o);
inc(position);
clav := '';
clav2 := encontrado[i]+ encontrado[i+1];
i:=i+2;
pos2 := encontrado[i]+encontrado[i+1];
i:=i+2;
iguales := false;
writeln(o,' autor');
while (not iguales) do
begin
leerRegTituloIndice(ape, clav, pos, ent);
if(pos = pos2 ) and (clav2 = clav) then
begin
p:=0;
while (pos = pos2) and (clav = clav2) do
begin
inc(p);
writeln(p ,' titulo : ', ape );
leerRegTituloIndice(ape, clav, pos, ent);
iguales:= true;
end;
end;
end;
writeln('Pulse enter para mostrar el siguiente regristo.');
readln;
end;
writeln('No existen mas autores con ese apellido.');
writeln('Bloques leidos', ent + position );
end;
Procedure leerRegCodDireccionadoApellido1();
Var
DNI,aux : String ;
regristoIgual, final, iguales : boolean ;
clave,bloqueAcaba, contador,x : integer;
Begin
final := false;
x := 1;
contador := 0;
clave := 0;
regristoIgual := false;
DNI:= '';
PedirApellido(DNI);
while (not final)do
begin
c1024_E:= 3;
ficheroD.leerBloque(clave, bloque_E);
inc(contador);
leerCampoLong(aux);
descodificarNumero(aux,bloqueAcaba);
if(clave > 499 ) and (bloqueAcaba = 3)then
begin
final := true;
end
else
begin
while (c1024_E < bloqueAcaba) do
begin
limpiarRegLogico;
leerRegCod;
compararApellido(DNI,iguales);
if iguales then
begin
regristoIgual := true;
mostrarRegPantalla(x);
writeln('Leidos: ',contador,' bloques');
inc(x) ;
writeln('Pulse enter para continuar la busqueda');
readln;
end;
end;
inc(clave);
end;
end;
if regristoIgual then
begin
writeln('No hay mas autores con ese nombre.');
writeln('Leidos: ',contador,' bloques');
end
else
begin
writeln('El autor no se encuentra en nuestra base de datos.');
writeln('Leidos: ',contador,' bloques');
end;
end;
Procedure leerRegCodDireccionadoNombre();
Var
DNI,aux : String ;
regristoIgual, final, iguales : boolean ;
clave,bloqueAcaba, contador,x : integer;
Begin
final := false;
x := 1;
contador := 0;
clave := 0;
regristoIgual := false;
DNI:= '';
PedirNombre(DNI);
while (not final)do
begin
c1024_E:= 3;
ficheroD.leerBloque(clave, bloque_E);
inc(contador);
leerCampoLong(aux);
descodificarNumero(aux,bloqueAcaba);
if(clave > 499 ) and (bloqueAcaba = 3)then
begin
final := true;
end
else
begin
while (c1024_E < bloqueAcaba) do
begin
limpiarRegLogico;
leerRegCod;
compararNombre(DNI,iguales);
if iguales then
begin
regristoIgual := true;
mostrarRegPantalla(x);
writeln('Leidos: ',contador,' bloques');
inc(x) ;
writeln('Pulse enter para continuar la busqueda');
readln;
end;
end;
inc(clave);
end;
end;
if regristoIgual then
begin
writeln('No hay mas autores con ese nombre.');
writeln('Leidos: ',contador,' bloques');
end
else
begin
writeln('El autor no se encuentra en nuestra base de datos.');
writeln('Leidos: ',contador,' bloques');
end;
end;
Procedure leerRegCodificadoEnDireccionado();
Var
nom,ap1,ap2,aux, auxiliar :String;
clave,bloqueAcaba,num, numclave : integer ;
regristoIgual, iguales : boolean;
Begin
nom:='';
ap1:='';
ap2:='';
regristoIgual:= false;
PedirInformacion(nom,ap1,ap2);
conseguirClave(nom,ap1,ap2,clave);
while ( clave <> -1 ) and not (regristoIgual) do
begin
ficheroD.LeerBloque(clave, bloque_E);
leerCampoLong(aux);
descodificarNumero(aux,num);
bloqueAcaba := num;
if (num = 3 ) then
begin
writeln('Regristo no existente.');
end
else
begin
c1024_E:=3;
while (c1024_E < bloqueAcaba) and not (regristoIgual) do
begin
limpiarRegLogico;
leerRegCod;
comparar(nom,ap1,ap2,iguales);
if iguales then
regristoIgual := true;
if ( c1024_E = bloqueAcaba ) and not (regristoIgual) then
begin
leerDesbordado(auxiliar);
descodificarNumero(auxiliar,numclave);
if(numclave <> 0 ) then
begin
clave := 499 + numclave;
end
else
begin
clave:= -1;
end;
end;
end; {while}
end;{if}
end;{while}
if regristoIgual then
begin
mostrarRegPantalla(1);
end
else
begin
writeln('Autor no existente. ');
end;
end;{metodo}
Procedure leerRegistoCodificado;
VAR contador:integer;
Begin
c1024:=0;
control:=TRUE;
try
fichero.abrir('C:\Temp\ficheros\serial.txt');
except
WriteLn('Se ha producido un error');
ExitCode:=1;
end;
fichero.leerbloque(bloque);
limpiarRegLogico;
leerRegCod;
contador:=1;
WHILE control DO
BEGIN
mostrarRegPantalla(contador);
limpiarRegLogico;
leerRegCod;
readln;
inc(contador);
end;
writeln('Todos los registros han sido mostrados');
End;
Procedure consultar;
Var
opcion:byte;
BEGIN
dibujarMenu2;
readln(opcion);
If (opcion<1)OR(opcion>7)then
writeln('Opcion incorrecta.')
else
begin
case opcion of
1:leerRegCodificadoEnDireccionado;
2:leerRegCodDireccionadoDNI;
3:leerRegCodDireccionadoTituloIndice;
4:leerRegCodDireccionadoNombre;
5:leerRegCodDireccionadoApellido1Indice;
6:leerRegCodDireccionadoApellido1Titulo;
7:;
end;
end;
END;
Procedure ejecutarMenu;
Var
opcion:byte;
BEGIN
Repeat
dibujarMenu;
readln(opcion);
If (opcion<1)OR(opcion>4)then
writeln('Opcion incorrecta, elija una opcion valida.')
else
begin
case opcion of
1:abrir;
2:direccionar;
3:Consultar;
4:begin
writeln('El usuario ha decidido abandonar la aplicacion. Adios');
ficheroD.Cerrar();
end;
end;
end;
Until opcion = 4;
write('Fin');
readln;
END;
begin {programa principal}
c1024:=0;
control:=TRUE;
ejecutarMenu;
WriteLn('Presione ENTER...');
end.