program Tp_Archivos; uses crt; Const NMax=84; // Maximo de numeros NMed=42; // Mitad de numeros NMin=21; // 1/4 de numeros var Op, Op2, I: byte; //Opciones Menu Y Contador NB, NW, NI, NL: string; //Nombres para los archivos VB: array [1..NMax] of byte; //Vector para datos Byte VW: array [1..NMax] of Word; //Vector para datos Word VI: array [1..NMax] of Integer; //Vector para datos Integer VL: array [1..NMax] of LongInt; //Vector para datos LongInt //------------------------------------------------------------------- Procedure GenArchB (NB:string; VB:array of byte); Var Aux: Byte; FLB: File of byte; Begin randomize; {$I-} Assign (FLB, NB); Rewrite (FLB); For Aux:=1 to NMax do Begin VB[Aux]:= random (200); End; If (IOResult=0) then Begin For Aux:=1 to NMax do Begin write (FLB, VB[Aux]); End; End Else Begin writeln ('Error'); writeln ('Presione una tecla'); readkey; End; close (FLB); {$I+} End; //------------------------------------------------------------------- Procedure GenArchW (NW, NB:string; VW:array of word); Var FLW: File of Word; FLB: File of Byte; Aux, Lee: Byte; GW: Word; Begin {$I-} Assign (FLB, NB); Reset (FLB); If (IOResult=0) then Begin Aux:= 0; Repeat Aux:= Aux+1; read (FLB, Lee); If Lee>99 then GW:= (Lee mod 100) Else GW:= Lee; read (FLB, Lee); If Lee<10 then GW:= (GW*10)+Lee Else If Lee<100 then GW:= (GW*100)+Lee Else GW:= (GW*100)+(Lee mod 100); VW[Aux]:= GW; Until (Aux=NMed); close (FLB); Assign (FLW, NW); Rewrite (FLW); For Aux:=1 to NMed do Begin write (FLW, VW[Aux]); End; End Else Begin writeln ('Error'); writeln ('Presione una tecla'); readkey; End; close (FLW); {$I+} End; //------------------------------------------------------------------- Procedure GenArchI (NI, NB:string; VI:array of integer); Var FLI: File of Integer; FLB: File of byte; Aux, Lee: byte; GI: Integer; Begin {$I-} Assign (FLB, NB); Reset (FLB); If (IOResult=0) then Begin Aux:= 0; Repeat Aux:= Aux+1; read (FLB, Lee); If Lee>99 then GI:= (Lee mod 100) * -1 Else GI:= Lee; read (FLB, Lee); If Lee<10 then Begin If GI<0 then Begin GI:= (GI*10)-Lee; End Else GI:= (GI*10)+Lee; End Else If Lee<100 then Begin If GI<0 then Begin GI:= (GI*100)-Lee; End Else GI:= (GI*100)+Lee; End Else Begin If GI<0 then Begin GI:= (GI*100)-(Lee mod 100); End Else GI:= (GI*100)+(Lee mod 100); End; VI[Aux]:= GI; Until (Aux=NMed); close (FLB); Assign (FLI, NI); Rewrite (FLI); For Aux:=1 to NMed do Begin write (FLI, VI[Aux]); End; End Else Begin writeln ('Error'); writeln ('Presione una tecla'); readkey; End; close (FLI); {$I+} End; //------------------------------------------------------------------- Procedure GenArchL (NL, NB:string; VL:array of longint); Var FLL: File of LongInt; FLB: File of byte; Aux, Lee, Cont: byte; GL: LongInt; Begin {$I-} Assign (FLB, NB); Reset (FLB); If (IOResult=0) then Begin Aux:= 0; Repeat Aux:= Aux+1; Cont:= 0; repeat Cont:= Cont+1; Read (FLB, Lee); If Cont=1 then Begin If Lee>99 then GL:= (Lee mod 100) * -1 Else GL:= Lee; End Else Begin If Lee<10 then Begin If GL<0 then Begin GL:= (GL*10)-Lee; End Else GL:= (GL*10)+Lee; End Else If Lee<100 then Begin If GL<0 then Begin GL:= (GL*100)-Lee; End Else GL:= (GL*100)+Lee; End Else Begin If GL<0 then Begin GL:= (GL*100)-(Lee mod 100); End Else GL:= (GL*100)+(Lee mod 100); End; End; until (Cont=4); VL[Aux]:= GL; Until (Aux=NMin); close (FLB); Assign (FLL, NL); Rewrite (FLL); For Aux:=1 to NMed do Begin write (FLL, VL[Aux]); End; End Else Begin writeln ('Error'); writeln ('Presione una tecla'); readkey; End; close (FLL); {$I+} End; //------------------------------------------------------------------- Procedure VerB (NB:string); Var Aux, Lee: Byte; FLB: File of byte; Begin {$I-} clrscr; writeln ('Ver Byte:'); writeln ('Archivo: ', NB); writeln (' '); Assign (FLB, NB); Reset (FLB); If (IOResult=0) then Begin For Aux:=1 to NMax do Begin Read (FLB, Lee); write (Lee:3, ' | '); End; writeln (' '); writeln (' '); End Else writeln ('Error'); writeln ('Presione una tecla'); readkey; Close (FLB); {$I+} End; //------------------------------------------------------------------- Procedure VerC (NB: string); Var Aux, Lee: Byte; FLB: File of byte; Begin {$I-} clrscr; writeln ('Ver caracteres:'); writeln ('Archivo: ', NB); writeln (' '); Assign (FLB, NB); Reset (FLB); If (IOResult=0) then Begin For Aux:=1 to NMax do Begin Read (FLB, Lee); write (chr (Lee), ' '); End; writeln (' '); writeln (' '); End Else writeln ('Error'); writeln ('Presione una tecla'); readkey; Close (FLB); {$I+} End; //------------------------------------------------------------------- Procedure VerW (NW: string); Var Aux: Byte; Lee: Word; FLW: File of Word; Begin {$I-} clrscr; writeln ('Ver Word:'); writeln ('Archivo: ', NW); writeln (' '); Assign (FLW, NW); Reset (FLW); If (IOResult=0) then Begin For Aux:=1 to NMed do Begin Read (FLW, Lee); write (Lee:4, ' | '); End; writeln (' '); writeln (' '); End Else writeln ('Error'); writeln ('Presione una tecla'); readkey; Close (FLW); {$I+} End; //------------------------------------------------------------------- Procedure VerI (NI: string); Var Aux: byte; Lee: integer; FLI: File of integer; Begin {$I-} clrscr; writeln ('Ver Integer:'); writeln ('Archivo: ', NI); writeln (' '); Assign (FLI, NI); Reset (FLI); If (IOResult=0) then Begin For Aux:=1 to NMed do Begin Read (FLI, Lee); write (Lee:4, ' | '); End; writeln (' '); writeln (' '); End Else writeln ('Error'); writeln ('Presione una tecla'); readkey; Close (FLI); {$I+} End; //------------------------------------------------------------------- Procedure VerL (NL: string); Var Aux: byte; Lee: LongInt; FLL: File of LongInt; Begin {$I-} clrscr; writeln ('Ver Integer:'); writeln ('Archivo: ', NL); writeln (' '); Assign (FLL, NL); Reset (FLL); If (IOResult=0) then Begin For Aux:=1 to NMin do Begin Read (FLL, Lee); write (Lee:8, ' | '); End; writeln (' '); writeln (' '); End Else writeln ('Error'); writeln ('Presione una tecla'); readkey; Close (FLL); {$I+} End; //------------------------------------------------------------------- BEGIN repeat clrscr; writeln ('MENU:'); writeln ('1- Crear Archivo'); writeln ('2- Ver Archivo'); writeln ('0- Salir'); readln (Op); //--------------------------------- If Op=1 then Begin repeat clrscr; writeln ('CREAR ARCHIVO'); writeln ('1- Byte'); writeln ('2- Word'); writeln ('3- Integer'); writeln ('4- LongInt'); writeln ('0- Salir'); readln (Op2); If Op2=1 then Begin clrscr; write ('Nombre para archivo Byte: '); readln (NB); For I:=1 to NMax do VB[I]:= 0; GenArchB (NB, VB); End; If Op2=2 then Begin clrscr; write ('Nombre del archivo Byte: '); readln (NB); write ('Nombre para archivo Word: '); readln (NW); For I:=1 to NMax do VW[I]:= 0; GenArchW (NW, NB, VW); End; If Op2=3 then Begin clrscr; write ('Nombre del archivo Byte: '); readln (NB); write ('Nombre para archivo Integer: '); readln (NI); For I:=1 to NMax do VI[I]:= 0; GenArchI (NI, NB, VI); End; If Op2=4 then Begin clrscr; write ('Nombre del archivo Byte: '); readln (NB); write ('Nombre para archivo LongInt: '); readln (NL); For I:=1 to NMax do VL[I]:= 0; GenArchL (NL, NB, VL); End; If (Op2<0) or (Op2>4) then Begin writeln (' '); writeln ('Opcion no valida'); writeln ('Presione una tecla'); readkey; End; Until (Op2>=0)and(Op2<=3); End; //--------------------------------- If Op=2 then Begin repeat clrscr; writeln ('VER ARCHIVO'); writeln ('1- Byte'); writeln ('2- Caracteres'); writeln ('3- Word'); writeln ('4- Integer'); writeln ('5- LongInt'); writeln ('0- Salir'); readln (Op2); If Op2=1 then Begin clrscr; write ('Nombre del archivo Byte: '); readln (NB); VerB (NB); End; If Op2=2 then Begin clrscr; write ('Nombre del archivo Byte: '); readln (NB); VerC (NB); End; If Op2=3 then Begin clrscr; write ('Nombre del archivo Word: '); readln (NW); VerW (NW); End; If Op2=4 then Begin clrscr; write ('Nombre del archivo Integer: '); readln (NI); VerI (NI); End; If Op2=5 then Begin clrscr; write ('Nombre del archivo LongInt: '); readln (NL); VerL (NL); End; If (Op2<0) or (Op2>5) then Begin writeln (' '); writeln ('Opcion no valida'); writeln ('Presione una tecla'); readkey; End; Until (Op2>=0)and(Op2<=4); End; //--------------------------------- If (Op<0)or(Op>2)then Begin writeln (' '); writeln ('Opcion no valida'); writeln ('Presione una tecla'); readkey; End; //--------------------------------- Until (Op=0); END.
We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy. Accept Learn more