type
cadena=string[80];
var
f,d:file of byte;
fuente,destino,claveStr:cadena;
clave:array[0..80] of byte absolute claveStr;
signo:byte;
tecla:char;
function existe(fichero:cadena):boolean;
var
f:file;
begin
{$I-} assign(f,fichero);
reset(f);
{$I+} if IOResult=0 then
begin
close(f);
existe:=true;
end else existe:=false;
end;
procedure MAYUSCULAS(var frase:cadena);
var
i:integer;
begin
for i:=1 to length(frase) do
if frase[i]='¤' then frase[i]:='¥' else frase[i]:=upcase(frase[i]);
end;
procedure leer(var opcion:char; op1,op2:char);
begin
repeat
read(kbd,opcion);
opcion:=upCase(opcion);
until opcion in [op1,op2];
writeln(opcion);
end;
procedure continuar;
var
car,i,long:byte;
begin
assign(d,destino);
rewrite(d);
if signo=255 then writeln('Codificando fichero...') else writeln('Descifrando fichero...'); i:=1;
long:=length(claveStr);
while not eof(f) do
begin
read(f,car);
car:=car+signo*clave[i];
write(d,car);
if i<long then i:=i+1 else i:=1;
end;
close(d);
end;
BEGIN
write('Fuente : '); readln(fuente);
MAYUSCULAS(fuente);
if fuente<>'' then
begin
if existe(fuente) then
begin
assign(f,fuente);
reset(f);
write('Codificar o Descifrar C/D '); leer(tecla,'C','D');
if tecla='C' then signo:=255 else signo:=1;
write('Clave : '); readln(claveStr);
if claveStr<>'' then
begin
write('Destino: '); readln(destino);
MAYUSCULAS(destino);
if destino<>'' then
begin
if destino<>fuente then
begin
if existe(destino) then
begin
write('Fichero existente. ¨ Continuar ? S/N '); leer(tecla,'S','N');
if tecla='S' then continuar;
end else continuar;
end else writeln(' Deben ser distintos !'); end;
end;
close(f);
end else writeln('Fichero no encontrado.'); end;
END.
Crear cuenta
Comentarios sobre la versión: Versión 1 (2)