rafael
Administrator
Dołączył: 07 Lut 2006
Posty: 72
Przeczytał: 0 tematów
Ostrzeżeń: 0/3
Skąd: Pszczyna
|
| Temat postu: |
|
|
Może to Ci się przyda. Program od brata, ale raczej działa :wink: Masz tu jeszcze potrzebne pliki: [link widoczny dla zalogowanych]
| Kod: | program szyfrowanie;
uses
SysUtils;
const
maxUsersRead=1000;
type
TUser = record
login: string[20];
pwd: string[30];
end;
TUsertab = array[1..maxUsersRead] of TUser;
procedure GenerujKlucz;
var
plik: file of byte;
key: integer;
begin
assign(plik,'key.int');
if not FileExists('key.int') then
begin
randomize;
rewrite(plik);
key := random(255);
write(plik, key);
end;
end;
procedure szyfruj(var tab: Tuser);
var
j: byte;
plik: file of byte;
klucz: byte;
begin
assign(plik,'key.int');
reset(plik);
read(plik,klucz);
close(plik);
for j := 1 to length(tab.pwd) do
begin
tab.pwd[j] := chr(ord(tab.pwd[j]) + klucz);
end;
end;
procedure AddUser(fileName: string);
var
plik: file of TUser;
u: Tuser;
begin
writeln('--- USER ---');
write('LOGIN: ');
readln(u.login);
write('HASLO: ');
readln(u.pwd);
szyfruj(u);
writeln;
writeln;
Assign(plik, fileName);
if fileExists(fileName)then
reset(plik)
else
rewrite(plik);
seek(plik, fileSize(plik));
write(plik,u);
close(plik);
writeln('DANE USERA WPROWADZONE DO SYSTEMU');
readln;
end;
procedure ReadUsersFromFile(var tab: TUserTab; fileName: string; var count: integer);
var
plik: file of TUser;
begin
assignFile(plik, fileName);
if FileExists(fileName) then
begin
count:=0;
reset(plik);
while not Eof (plik) do
begin
inc(count);
read(plik,tab[count]);
end;
end;
close(plik);
end;
function CheckUsersFromFile(var tab: TUserTab; count: integer; u: Tuser): boolean;
var
i: integer;
begin
result := false;
for i:=1 to count do
begin
szyfruj(tab[i]);
if (u.login = tab[i].login) and (u.pwd = tab[i].pwd) then
begin
result:= true;
break;
end;
end;
end;
procedure login(tab: TUserTab; count: integer; proba: byte);
var
i: integer;
a: byte;
u: Tuser;
begin
a := proba;
for i := 1 to proba do
begin
write('Podaj login: ');
readln(u.login);
write('Podaj haslo: ');
readln(u.pwd);
if CheckUsersFromFile(tab,count,u) then
begin
writeln('Zalogowales sie!!!');
readln;
break;
end
else
begin
a := a-1;
if a > 0 then
writeln('Podales zle dane!! Sproboj jeszcze raz. Pozostalo prob: ', a,'.')
else
if a = 0 then
begin
writeln('Podales zle dane!!! Wyczerpales limit prob!!!');
readln;
break;
end;
end;
readln;
end;
end;
procedure ZmianaHasla(var tab: Tusertab; a: integer; filename: string);
var
bufor: Tusertab;
i: byte;
plik: file of Tuser;
login, btw: string;
begin
assign(plik, filename);
reset(plik);
for i := 1 to a do
begin
read(plik,bufor[i]);
szyfruj(bufor[i]);
end;
close(plik);
write('Podaj login: ');
readln(login);
for i := 1 to a do
begin
if bufor[i].login = login then
begin
write('Podaj nowe haslo: ');
readln(bufor[i].pwd);
writeln('Haslo zmienione!!');
btw := 'yes';
szyfruj(bufor[i]);
end;
end;
if btw <> 'yes' then
writeln('Nie znaleziono takiego loginu!!');
rewrite(plik);
for i := 1 to a do
begin
write(plik,bufor[i]);
end;
close(plik);
end;
const
fileName = 'test.txt';
var
tab: TUsertab;
a, wybor: integer;
begin
generujklucz;
repeat
writeln('1 - Zarejestruj sie!!');
writeln('2 - Zaloguj sie!!');
writeln('3 - Zmien haslo!!');
writeln('4 - Zakoncz!!');
write('Wybierz numer: ');
readln(wybor);
if wybor = 1 then
begin
AddUser(fileName);
ReadUsersFromFile(tab,fileName,a);
end
else
if wybor = 2 then
begin
ReadUsersFromFile(tab,fileName,a);
login(tab,a,5);
end
else
if wybor = 4 then
begin
writeln('Wyszedles z systemu!');
readln;
end
else
if wybor = 3 then
begin
ReadUsersFromFile(tab,fileName,a);
ZmianaHasla(tab,a,filename)
end
else
writeln('Niepoprawne polecenie!!!');
until wybor = 4;
end. |
Post został pochwalony 0 razy
|
|
Pytania 
Autor
