Please note, this is a STATIC archive of website www.tutorialspoint.com from 11 May 2019, cach3.com does not collect or store any user information, there is no "phishing" involved.
Tutorialspoint

kkff

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.

Advertisements
Loading...

We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy.