Witam!
To mój pierwszy program, który coś tam sensownego robi, to znaczy pozwala stworzyć test wyboru ABC (jako egzaminator) i rozwiązać go (jako zdający). Można wybrać sposób oceniania (stopień szkolny lub zdany/nie zdany). Wynik jest zapisywany do pliku rtf. Program posiada proste zabezpieczenie przed ponownym rozwiązaniem testu, a dostęp do panelu egzaminatora jest chroniony hasłem.
KreatorTestow.pas
program test_kreator; // v.1.2 {Autor: A.K.}
{Wszelkie prawa zastrzezone!}
uses crt, dos, windows, sysutils, kryptogram;
function ocena(jak_ocenic,osiagniety_wynik,prog_zdawalnosci:byte):string;
var skala:byte;
begin
//////////////////////////////////////////
// Wynik dla czitera //
//////////////////////////////////////////
if jak_ocenic=0 then ocena:='Oszust!'
else begin
//////////////////////////////////////////
// Zdal / Nie Zdal //
//////////////////////////////////////////
if jak_ocenic=1 then begin
if (osiagniety_wynik<prog_zdawalnosci) then ocena:='Nie zdal'
else ocena:='Zdal';
end
else begin
//////////////////////////////////////////
// Skala szkolna //
//////////////////////////////////////////
if jak_ocenic=2 then begin
if (osiagniety_wynik<30) then writeln('Niedostateczny');
if (osiagniety_wynik>=30) and (osiagniety_wynik<50) then ocena:='Dopuszczajacy';
if (osiagniety_wynik>=50) and (osiagniety_wynik<70) then ocena:='Dostateczny';
if (osiagniety_wynik>=70) and (osiagniety_wynik<90) then ocena:='Dobry';
if (osiagniety_wynik>=90) then ocena:='Bardzo Dobry';
end;
end;
end;
end;
function procent (ile,wsio:integer):real;
begin
procent:=((ile*100)/wsio);
end;
procedure tematzadania(a0:byte; a1,a2,a3,a4:string);
begin
writeln;
writeln(' Pytanie ',a0);
writeln(' ',a1);
writeln;
writeln(' a) ',a2);
writeln(' b) ',a3);
writeln(' c) ',a4);
writeln;
end;
type
pytanko = record
nr : byte;
tresc : string;
odp_1 : string;
odp_2 : string;
odp_3 : string;
trafna : string;
end;
ustawienia = record
naglowek : string;
sposoc : byte;
pz : byte;
end;
var
data : array[1..4] of word; // czwarta nieuzywana - dzien tygodnia
czas_p : array[1..4] of word; // czwarta nieuzywana na sec/100
czas_k : array[1..4] of word;
personalia : array[1..2] of string;
uzytkownik : string;
username : char;
zadanie : array[1..250] of pytanko;
formularz : file of pytanko;
rozwiazany : text;
liczba_pytan : byte;
i,j : byte;
udzielona : array[1..250] of string;
punkty : byte;
rtf : string;
nowe_haslo : string;
podane_haslo : string;
ini : file of ustawienia;
ust : ustawienia;
osiag : byte;
procedure kreator(var a:byte); //uzywa zmiennych glob. !!! Umiescic pod dekl. !!!
begin
for i:=1 to a do begin
zadanie[i].nr:=i;
writeln;
writeln(' Pytanie nr ',zadanie[i].nr,':'); writeln; writeln;
writeln(' Podaj tresc pytania:');
writeln; write(' '); readln(zadanie[i].tresc); writeln;
writeln(' Podaj pierwsza odpowiedz:');
writeln; write(' a) '); readln(zadanie[i].odp_1); writeln;
writeln(' Podaj druga odpowiedz:');
writeln; write(' b) '); readln(zadanie[i].odp_2); writeln;
writeln(' Podaj trzecia odpowiedz:');
writeln; write(' c) '); readln(zadanie[i].odp_3); writeln;
repeat
write(' Ktora odpowiedz jest poprawna? ');
readln(zadanie[i].trafna);
for j:=1 to length(zadanie[i].trafna) do
zadanie[i].trafna[j]:= upcase(zadanie[i].trafna[j]);
if (zadanie[i].trafna<>'A') and (zadanie[i].trafna<>'B') and (zadanie[i].trafna<>'C') then
writeln(' Podana odpowiedz nie istnieje! Wprowadz ponownie!');
until (zadanie[i].trafna='A') or (zadanie[i].trafna='B') or (zadanie[i].trafna='C');
clrscr;
end;
end;
procedure zapis(var sciezka : string); //uľywa zmiennych glob. !!! Umieci† pod dekl. !!!
begin
assign(rozwiazany,sciezka);
rewrite(rozwiazany);
write(rozwiazany,' ',ust.naglowek,#10);
write(rozwiazany,'--------------------------------------------------------------------------------',#10);
write(rozwiazany,' Zdajacy: ',personalia[1],' ',personalia[2],#10);
write(rozwiazany,'--------------------------------------------------------------------------------',#10);
write(rozwiazany,' Data: ',data[3],'.',data[2],'.',data[1],'.',#10);
write(rozwiazany,'--------------------------------------------------------------------------------',#10);
write(rozwiazany,' Czas rozpoczecia: ',czas_p[1],':',czas_p[2],':',czas_p[3],' Czas zakonczenia: ',czas_k[1],':',czas_k[2],':',czas_k[3],#10);
write(rozwiazany,'--------------------------------------------------------------------------------',#10);
for i:=1 to liczba_pytan do begin
write(rozwiazany,#10,' Pytanie ',zadanie[i].nr,#10);
write(rozwiazany,' ',zadanie[i].tresc,#10);
write(rozwiazany,' a) ',zadanie[i].odp_1,#10);
write(rozwiazany,' b) ',zadanie[i].odp_2,#10);
write(rozwiazany,' c) ',zadanie[i].odp_3,#10,#10);
write(rozwiazany,' Odpowiedz zdajacego: ',udzielona[i],#10,' Prawidlowa odpowiedz: ',zadanie[i].trafna,#10,#10);
if udzielona[i]=zadanie[i].trafna then
write(rozwiazany,' Punkty za zadanie: 1')
else
write(rozwiazany,' Punkty za zadanie: 0');
write(rozwiazany,#10,#10,#10);
end;
write(rozwiazany,'--------------------------------------------------------------------------------',#10);
write(rozwiazany,' Wynik: ',punkty,' na ',liczba_pytan,' = ',procent(punkty,liczba_pytan):3:1,'%',#10);
write(rozwiazany,'--------------------------------------------------------------------------------',#10);
write(rozwiazany,' Ocena: ',ocena(ust.sposoc,trunc(procent(punkty,liczba_pytan)),ust.pz),#10);
write(rozwiazany,'--------------------------------------------------------------------------------',#10);
close(rozwiazany);
end;
begin
repeat
writeln; writeln(' Podaj nazwe uzytkownika [Zdajacy/Egzaminator]');
writeln; write(' '); readln(uzytkownik); clrscr;
for j:=1 to length(uzytkownik) do
uzytkownik[j]:= upcase(uzytkownik[j]);
if uzytkownik='EGZAMINATOR' then username:='a' else
if uzytkownik='ZDAJACY' then username:='b' else begin writeln; writeln(' Podany uzytkownik nie istnieje!'); end;
until (username='a') or (username='b');
case username of
(******************************************************************************************************************************************
**************************************CZesc*DLA*EGZAMINATORA*******************************************************************************
******************************************************************************************************************************************)
'a':begin
if not fileexists('pass.dat') then begin writeln; writeln(' Brak hasla zabezpieczajacego! Utworz nowe haslo!');
writeln; writeln(' Uwaga! Haslo nie moze miec wiecej niz 10 znakow!'); writeln;
write(' Haso: '); readln(nowe_haslo); wprowadz_haslo(nowe_haslo);
filesetattr('pass.dat',fahidden);
end
else begin
writeln; writeln(' Witaj ',uzytkownik,'!'); writeln;
repeat
writeln(' Wprowadz haslo aby rozpoczac prace z kreatorem.');
writeln(); write(' Haslo: '); readln(podane_haslo);
porownaj_haslo(podane_haslo);
if porownaj_haslo(podane_haslo) = FALSE then begin writeln;
writeln(' Haslo nieprawidowe! Wcinij [ENTER] aby kontynuowac!');
readln; clrscr;
end;
until porownaj_haslo(podane_haslo) = TRUE;
end;
clrscr;
/////////////////////////////////////////////////////////////////////
// Tworzenie testu //
/////////////////////////////////////////////////////////////////////
if not directoryexists('C:\Egzamin') then createdir('C:\Egzamin');
writeln; writeln(' Wprowadz naglowek:'); writeln; write(' ');
readln(ust.naglowek); clrscr;
repeat
writeln; writeln(' Wybierz sposob oceniania:'); writeln;
writeln(' 1 - Zdal/Nie Zdal'); writeln(' 2 - Szkolna skala ocen');
writeln; write(' '); readln(ust.sposoc); clrscr;
if ust.sposoc=1 then begin
writeln; writeln(' Zdane od [%]:'); writeln;
write(' '); readln(ust.pz); clrscr;
end else begin ust.pz:=0; end;
if (ust.sposoc<>1) and (ust.sposoc<>2) then begin
writeln; writeln(' Nie znaleziono! Wybierz ponownie!'); write(' ');
readln; clrscr;
end;
until (ust.sposoc=1) or (ust.sposoc=2);
assign(ini,'C:\Egzamin\settings.ini');
rewrite(ini);
write(ini,ust);
close(ini);
writeln;
write(' Podaj ilosc pytan (do 250): '); readln(liczba_pytan);
clrscr;
assign(formularz,'C:\Egzamin\test.data');
rewrite(formularz);
/////////////////////////////
// Wprowadzanie //
/////////////////////////////
kreator(liczba_pytan);
/////////////////////////////
// Zapis do pliku //
/////////////////////////////
for i:=1 to liczba_pytan do
write(formularz,zadanie[i]);
close(formularz);
end;
(******************************************************************************************************************************************
**************************************CZesc*DLA*ZDAJaCEGO**********************************************************************************
******************************************************************************************************************************************)
'b':begin
if not fileexists('C:\Egzamin\test.data') then begin writeln; writeln(' Brak testow do rozwiazania!'); readkey; exit; end;
punkty:=0;
getdate(data[1],data[2],data[3],data[4]);
writeln(' Dane zdajacego:'); writeln;
write(' Imie: '); readln(personalia[1]);
write(' Nazwisko: '); readln(personalia[2]);
clrscr;
gettime(czas_p[1],czas_p[2],czas_p[3],czas_p[4]);
/////////////////////////////////////////////////////////////////////
// Odwolanie do pliku //
/////////////////////////////////////////////////////////////////////
assign(formularz,'C:\Egzamin\test.data');
reset(formularz);
i:=1;
repeat
read(formularz,zadanie[i]);
inc(i);
until eof(formularz); //Wazne!!! bez tego czyta po dokumencie!!!
close(formularz);
assign(ini,'C:\Egzamin\settings.ini');
reset(ini);
read(ini,ust);
close(ini);
/////////////////////////////////////////////////////////////////////
// Rozwiazanie //
/////////////////////////////////////////////////////////////////////
liczba_pytan := i-1;
for i:=1 to liczba_pytan do begin
repeat
tematzadania(zadanie[i].nr,zadanie[i].tresc,zadanie[i].odp_1,zadanie[i].odp_2,zadanie[i].odp_3);
write(' Odpowiedz: '); readln(udzielona[i]);
clrscr;
for j:=1 to length(udzielona[i]) do
udzielona[i][j]:= upcase(udzielona[i][j]);
if (udzielona[i]<>'A') and (udzielona[i]<>'B') and (udzielona[i]<>'C') then
writeln(' Podana odpowiedz nie istnieje! Sprobuj ponownie!');
until (udzielona[i]='A') or (udzielona[i]='B') or (udzielona[i]='C');
if udzielona[i]=zadanie[i].trafna then inc(punkty);
end;
gettime(czas_k[1],czas_k[2],czas_k[3],czas_k[4]);
if fileexists('backup.rtf') then ust.sposoc:=0;
rtf:='C:\Egzamin\test.rtf';
zapis(rtf);
////////////////////////////////////////////
// Kopia na wypadek czitowania //
////////////////////////////////////////////
if not fileexists('backup.rtf') then begin
rtf:='backup.rtf';
zapis(rtf);
filesetattr('backup.rtf',fahidden);
end;
///////////////////////////////////////////
writeln;
writeln(' Wynik: ',punkty,' na ', liczba_pytan);
writeln(' Ocena: ',ocena(ust.sposoc,trunc(procent(punkty,liczba_pytan)),ust.pz));
readln;
end;
end;
end.
kryptogram.pas
unit kryptogram; {Autor: A.K.}
{Wszelkie prawa zastrzezone!}
interface
procedure wprowadz_haslo(hw:string);
function porownaj_haslo(hds:string):boolean;
implementation
function porownaj_haslo(hds:string):boolean;
type
kod = record
el : array[1..21] of string;
dl : byte
end;
var
licznik : byte; //dlugosc hasla
a,b : byte; //na pozniej
i,j,k : byte;
has : kod;
fil : file of kod;
tab : array[1..10] of char;
tabp : array[1..10] of char;
begin
assign(fil,'pass.dat');
reset(fil);
read(fil,has);
close(fil);
a:=0;
for j:=1 to length(hds) do
tabp[j]:=hds[j];
for i:=1 to 2*has.dl do begin
if i mod 2 = 0 then begin
a:=a+1;
tab[a]:=has.el[i][1];
end;
end;
b:=0;
if has.dl=length(hds) then licznik:=0 else licznik:=1;
for k:=1 to length(hds) do begin
inc(b);
if not (tabp[b] = tab[b]) then inc(licznik);
end;
if licznik=0 then porownaj_haslo:= TRUE
else porownaj_haslo:= FALSE;
end;
procedure wprowadz_haslo(hw:string);
type
kod = record
el : array[1..21] of string;
dl : byte;
end;
var
dh : byte; //dlugosc hasla
a,b : byte; //na pozniej
i,j,k : byte;
has : kod;
fil : file of kod;
pierwaja: string;
begin
dh := length(hw);
has.dl := dh;
a := 1;
randomize;
for i:=1 to dh+1 do begin
for j:=0 to random(200) do
has.el[a][j] := char((random(94))+32);
inc(a);
if a>2*dh then break;
has.el[a] := hw[i];
inc(a);
end;
assign(fil,'pass.dat');
rewrite(fil);
write(fil,has);
close(fil);
end;
begin
end.
Co o tym sądzicie?
bo niedawno minęło dziesięć lat, odkąd napisałem ten program i byłem ciekaw, co obecnie mogą powiedzieć o nim zawodowcy. ;PTzn. przez ten czas w ogóle nie programowałeś, czy jednak programowałeś? bo jeśli to drugie, to nasze uwagi mogą być od czapy/oczywiste, jeśli już piszesz lepiej, jeśli programowałeś przez te lata. Chyba, że miałeś dużą przerwę i na nowo wchodzisz w temat programowania.