y
E-ma-> webmaster' ¡a'
-
Labúsquedabinariasepuedeaplicar.enestructurasdedatosquepermitenaccesodire¡.
porloquesepu"o"u,u,"nltsficherosbinariosqueesténalmacenadoSeflsoptlf: direccionables'
"''1"'T-":l :::: 1,: #;"1''*á-*'":T:""',."fi o,o,i"",lJlff Hil:"X,:::.:ff
;.J:*Htero
b in ar
io que
alm
ac en
i::il:::#;:H1: [',::?i:ilffi;,r
;"i
:,.'
]':":t:;"n,T:X[i": J"J:J:,:::J:::"""0:'"
:::i:::ff::ti;li;lliil],' i::lli:,"$:1,"J;ii1xÍl;til?"il1;':il:*trl,:^T:::tH"J::':X?i#:Tl; #ffiil:*:l*::11;;"1'";1[:' ','J:'J,1?.:r;:X1""$?#"'ilX"'*f utilizando bús' e:
T i?:il:ll:?:H#::T[::,Tü:Ttl'*" binario'
o"nas consultas
1a
-'
¿i.trtc,*i.u sobre el propio f,chero
10.8.11 RuPturas de control En
algunos problemas e1
consta de más de un reg fichero que se quiere procesar
'
lógicoconelmismot"t"nunoouu'io'd"'o'campos'Además'elflcheroeste': de todas 3Q.-: nadoporunodeu.n",.*,o"sY'eventualmente'ensegundootercerlugarpor... tipo de información o resumen objetivo.'"i" El '"'"oU"*t "fé¡fl *i1t"1v|1r en alguno de sus campos' componente. oo" tornpu't"n "t rorventas d: de las lnlormaclutr LrL
"'":T::::if¿ffiÍ#['
toil'io'*ución stb , Sea un fichero con contrene información Cada componente de1 flchero zonas' por -' rea" ha que geográficamente código de la zona. en la producto vendido
"*, "i"o¿rgo y las unidad.; ;ilff-
de1 producto,
::l|-* los produi !f ; t:T:: ::::"":::"T::3","[1 de zona' va que todos :iffi[J:::i#ffi:"Tffiffi"i;u,";;;d"
1a
venra
r.enden en todas las zonas'
1.
prr'-:de zona' escriba un está ordenado por código fichero el que Suponiendo que obten ga .., vendidas e n "' v'otuid" unidades
i:;il :lt::l*,,,'JT,'::il ;il^'"
*: iJ:, ::[::J':i"?ffi #;il; zona.
Tl.#::;
Sor,ucroNrs 2.
355
Suponiendo que el fichero está ordenado por código de zona y, dentro de cada zona, por código de producto, escriba un programa que obtenga un informe por pantalla de las unidades vendidas. El informe deberá tener una línea por cada zonay producto dentro de esa zona. Cuando se acabe una zona se indicará, en otra línea, el total de unidades vendidas enla zona.
10.9
Soluciones
10.9.1 Copia
,
de ficheros de texto
Se van a plantear dos soluciones pafa
tealttzr la copia de un flchero de texto.
1. La primera solución copia el flchero origen en el destino leyendo y escribiendo catácter acarácter, sin tener en cuenta las líneas. PROCEDURE
CopiaCaracterAcaracter(VAR FOrg, FDes: text)
;
VAR ¡¡r.
¡hzr.
BEGIN { CopiaCaracterACaracter
}
reset (FOrg) ; rewrite (FDes) ; WHILE NOT eof (FOrg) D0 BEGIN read (hOrg, car) ; wrrte (f'ljes, car ) ;
,y
close (FOrg) ; cfose (FDes) ; END; {CopiaCaracterACaracter}
l.
Esta segunda solución copia el fichero origen en el destino considerando tanto caracteres como líneas.
PROCEDURE
CopiaCaracterYlinea(VAR FOrg, FDes: t-ex:
VAR
car: char; BEGIN i CopiaCaracterYLinea) reset (FOrg) ; rewrlte (t'Des) ; WHILE NOT eof (FOrg) DO BEGIN
IIIHILE
not eoln(FOrg) D0 BEGIN read(FOrg, car); write (FDes, car)
;
Frcnnnos
356
END;
writeln
(FDes)
;
readTn(rorg); END; - l^aó
END
;
l['r)rñl \l v!f
/ ,
lL'llaq Dee \L
I l
. .
I
lCopiaCaracterYLrnea)
El programa completo: PROGRAM
CopiarF icheroTdxto
;
VAR
FOrigen, FDestíno: text; correcto: boolean; nombre: string; FUNCTION
BEGIN
Existe(VAR
fichero: text): boolean;
iexiste) {sr-}
reset (fichero)
;
ler-l IY- ' Existe := (IOResult = 0); ]
END; {existe} PF.CCEDURE
PedirFicheroOrigen(VAR FOrg: correcto: boolean);
text;
VAR
VAR
caT
i
Cha::;
nombre
: st::i:rg;
BEGIN REPEAT
CorIeCto := TRUE; write ('Escribe el nombre del fichero ' , 'que quieres copiar: ' ) ; readln (nombre) ; assign (FOrg, nombre) ;
IF
NOT EXiSTC (FOTg) THEN BEGIN
writeln('El fichero no se encuentra', ' (pulse cualquier tecla Para seguir o S para salir)') ; read (car)
;
COTTECTO
:=
FALSE;
Sor,ucroNns
357
END;
UNTIL correcto OR (upcase(car)
= 'S,);
END;
PedirFicheroDestino (VAR FDes: t.ext; VAR L§\\qqL§'. \ss\qa\\',
PROCEDURE
\\R =r§:--- *S§--\
noml¡re: sLring; DEñTIT D!UAI\
REPEAt'
correcto := TRUE; write('Escribe el nombre del fichero copia: ,); readln (nombre) ; :oo.i¡¡ (FDes, nOmbre) ; IF Existe(FDes) THEN BEGIN
writeln ('El fichero copia existe (pu1se R , , 'para reescribirlo, S para salir)'); read (car)
;
lF Upcase(car) <> 'R' correcto := FALSE;
THEIV
END;
UNTIL correcto OR (Upcase(car) ItrIn
IROCEDURE -
= 'S');
.
CopiaCaracterACaracter(VAR FOrg, FDes: text)
-1D
car: char; SfGIN {CopiaCaracter} reset (FOrg) ; rewrlte (lDes) ; WHILE NOT eof (FOrg¡ D0 BEGIN read(FOrg, car); wrl_te (hljes, car) ; END;
close (FOrg);
:lose
r.--
(FDes)
;
, iCopiaCaracter)
:: -::DURE CopiaCaracterylinea :_:
':-. . ¡h=r
.
(VAR
FOrg, FDes: text)
;
;
Flcnonos
358
BEGIN { CoPiaCaracterYLinea
}
¡
(t"Org)
; reset rewrite(bDes); hIHILE NOT eof (Forg) D0 BEGIN WHILE not eofn(FOrg) D0 BEGIN read(FOrg, car); write (FDes, car)
P
v,
!L
END;
writeln 1f»es) ; readln (FOrg) ; END;
close tFOrg)
¡
c,Lose (¡'Des )
;
/
END; iCoPiaCaracterYLinea) BEGIN {Programa
PrinciPal}
PedirFicheroOrigen(FOrigen' correcto)
IF correcto
;
THEN BEGIN
PedirFicheroDestino (FDestino' correcto)
IF correcto
;
THEN
CopiaCaracterACaracter ( F0rigen' FDestino); (FOrigen' FDestino) ) {o CopiaCaracterYLinea
END;
END. {lrograma PrinciPalJ
10.9.2 Sustitución y recuento de vocales PROGRAM
SustituirYContarVocales
;
VAR l^vi-^.
PROCEDURE
iovl
:
Almacenar (VAR fTexto:
text);
i/AR
car : char; i:3IN {elmacenar} :ewrite (fTexto)
;
,.;:tte1n 'Escribe el- texto: ' ) ; :.: ?IAT read (car) ; -: car <> chr(13) THEN (
tfTexto, car) ; "',:-:e chr(13); :a: -,1,---
E¡ END;
wri
t:
SorucloNns
359
close (fTexto); :i.); {almacenar} -:iOCEDURE
Most.rar (VAR fTexto: t.ext)
;
--R
¡¡r.
¡h¡-.
contA, contE, contI, conto, contU: inLeger; ::GIN {Uostrar} cont.A : = 0; contE : = 0; ^^ñlT
..-
u; ^
contO : = 0;
contu ,= A;' reset (fTexto); WHILE NOT eof (fTexto)
DO BEG]N
read (fTexto, car); CASE car 0F ,4, ,,A, : BEGIN
contA := contA + writ.e (, ,) ¡
1,.
END; tFt
/ó/. e
.
DEñTIT Dlgal!
contE := contE + 1; write (, ,) ;
,I, ,,i, :
END;
BEGIN
contl := ConLf + write (, _,) ; END;
'a' ,'o' :
BEGIN
contO := conto writ.e (, _,) ;
+
END;
,U,
,,U,:
BEGIN
contU := conLU + 1; write (, ,) ; END; ELSE
write (car) trI\Tn. !a!u/ f^-^^i luqDEJ
IND; {whilei ,,;riteln;
;
Frcnnnos
360
writeln writeln writeln writeln writeln
('La a ('La e ('La i ('La o ('La u
close (fTexto) END; {fUostrar}
aparece aparece aparece aparece aparece
'rccntA, ' veces'); ' , contE,
,
' ¡nnl
' veces');
T
' , conLo, 'rcontU,
,
rra¡ac,\. vU99,
/,
¡ra¡ac/\. vueru
/ /
' veces');
;
principal} (texto,'texto.txt' assign
BEGIN {Programa Almacenar
(texto)
)
;
;
writ.eln('El texto sin vocales y las est.adisticas' ' de aparicion de cada UIld Sofl: /); Mostrar (texto) END. {Programa principal} .
10.9.3 Encontrar los más jóvenes PROGRAIvI
LosNMas,Toveses
;
CONST
N = 10; TYPE
TRegistro =
RECORD
apellidos: stríng[35J ; nombre: string[20] ; dni: strinS [9] ; anioNacimiento: integer;
direccion: string[35J ; codigoPostal: string[5] ciudad: string [20] ;
;
END;
TFichero = FILE OF TRegistro; TArray = ARRAY [1..N] OF TRegistro; TEstructuraArray = RECORD ]-^ñ^,
ñ U..!\/\T,
datos: Tarray; :.
-_.
I
=:-:: ; jl : l;.=---stro;
f,
C
SolucroNns nj ovenes EIJI\TCTION
BEGIN
: TEstruct.uraArray;
Existe (VAR f ichero: TFichero)
{existe} {$r-} reset (fichero)
:
;
{$r+}
Exrste := (IOResuIr = 0); close (fichero) ; END; iexiste) PROCEDURE
CalcularNMasJovenes (VAR agenda: TFichero; VAR nMenores: TEstructuraArray)
;
VAR i
i. . )
.in1-aaa-. tlruuYUr
/
esMenor: boolean; encrada: TRegistro; BEGIN { CalcularNMasJovenes reset (agenda) ;
}
nMenores.tope := 0; WHILE NOT eof (agenda) DO BEGI}J read (agenda, entrada) ; IF nMenores.tope < N THEN BEGIN nMenores. t.ope : = nMenores. tope + 1; nMenores. datos lnMenores . tope] . anioNacimienLo : =
MAXINT
END;
)' r
.-
ll
.
esMenor
:=
FALSE;
REPEAT
j := j + 1; IF entrada. anioNacimient.o
<
nMenores . datos I j
I . anioNac_:_.:_-_ l
THEN BEGIN
esMenor
:=
TRUE;
i i= nMenores.tope DOWNTO j*1 ¡: nMenores.datos Ii] := nMenores.oa:_= ._--_ nMenores.datos Ij] := entrada; FOR
END;
LINTIL (j = nMenores.tope) OR (esMenor = END; iwuri,e) close (agenda) ; :l:l ; { CalcularNMasJovenes i
[rue.;
;
FrcuBnos
ról
,: - ::-]URE MostrarNMasJovenes
(nJovenes
:
TEstructuraArray)
;
.:_:
A U
::l:N
PI
I\I . ' ' !r ,
{MostrarNMasJovenes
}
nJovenes'tope DO BEGIN FOR write (nJovenes'datos Iil 'apel]idos:35)
i:= 1
TO
VA
;
wrj-te (nJovenes 'd'atos lil 'nombre:20) ; write (nJovenes 'datos Ii] 'dni:10) ; write (nJovenes 'datos Ii] 'anioNacimienLo:5) writeln;
;
END;
END;
{MostrarNMasJovenes}
BEGIN {Programa
PlinciPati
assign(agenda,' agenda'dat' ) ; IF Existe (agenda) THEN BEGIN
calcularÑtqasJovenes (agenda' nJovenes) MostrarNMaSJovene s (nJovenes )
;
;
E}\D
ELSE
,,,riielnt'EI fichero agenda.dat no existe')
;
ú\Tn I Proorama PrinciPal] !!\!.
t_--J
10.9.4 Yisualizar fichero con imagen PROGRAM
LecturalmagenRaw
CONST ñvm-lr=rtl, [Af -
TYPE
;
|
TFicherolma$en = FILE ob DYte; TNombreFichero = string [501 ;
'.-iR
ancho, alto: integer; correcto: boolean; :,cherolmagen : TFicherolmagen ; a
-'- -"r
^tsó/IIAR - . - --r É)tI5Ls\r --., -to\
fichero:
----*.--l
:--j
1:s.: fichero) :--l
;
TFicherolmagen)
: boolean;
JE
Sor,ucroNns
363
Existe := (IOResuIt = 0); {
exi ste
?ROCEDURE
}
fichero:
PedirDatoslmagen(VAR
TFicherolmagen;
VAR ancho, alto: integer; VAR correcto: boolean) ; -,:AR
n:v.
¡h¡r.
nombre
:
TNombreFichero
;
:EGIN { nediroatostmagen} REPEAT
COTTECTO
:
=
TRUE;
write('Ruta y nombre de Ia imagen sin extension', (.raw):'); Í readln (nombre) ; nombre := nombre + EXT; assign (fichero, nombre) ; IF Existe (fichero) THEN BEGIN
write('Anchura: ')
;
readln(ancho);
write('Altura:'); readln (alto)
;
END
ELSE BEGIN
writeln('El fichero no se encuentra (Pulse ', 'una tecla para seguir o S:Salir)'); read (car)
;
correcto : = FALSE; END;
l,'}JTIL
:.
correcto 0R (Upcase (car) ='g'¡
'
1; {ledirnatoslmagen}
.:ICEDURE
PintarPixel (pix: byte)
r,IN i eintarlixel write(pix:3); -; ilintareixel)
:
;
)
ErrorlecLura(comp_x, comp_y: integer) .. IIN { ErrorLectura } ::ICEDURE
;
'.'-.i ral¡.
writeln('Error de lectura en efemento: ',
comp
x, ',',
FrcnBnos
364
comp_y)
;
writeln ('aborfada la ej ecucion del programa ' ' ) END; {Errorlectura} FLIíCTION LecturaCorrecta (ancho,
alto: integer;
VAR
fRaw: TFicherolmagen) :boolean;
VAR i nl aaov --'--t--i lnt¡t tv a . pf t
--t t. r. val PL^v!.
fallo: boolean; BEGIN
{lectura}
reset (fRaw) ;
fallo := FALSE; ., ^ ,, |
..._ '-
1. r, 1. -t
(x <= alto) AND NOT fallo DO BEGIN writeln; WHILE (y <= ancho) AND (not eof (fRaw) ) D0 BEGIN read (fRaw, Pixel) ; pintarPixel (Pixel) ; ¿ y := y+1;
WHILE
END;
rF eof (fRaw) AND (y <= ancho) THEN BEGrN errorlectura (x, y) ; fallo := TRUE; END;
y:=
1_;
x+1; END;
LecturaCorrecta :=
NOT
falIo;
close (fRaw) ;
end; {rrN }ectura} FinalExito; BEG]N {rinalExito} PROCEDURE
','-.iraln.
writeln ('Fin de programa con exito' ) ; writeln('Alejate para ver el resultado') Il.iD
; irinalrxito
PRCCEDURE
BEGIN
)
FinalFalIo;
{ rinalrallo}
;
Sor,ucroNBs
365
writeln ('Fin de programa con errores, iND; {rina}ral1o}
)
;
:EGIN {Programa principal} PedirDat.oslmagen(ficherolmagen, ancho,
alto, correcto) ; IF correcto THEN IF LecturaCorrecta(ancho, a1to, ficherolmagen) THEN finalExito ELSE
f ra¡¿l l r-
:.,U.
t
inalFallo;
.
Programa
prrncrpal
J
10.9.5 Partición de un flchero binario
\
continuación de detallan las soluciones de la partición de un fichero de acuerdo a los -i¡tintos criterios.
Partición de un fichero binario por contenido .
: IGRAM Part icionFicheroBinarioContenido
;
'_:5
TRegistro =
RECORD
apellidos: string nombre: string[20J dni: string [9] ;
[351
;
;
direccion: string[35] ; codigoPostal: string [5J ; ciudad: stringl20J ; turno: char; :\Tn :
.
-tichero = F]LE
OF
TRegistro;
-i:igen, fMagnana, fTarde: TFichero; -=:Logico: TRegistro; ParticionContenido (VAR fOrg, fMan, flal:
r=j: TRegistro; ,'
Part i c ionContenido
:eset (f0rg)
;
:ewrite (fMan) ;
)
-: _::=ro,
;
Frcnnnos
366
rewrite (fTar)
;
(forg) DO BEGIN (fOrg, reg) ; read IF reg.turno = 'M' THEN write (fMan, reg)
WHILE NOT eof
ELSE
write (fTar, reg)
;
END; {wttrlri close ( fOrg) ; close (fMan) ; close (t'Iar) ; END
; {ParticionContenido}
BEGIN IPrograma principa]) assign (fMagnana,' turnoMagnana.bin' ) ; assign (fTarde, 'turnoTarde.bin' ) ; assign (fOrigen, 'TodosTurnos.bin' ) ; ParticionContenido (fOrigen, fMagnana, fTarde) -1 EjNlJ. t Programa prlncrpal.f
;
Partición de un fichero binario en secuencias de longitufN PROGMM Part i
c
ionFicheroBinarioSecuenc iasN ;
TYPE
TRegistro =
RECORD
apellidos: string[35] nombre: string [201 dni: string [9] ;
;
;
direccion: string[35] ; codigoPostal: string [5] ; ciudad: string[20J ; turno: char; END;
':-:.
TFichero = FILE 0F TRegistro;
:irigen, fPartl, fParL2: TFichero; :=r-ogico: TRegistro; -_-
_=JcL
t
.:.,,:--:.1 ?a::rcionSecuenciasN(VAR f0rg, fPar1, fPar2: TFicherc, n: integer); -.-_::_
SolucroNrs
367
reg: TRegistro; conr: inCeger; cambio: boolean; BEGIN { Particl-onSecuenciasN}
reseL (fOrg) ; rewrite (fPar1) rewrite (fPar2) Camb1o
:=
; ;
TRUE;
ñnnl .n. . vt WHILE NOT eof
(forg)
D0 BEGIN
read(fOrg,reg);
IF
cambio
THEN
write ( fPar1, reg) ELSE
write (fPar2, reg) ; Cont := cont + 1; IF cont = n THEN BEGIN cambio := NOT cambio; cont := 0i END;
:l
l;
END; {wurle} close (fOrg) ; cfose (fPar1) ; cl-ose (f Par2 ) ; { ParticionSecuenciasNi
:: :IN
:-:. : -
I
t
Programa prInClpa-L
)
assign (fPart1,' fPartl.bin' ) ; assign (fPart2 ,'fParL2.bin' ) ; assign (fOrigen, 'afumnos.bin, ) ; writ.e('Teclea eI valor de N: ,\; readln (n) ; Part.icionSecuenciasN (fOrigen, f Part1, fparL2, n) iPrograma principal]
;
¡rtición de un fichero binario en secuencias ordenadas I - lzu\M ParLicionFicheroBinarioSecuenciasOrdenaCas '-l _:_
TRegistro =
RECORD
apellidos: string
[351
nombre: string [20J ;
;
;
Frcnnnos
368
dni: string[9J ; direccion: string[35J ; codigoPostal : string [51 ciudad: string[20J;
turno: char; END;
TFichero = FILE OF TRegistro; VAR
fOrigen, fPar[l, fParL2: TFichero;
PROCEDURE
ParticionSecordenadas
(VAR
fOrg, fParl
,fPar2: TFichero)
VAR
regAnt, regAct: TRegistro; cambio: boolean; BEGIN { rarticionSecOrdenadas
reseL (forg) ; rewrite (fPar1) rewriLe (fPar2)
}
t
; ;
:ambio := TRUE; ::c.lrt. aPellidos i= ' ' i ,';:---: NCT eof (fOrg) DO BEGIN j---¡ zoaAcj-). ---y/!tYr¡eu/
-..-^i -=:-
/
-: l.: - :egAnt. aPellidos
<=
:1::--- := NOT cambio;
-=
^a--_
^
_-_-:_,
'i:-:::Pa:-,
regAct)
ELSE
wrire :?er'-, :egAct); rreaAnl sYñ]r
u
.=
-cfA-'
END; {wttri,r} close (fOrg) ; cfose (fPar1) ; close 1fPar2) ; E\D; {ParticionSecOrdenadas}
BEGII\ {Programa PrinciPal} asslgn fParcl, 'fPartl.bin' ) ; assLgn fParL2, 'F.ParL2.bin') ; assign (fOrigen, 'alumnos.bin' )
regAct
.
apellidos)
THEN
;
Sor,ucroNns
369
(f0rigen, tPartl, fPart2) principal)
Partici-onSecOrdenadas
END.
{Programa
10.9.6 Fusión
;
de flcheros binarios
El punto crítico de la fusión de dos ficheros es garantizar que se procesan todas la componentes de ambos. Con un control convencional de la salida de los bucles qu realizan la lectura secuencial de los ficheros, a través de eof ( ), se puede quedar e
último registro de cada uno sin procesar. Por el1o, la solución que se propone utiliza u: procedimiento específico para realizar la lectura de los ficheros, y el control de detecció del fin de cada uno se realiza a través de sendas variables booleanas. PROGRAM
FusionDosFicherosBinarios
;
TYPE
TDATOS
=
RECORD
nombre: string[20J
;
apellidos: string[35J I
;
END;
TReqistro =
RECORD
clave: rnteger; datos: TDatos; END; -,.AR
TFi-chero = FILE 0F TRegistro;
fFusion, f1, f2: TFichero; reglogico : TRegistro; ;ROCEDURE
LeerFichero (VAR fichero: TFichero; VAR registro: TRegistro; VAR fin: boolean);
:iGIN {leerfichero} IF NOT eof (fichero)
THEN
read ( f ichero, regisLro) ELSE
fin := TRUE; :i.lJ; tLeerF'].cnero] ¡
:ICEDURE FusionFicheros(VAR '.r1,
tL, 12: TRegistro; fin1, fin2: boolean; :::IN
f1, f2, fFus: TFrchelc
;
310
Frcurnos
rewrite (fFus) reset (f1) ; reset (f2) ; €] !r11r -1
,-
. -
;
f:lao. Lq¿re,
f:.n2 := false; LeerFichero(f1, 17, finl) LeerFichero (f2, 12, fin2) IdHILE NOT
finl-
AND NOT
; ;
fin2
IF 11.clave <= 12.clave write(fFus, r1) ;
D0 BEGIN THEN BEGIN
LeerFichero(f1, T7, finl)
;
END
ELSE BEGIN
wrice (fFus, 12) ;
LeerFichero(f2, 12, ftn2)
;
END; }
{wHrf,r} WHILE NOT finl
END;
DO BEGIN
write (fFus, r1) ; LeerFichero
f1, T7, finl
)
;
=r:Fichero (f2, 12, fin2)
;
(
E\TN.
WHILE NOT fin2 DO BEGIN i;:ite (f Fus, 12) ; -
:l.l: --_:= -- *: ¡l aca
f I
END; {Fusron;-c:r=::s
prrncrpali assign(f1, 'f1.bin"; assign(f2, 'f2.bin'); assign(fFusion,' fusi-on.bin' ) ; FusionFicheros (f1, f2, fFusion) - _\J. Programa prlnclpaI.l t
BEGIN {Programa
l-
-
10.9.7 Ordenación ?LCGLAM
\
de un fichero por mezcla directa
0rdenacionMezclaDirecta
TYPE
TRegisrrc =
RECORD
;
Sor,ucroNns
codigo: string[10] ; denominacion: strinq
[3
311
0]
;
END;
TFichero = FILE OF TRegistro;
fOrigen, fPartl, fparL2: TFichero; regLoglco :'I'Reglstro; PROCEDURE
ParticionSecuenciasN (VAR fOrg, fpar1, fPar2: TFichero; n. rr¿uuYUr i nl-a¡a-\ ra.
'iaR
,
/ /
reg: TRegistro; cont : int.eger; :
cambio: boolean; IIIN { narticionSecuenciasN} . reset (fOrq) \- --, " rewrite (fpar1) ; rewrit.e (fpar2\ ; cambio := TRUE; aónl . = n. WHILE NOT eof (fOrg) D0 read (fOrg, reg) ; IF cambio THEN write (fpar1, reg)
BEGIN
ELSE
write (fpar2, reg) ; cont := cont + 1; IF cont = n THEN BEGIN cambio := NOT cambio; Cont : = 0; END;
:,
-,
END; {wHrlo} close (f0rg) ; close (fparf) ; close (fPar2) ; {ParticionSecuenciasN}
:--I:)URE Leer(VAR f: TFichero;
VAR r: TRegistro; VAR fin:boolean);
-:
eof
(f)
read (f
, r)
NOT
THEN
)tz
f,'rcnnnos ELSE
fin :=
TRUE;
END; PROCEDURE
FusionSecuenciasN(VAR
fOrg, fParl, fPar2: TFichero; n:
Iongint)
;
IIi:
regF1, regF2: TRegistro;
finl, fin2: boolean; contFl, contF2 : lonqint.; :E1T\T J !g II\
rewrite (fOrg) ; reset (fPar1) ; reset lfPar2) ¡ finl : = false; fin2:= false; Leer(fParr1, regF1, lint) Leer ( fParL2, regF2, fin2\
; ;
conlF'T .- n. .^nlF', .= n. . vl WHILE NOT
finl
OR NOT
fin2
DO BEG]N
fin2 AND (contFl < n) AND (contF2 < n) D0 BEGIN IF regF1. codigo <= L:e9F2. codigo THEN BEGIN
WHILE NOT
finl
AND NOT
write (fOrg, regFl) ; Leer (fPart1, regF1, finl) contFl := cont.Fl + 1;
;
END
ELSE BEGIN
write (forg, regF2) ; Leer (fPart2, regE2, fin2) contF2 := contF2 + 1;
;
END;
END; {wurlr} WHILE NOT
finl
AND
(contFl < n) D0 BEGIN
write (fOrg, regFl) ; Leer(fPart1, regF1, finl) contFl := conLFl + 1;
P] ;
Errn. Í¡ LNJ; TI4HILE] IIHILE NOT fín2 AND (contF2 < n)DO BEGIN write (fOrg, regE2) ;
Leer(fPart2, regF2, fin2)
1
;
T'
.
313
SoLUCToNES
contF2 := contF2 + 1; END; {wurlr} ContFl := 0; ContF2 : = 0; END; iwiirln i close (f0rg) ; close (fPartf)
;
close(fParL2); :. --t
.
.:SCEDURE
.-:
MezclaDirecta(VAR fOrg, fPar1, fPar2: TFichero)
reg: TRegistro; n, numRegistros: longint; ::lIN {MezclaDirecta} lr
.-
h
.-
r, f
.
i
I
reseL (fOrg) ; numRegistros := filesize(fOrg) ; close (fOrg) ; WHILE n < numRegistros DO BEGIN ParticionSecuenciasN (fOrg, fParl , fPar2, n) FusionSecuenciasN (fOrg, fParl , fPar2, n) ;
n:=n*2;
:,,);
END; {wurle}
iMezclaDirectai
:: -:IN t Programa prrnclpal l_
-
\ J
assign(fPart1,' fPartSl.bin' ) ; assign(fPart2,' fPartS2.bin' ) ; assign (fOrigen, 'afumnos,bin') ; MezclaDirecta (fOrigen, fParLl , fParL2)
:.
-.
l_
tPrograma prlnclpar
;
1
]
1U.9.8 Ordenación de un fichero por mezcla natural .
: IGRAM OrdenacionMezclaNatural
;
. _'?E
TRegistro =
RECORD
codigo: string[10]
;
denominacion: string [30J ; END;
TFichero = FILE OF TRegistro;
;
;
FICHERoS
314
VAR
VAR
fOrigen, fPartl, fParL2: TFichero; reglogico: TRegistro; PROCEDURE
ParticionSecOrdenadas (VAR fOrg, fParl
,fPar2: TFichero)
;
VAR
regAnt, regAct: TRegistro; cambio: boolean; BEGIN { ParticionSecOrdenadas
}
reset (fOrg¡ ; rewrite (fPar1) ; rewrite (fPar2) ; cambio := TRUE; regAnt.codigo i= ";
eof(fOrg¡ D0 BEGIN read (fOrg, regAct) ; IF NOT (regAnt.codigo <= regAcL.codigo) cambio := NOT cambio; IF cambio THEN write (fPart, regAct)
WHILE NOT
THEN
ELSE
write (fPar2, regAct) regAnt := regAct; END; {wurlu} close (f0rg) ; close (fPar1) close (fPar2)
;
; ;
END; {ParticionSecOrdenadas}
PROCEDURE
f: TFichero; VAR r: TRegistro; VAR fin: boolean);
Leer(VAR
BEGIN
IF
NOT
eof
read
(f)
THEN
(f, r)
ELSE
fin := true; END; PROCEDIIRE
FusionSec0rdenadas (VAR
fOrg, fParl , fPar2: TFichero)
;
DEñ DEU
Sor,ucroNBs
375
regF1, regF2: TRegistro;
fin1, fin2: boolean; :
codAntFl, codAntF2: strj-ng[10J jGIN { FusionSecOrdenadas } rewrite (fOrg) ; reset (fPar1) ; reset (f"Par2) ;
;
finl := FALSE; ftn2 := FALSE; Leer(fPart1, regF1, finl) Leer(fPart2, regF2, fin2) WHILE NOT
finl
OR NOT
; ;
fin2
DO BEGIN
codAntFl := regFl.codigo; codAntF2 := regF2.codigo; WHILE NOT
IF
finl
AND NOT
fin2
AND (codAntFl- <= regFl.codigo) AND (codAntF2 <= regF2.codi-go) DO BEGIN regF1. codigo <= regF2. codigo THEN BEGIN write (f0rg, regFl-) ; write (regF1. codigo : 3) ;
codAntFl := regFl.codigo; Leer(fPart1, regF1, finl)
;
END
ELSE BEGIN
write (fOrg, regE2) ; write (regF2. codigo:3 ) ; codAnLF2 := regF2.codigo; Leer(fPart2, regF2, fin2\
;
END;
END; {wHrlu} WHILE NOT
finl
AND (codAntFl <=
regFl.codigc :- ::l-l:
write (fOrg, regFl) ; write (regF1 . codigo:3 ) ; codAntFl := regFl.codigo; Leer(fPart1, regF1, finl) END;
t
wHrLE
l
fin2
AND (codAntF2 <= regE2) ; (regF2. wriLe codigo:3 ) ;
WHILE NOT
;
re9F2.cci:gc1 D0
write (forg,
codAntF2 := regF2.codigo; Leer ( fParL2, regE2, ftn2\
;
BEGIN
FICHEROS
316
END; {wurrn} END; {Wtttt u} close (fOrg) ; JIose (IPartr) ; close (fPart2) ;
I),);
{FusionSecOrdenadas}
;::SCEDURE "-
MezclaNatural (VAR fOrg, fParl
, fPar2: TFichero)
;
D
reg: TRegistro; ordenado: boolean;
::GIN {MezclaNatural} ordenado := FALSE; REPEAT
ParticionSecOrdenadas (fOrg, fParl , fPar2) ; reset (fPar2) ; ordenado := (filesize(fPar2¡ = 0); cl-ose (fPar2) ; IF NOT ordenado THEN FusionSecOrdenadas (fOrg, fParl , fPar2) ; LTJTIL ordenado;
:1,-r; {MezclaNaturali ::l:N {Programa princiPali assign(fPart1,' fPartSl.bin'
)
;
assign (fParL2, 'fParLS2.bin') ; assign (f Origen, 'al-umnos . bin' ) ; MezclaNatural (fOrigen, fParLl , fParL2)
-1.-.
;
t-
.l tPrograma prlnclpa.Li
10,9.9 Asistente para crear páginas web ', Programa que asiste en la creación de páginas PROGRAM As
i sLenteWebPersonal
;
PR(
CONST
NIIMIDIOMAS
VA
web personales simples.
= 1;
NIIMEROESTUDIOS
Vzu
=
1;
;f-PE
BEC
TFicheroTexto = text;
= string TDia = 1..31;
THes
[10J
;
Sor,ucroNns
371
TAnio = 1900..2100;
= string[15]; TApellidos = string[30] TFecha = RECORD TNombre
;
dia: TDia; : TMes,. anio: TAnio;
mes END;
TDi reccion=RECORD
calle: string[20]
;
numero: integer;
codigo: string[5] ; localidad: string[15] provincia: string[15J
; ;
END;
TEstudio = string [15] ; TEstudios = array Il..NumeroEstudios] OF TEstudio; Tldioma = string[15]; Tldiomas = arrayIl..NumIdiomas] OF Tldioma; TCurriculum = RECORD nombre: TNombre; apellidos : TApellidos ; fechaNacimient.o
:
TFecha;
direccion : TDireccion; Lelefono: string[9] ;
mail: string[40]; estudiosprevios : TEstudios roromas : Idlomas; foto: string[50] ;
;
'.1
END;
pagWeb
: TFicheroTexto;
curriculum: TCurriculum; PROCEDURE
InicializacionCurriculum(VAR curir: l:l::.culum)
VAR
i . llluUYUr, irra^^-.
BEGIN { fniciatizacionCurriculum} wiLh Curr DO BEGIN
writeln
(
,Nombre : , );
readln(Nombre);
;
Frcunnos
318
writeln ('ApelIidos' ) ; readln(Apellidos); writeln ('Fecha de Nacimiento' write (' Dia: ' ) ; readln ( FechaNacimiento. Dia)
)
;
;
write (' Mes: ' ) ; readln (FechaNacimienTO.
write l' Anio:
')
Mes )
;
;
readln ( FechaNacimiento . Anio)
writeln ('Direccion' write (' calle: ' ) ;
)
;
;
readln (Direccion. CaIle) ; write (' Numero: ') ; readln (Direccion. Numero ) ; write (' Codigo Postal: ') readln (Direccion. Codigo) ;
write (' Localidad: ')
;
;
readln (Direccion. Localidad) write (' Provincia: ' ) ; readln (Direccion. Provincia)
;
;
write('Telefono:'); readln (Telefono)
;
write ('Correo El-ectronico: ' readln (Mait) FOR
)
;
i := 1 TO NumeroEstudios
DO
BEGIN
write ('Estudios Previos '
,
Ii]
)
readln (EstudiosPrevios
;
END;
FOR
i := 1 TO Numldiomas
DO
BEGIN
write ('rdioma ' , i, readln(rdiomas
Ii] );
END;
nombre de
write ('Ruta readln
r'--
f
(F',oto
la foto:
');
)
-¡i ei:l i zacionCurriculum)
.: -l:l-:.1 MostrarEstudios (curr: TCurriculum; n=n. vuY .
TE.r
VAR
cheroTexto)
;
SolucloNe i .
s
319
i nt-aaa-, ¿¡reuYur,
BEGIN {MostrarEstudios} FOR i := 1 TO NumeroEst.udios-1 DO write(pag,,,, curr.Estudiosprevios [i],,,, ) ; f n-,.i r ^ tEvrra mostrar 1a ",', al final del ultimo) write (pag, " , curr.Estudiosprevios [NumeroEstudios] END; iMost.rarEstudios) PROCEDURE
Mostrarldiomas
(curr: TCurriculum;
VAR
pag: TFicheroTexto)
)
;
VAR i .
int-a¡a-. rrluuYUr,
BEGIN {Mostrarldiomas} FOR i := 1 TO Numldiomas-1
DO
write(pag, , ,, curr.Idiomas[i], ,,,)i I n.'i ¡. mostrar Ia ,,, IEVTLd " al final deI ultimo) write (pag, ' ' , curr. Idiomas lNumrdiomasl ) ; END; {Mostrarldiomas} PROCEDURE
CreacionCabecera (curr
: TCurriculurn;
VAR pag: TFicheroTexro
r;
BEGIN {CreacionCabecera}
writeln
, , curr . Nombre, curr.Ape11idos,, , ) ;
(.pag, ,
,
,
END; {CreacionCabecera} PROCEDURE
CreacionCuerpopagina (curr VAR
: TCurriculum; pag: TFicheroTexLo)
BEGIN {CreacionCuerpopagina} writeln (pag,'
Nombre:
Apellidos : , ,
write
curr.Apellidos, , ./pr,)
;
(pag, '
Fecha de Nacimiento
curr.FechaNacimiento .Día,, f ,,
:
,
,
curr.FechaNacimiento .Mes,, f , ) ;
writeln (pag, curr. FechaNacimiento.Anio,,, lpr, write (pag, ,
Direccion :
Ca11e,
)
;
)
;
;
FlcHsnos
380
',',ct)TT.Direccion'Numero" curr.Direccion'Codigo"' ) ; "' writeln (pag, curr.Direccion' Localidad" curr. Direc cion. Provincía,
"'
,
Telefono: ', curr'Tefefono' ,
.lpr,)
;
writeln (pag,'
Correo Electronico
:
,
curr.Mail ,'")' ,curr'Mail ,'
Estudios Previos:' ) ; MostrarEstudios (curr, Pag) ; writeln (Prg, ' .lPr' ) ; write (Pag, '