Ocentral (Normal User)
Pro
Messaggi: 86
Iscritto: 25/12/2009
|
Program Criptatore;
uses crt,dos;
var nome:string[20]; pass:string; s1:pathstr ;
procedure codifica(Nomefile,password:string);
const
maxbuf=3000;
var
base1,base2:byte;
sorg,dest:file;
buffer:array[1..maxbuf]of byte;
byteletti:real;
i:integer;
i1,i2:byte;
rr:integer;
procedure aprifile;
const
s:array[1..6] of char =('L','O','C','K','E','D');
BEGIN
assign(sorg,s1);
{$I-}
reset (sorg,1);
{$I+}
if ioresult<>0 then
begin
writeln('File non trovato');
write('Premere invio per terminare');
readln;
halt;
end;
blockread(sorg,buffer,6,rr);
if ((buffer[1]=ord('L'))and
(buffer[2]=ord('O'))and
(buffer[3]=ord('C'))and
(buffer[4]=ord('K'))and
(buffer[5]=ord('E'))and
(buffer[6]=ord('D'))) then
begin
writeln('File già crittografato...');
write('Premere invio per terminare.......');
readln;
halt;
end;
reset(sorg,1);
assign(dest,'$$$$$.$$');
rewrite(dest,1);
blockwrite(dest,s,6);
blockwrite(dest,base1,1);
blockwrite(dest,base2,1);
end;
{***********************}
procedure prendibase;
var
i,j:integer;
begin
gotoxy(1,6);
write('Scrivere la password');
readln(pass);
base1:=0;
base2:=0;
j:=length(password);
for i:=1 to length(password) do
begin
base1:=base1+(ord(password) * i);
base2:=base2+(ord(password) * j);
j:=j-1;
end;
end;
{***********************************}
procedure chiudifile;
var
i:integer;
begin
rr:=0;
rewrite(sorg,1);
fillchar(buffer,maxbuf,0);
while byteletti>0 do
begin
if byteletti>maxbuf then
blockwrite(sorg,buffer,maxbuf)
else
begin
i:=trunc(byteletti);
blockwrite(sorg,buffer,i);
end;
byteletti:= byteletti-maxbuf;
end;
close(sorg);
close(dest);
erase(sorg);
rename(dest,paramstr(1));
end;
begin {codifica}
prendibase;
aprifile;
i1:=base1;
i2:=base2;
byteletti:=0;
blockread(sorg,buffer,maxbuf,rr);
byteletti:=byteletti+rr;
while rr > 0 do
begin
for i:=1 to rr do
begin
i1:=i1-i;
i2:=i2+i;
if odd(i) then
buffer:= buffer - i1
else
buffer:= buffer +i2;
end;
blockwrite(dest,buffer,rr);
blockread(sorg,buffer,maxbuf,rr);
byteletti:= byteletti+rr;
end;
chiudifile;
end; {endcodifica}
{*************************************************************}
procedure decodifica(nomefile, password:string);
const
maxbuf=3000;
var
base1,base2,base1x,base2x:byte;
sorg,dest:file;
buffer:array[1..maxbuf]of byte;
byteletti:real;
i:integer;
i1,i2:byte;
rr:integer;
procedure aprifile;
const
s:array[1..6] of char =('L','O','C','K','E','D');
BEGIN
assign(sorg,nomefile);
{$I-}
reset (sorg,1);
{$I+}
if ioresult<>0 then
begin
writeln('File non trovato');
write('Premere invio per terminare');
readln;
halt;
end;
blockread(sorg,buffer,6);
if not ((buffer[1]=ord('L'))and
(buffer[2]=ord('O'))and
(buffer[3]=ord('C'))and
(buffer[4]=ord('K'))and
(buffer[5]=ord('E'))and
(buffer[6]=ord('D'))) then
begin
writeln('File non crittografato...');
write('Premere invio per terminare.......');
readln;
halt;
end;
blockread(sorg,base1x,1);
blockread(sorg,base2x,1);
if ((base1<>base1x) or (base2<>base2x)) then
begin
writeln('Password Sbagliata.');
writeln('Premere invio per terminare.....');
readln;
halt;
end;
assign(dest,nomefile+'.$$');
rewrite(dest,1);
end;
procedure prendibase;
var
i,j:integer;
begin
gotoxy(1,6);
write('Scrivere la password');
readln(pass);
base1:=0;
base2:=0;
j:=length(password);
for i:=1 to length(password) do
begin
base1:=base1+(ord(password) * i);
base2:=base2+(ord(password) * j);
j:=j-i;
end;
end;
procedure chiudifile;
var
i:integer;
begin
rewrite(sorg,1);
fillchar(buffer,maxbuf,0);
while byteletti>0 do
begin
if byteletti>maxbuf then
blockwrite(sorg,buffer,maxbuf)
else
begin
i:=trunc(byteletti);
blockwrite(sorg,buffer,i);
end;
byteletti:= byteletti-maxbuf;
end;
close(sorg);
close(dest);
erase(sorg);
rename(dest,paramstr(1));
end;
begin {Decodifica}
prendibase;
aprifile;
i1:= base1;
i2:=base2;
byteletti:=0;
blockread(sorg,buffer,maxbuf,rr);
byteletti:=byteletti+rr;
while rr>0 do
begin
for i:=1 to rr do
begin
i1:=i1-i;
i2:=i2+i;
if odd(i) then
buffer := buffer +i1
else
buffer := buffer - i2;
end;
blockwrite(dest,buffer,rr);
blockread(sorg,buffer,maxbuf,rr);
end;
chiudifile;
end;
{*******************************************************}
procedure Menu;
var c:char; v:byte;
begin
v:=0;
gotoxy(10,1);
write('Programma di codifica/decodifica');
gotoxy(10,5);
write('C)Codifica');
gotoxy(10,6);
write('D)Decodifica');
gotoxy(10,7);
write('E)Esci');
gotoxy(25,8);
readln(c);
begin
case upcase(c) of
'C':
begin
clrscr;
v:=1;
gotoxy(10,1);
write('Programma di codifica scritto da Cuayankees');
gotoxy(1,4);
write('Scrivere nome file inclusa l''estensione');
readln(nome);
S1 := FSearch(nome,'c:\users\cuacentral\desktop');
if S1= '' then
Writeln('file non trovato')
else
Writeln('file trovato nel percorso= ',FExpand(S1));
Codifica(nome,pass);
end;
'D':
begin
v:=1;
clrscr;
gotoxy(10,1);
write('Programma di decodifica scritto da Cuayankees');
gotoxy(1,4);
write('Scrivere nome file inclusa l''estensione');
readln(nome);
S1 := FSearch(nome,'c:\users\cuacentral\desktop');
if S1= '' then
Writeln('file non trovato')
else
Writeln('file trovato nel percorso= ',FExpand(S1));
Decodifica(nome,pass);
end;
'E':
begin
v:=1;
clrscr;
write('Premere invio per finire');
readln;
halt;
end;
end;
if v = 0 then
begin
write('Inserire bene i dati!!!');
gotoxy(25,8);
end;
end;
end;
begin
clrscr;
menu;
readln;
end.
Ultima modifica effettuata da Ocentral il 26/12/2009 alle 10:29 |