[Pascal] problem z menu programu


(Mateusz61096) #1

Witam!

Napisałem program, który jest symulatorem dużego lotka wraz z możliwością zarejestrowania się i zalogowania. Problem jest taki, że jak ktoś się zarejestruje (co najmniej 2 osoby muszą być zarejestrowane), zaloguje, zagra 1 raz w grę, a następnie chce wejść w swój profil (błąd pojawia się tylko przy takiej kolejności czynności jakie podałem) to zamiast w swój wchodzi w profil pierwszej osoby, która się zarejestrowała. Proszę o pomoc.

uses crt,dos,sysutils;


type

    rekord1 = record

    imie : string[20];

    nazwisko: string[20];

    wiek : byte;

    login : string[15];

    haslo : string[25];

    rok : word;

    miesiac : word;

    dzien : word;

    traf6 : integer;

    traf5 : integer;

    traf4 : integer;

    traf3 : integer;

    traf2 : integer;

    traf1 : integer;

    traf0 : integer;

    end;



var b,c,d,e,g,h,z,traf: byte;

    powt: string;

    a: array[1..6] of byte;

    w: array[1..6] of byte;

    profil: array[1..100] of rekord1;

    login1: string[20];

    i2: integer;

    F: file of rekord1;

    lbprof: byte;


const

    a1 : integer = 0;


procedure menuzal;forward;


procedure menugosc;forward;


procedure wyjscie;forward;


procedure zapisdopliku;forward;


procedure NowyProfil;

var haslo1,b1,b2:string[25];

    dt,b3,b4,c1: word;

    xx: word;

label kot1,kot2;


begin

    clrscr;

    inc(lbprof);

    writeln('Wprowadź swoje dane.');

    with profil[lbprof] do

    begin

        writeln('Imię: ');

        readln(imie);

        writeln;

        writeln('Nazwisko: ');

        readln(nazwisko);

        writeln;

    end;

    repeat

        writeln('Wiek: ');

        readln(b1);

        writeln;

        for b3:=1 to 150 do

        begin

            str(b3,b2);

            if b1=b2 then

            begin

                b4:=2;

                break;

            end;

        end;

        if b4=2 then val(b1,profil[lbprof].wiek,xx)

        else begin

        writeln('Miałeś/aś podać swój wiek... . Spróbuj jeszcze raz.');

        writeln;

        end;

    until b4=2;

    b4:=0;

        kot2:

        repeat

            writeln('Login: (nie dłuższy niż 10 znaków)');

            readln(profil[lbprof].login);

            writeln;

            if length(profil[lbprof].login)>10 then writeln('Za długi login. Spróbuj jeszcze raz.');

        until length(profil[lbprof].login)<=10;

        for c1:=1 to lbprof-1 do

        begin

            if lbprof=1 then break;

            if profil[lbprof].login=profil[c1].login then

            begin

                writeln('Przepraszamy, taki login już istnieje. Spróbuj inny.');

                goto kot2;

            end;

        end;

    with profil[lbprof] do

    begin

        kot1:

        writeln('Hasło: ');

        readln(haslo);

        writeln;

        traf0:=0;

        traf1:=0;

        traf2:=0;

        traf3:=0;

        traf4:=0;

        traf5:=0;

        traf6:=0;

    end;

    writeln('Potwierdź hasło: ');

    readln(haslo1);

    writeln;

    if profil[lbprof].haslo<>haslo1 then

    begin

        writeln('Wprowadziłeś dwa różne hasła. Spróbuj jeszcze raz.');

        goto kot1;

    end;

    getdate(profil[lbprof].rok,profil[lbprof].miesiac,profil[lbprof].dzien,dt);

    menugosc;

end;


procedure zaloguj;

var haslo1:string[25];

label kot5;


begin

    clrscr;

    repeat

        kot5:

        a1:=0;

        writeln('Podaj login: Powrót do menu: wpisz "powrot" i potwierdź ENTEREM.');

        readln(login1);

        writeln;

        repeat

            if login1='powrot' then menugosc;

            if lbprof=0 then menugosc;

            inc(a1);

            if login1 = profil[a1].login then break;

            if a1=lbprof then

            begin

                writeln('Nie ma takiego loginu! Spróbuj ponownie');

                goto kot5;

                end;

        until a1=lbprof;

        writeln('Podaj hasło: ');

        readln(haslo1);

        writeln;

        if haslo1=profil[a1].haslo then

        begin

            menuzal;

            break;

        end;

        writeln('Nieprawidłowe hasło. Spróbuj jeszcze raz.');

        delay(1500);

    until haslo1=profil[a1].haslo;


end;


procedure wyloguj;


begin

    login1:=' ';

    a1:=0;

    menugosc;

end;


procedure gra;

label kotwica1,kotwica3;


begin

clrscr;

writeln('Witaj w dużym lotku!');

writeln('Wybierz 6 liczb z zakresu 1-49 i wpisz je oddzielone od siebie spacją. Wybór potwierdź ENTEREM.');

kotwica3:

readln(w[1],w[2],w[3],w[4],w[5],w[6]);

for z:=1 to 6 do

begin

    if (w[z]>49) or (w[z]<1) then

    begin

        writeln('Błąd. Zły zakres danych. Spróbuj jeszcze raz');

        goto kotwica3;

    end;

end;

kotwica1:

randomize;

for b:=1 to 6 do

begin

    a[b]:=random(49)+1;

end;


for c:=1 to 6 do

begin

    for d:=c+1 to 6 do

    begin

        if a[c]=a[d] then goto kotwica1;

    end;

end;


writeln;

writeln('Liczby wybrane przez Ciebie to: ',w[1],' ',w[2],' ',w[3],' ',w[4],' ',w[5],' ',w[6]);

writeln;

write('W dzisejszym losowaniu wygranymi liczbami są: ');

for e:=1 to 6 do

begin

write(a[e],' ');

end;

traf:=0;

for g:=1 to 6 do

begin

    for h:=1 to 6 do

    begin

        if a[g]=w[h] then inc(traf);

    end;

end;

writeln;

writeln;

case (traf) of

    0: writeln('No cóż... . Nic nie trafiłeś/aś.');

    1: writeln('Trafiłeś/aś 1 liczbę. Lepsze to niż nic.');

    2: writeln('Trafiłeś/aś 2 liczby. Mogło być gorzej.');

    3: writeln('Trafiłeś/aś 3 liczby! Wygrałeś/aś około 24 zł!');

    4: writeln('Trafiłeś/aś 4 liczby! Wygrałeś/aś ponad 100 zł!');

    5: writeln('Trafiłeś/aś 5 liczb! Wygrałeś/aś kilka tysięcy zł!');

    6: writeln('Trafiłeś/aś 6 liczb! Zgarnąłeś/ęłaś główną pulę!!!');

end;

end;


procedure grazal;

label kotwica2,mm1;


begin

    kotwica2:

    gra;

    case (traf) of

    0: inc(profil[a1].traf0);

    1: inc(profil[a1].traf1);

    2: inc(profil[a1].traf2);

    3: inc(profil[a1].traf3);

    4: inc(profil[a1].traf4);

    5: inc(profil[a1].traf5);

    6: inc(profil[a1].traf6);

    end;

    writeln;

    writeln('Jeśli chcesz spróbować szczęścia jeszcze raz, wciśnij "t". Powrót do menu: "m". Wyjście z programu: "q".');

    mm1:

    powt:=readkey;

    if (powt='t') or (powt='T') then goto kotwica2;

    if (powt='m') or (powt='M') then menuzal;

    if (powt='q') or (powt='Q') then wyjscie

    else begin

        writeln('Zły klawisz. Spróbuj jeszcze raz.');

        delay(1500);

        goto mm1;

    end;

end;


procedure gragosc;

label kotwica2,mm1;


begin

    kotwica2:

    gra;

    writeln;

    writeln('Jeśli chcesz spróbować szczęścia jeszcze raz, wciśnij "t". Powrót do menu: "m". Wyjście z programu: "q".');

    mm1:

    powt:=readkey;

    if (powt='t') or (powt='T') then goto kotwica2;

    if (powt='m') or (powt='M') then menugosc;

    if (powt='q') or (powt='Q') then wyjscie

    else begin

        writeln('Zły klawisz. Spróbuj jeszcze raz.');

        delay(1500);

        goto mm1;

    end;


end;


procedure sortuj;

var

    I_tmp,I_tmp2,I_tmp3,I_tmp4,I_tmp5,I_tmp6,I_tmp7 : integer;

    W_tmp,W_tmp2,W_tmp3 : word;

    S_tmp,S_tmp2,S_tmp3,S_tmp4 : string[25];

    B_tmp : byte;

begin

    I_tmp:=profil[i2].traf6;

    profil[i2].traf6:=profil[i2+1].traf6;

    profil[i2+1].traf6:=I_tmp;


    I_tmp2:=profil[i2].traf5;

    profil[i2].traf5:=profil[i2+1].traf5;

    profil[i2+1].traf5:=I_tmp2;


    I_tmp3:=profil[i2].traf4;

    profil[i2].traf4:=profil[i2+1].traf4;

    profil[i2+1].traf4:=I_tmp3;


    I_tmp4:=profil[i2].traf3;

    profil[i2].traf3:=profil[i2+1].traf3;

    profil[i2+1].traf3:=I_tmp4;


    I_tmp5:=profil[i2].traf2;

    profil[i2].traf2:=profil[i2+1].traf2;

    profil[i2+1].traf2:=I_tmp5;


    I_tmp6:=profil[i2].traf1;

    profil[i2].traf1:=profil[i2+1].traf1;

    profil[i2+1].traf1:=I_tmp6;


    I_tmp7:=profil[i2].traf0;

    profil[i2].traf0:=profil[i2+1].traf0;

    profil[i2+1].traf0:=I_tmp7;


    W_tmp:=profil[i2].dzien;

    profil[i2].dzien:=profil[i2+1].dzien;

    profil[i2+1].dzien:=W_tmp;


    W_tmp2:=profil[i2].miesiac;

    profil[i2].miesiac:=profil[i2+1].miesiac;

    profil[i2+1].miesiac:=W_tmp2;


    W_tmp3:=profil[i2].rok;

    profil[i2].rok:=profil[i2+1].rok;

    profil[i2+1].rok:=W_tmp3;


    S_tmp:=profil[i2].imie;

    profil[i2].imie:=profil[i2+1].imie;

    profil[i2+1].imie:=S_tmp;


    S_tmp2:=profil[i2].nazwisko;

    profil[i2].nazwisko:=profil[i2+1].nazwisko;

    profil[i2+1].nazwisko:=S_tmp2;


    S_tmp3:=profil[i2].haslo;

    profil[i2].haslo:=profil[i2+1].haslo;

    profil[i2+1].haslo:=S_tmp;


    S_tmp4:=profil[i2].login;

    profil[i2].login:=profil[i2+1].login;

    profil[i2+1].login:=S_tmp4;


    B_tmp:=profil[i2].wiek;

    profil[i2].wiek:=profil[i2+1].wiek;

    profil[i2+1].wiek:=B_tmp;

end;



procedure najwyniki;

var i1,k1,k2,k3,k4,k5,k6,k7,max,max1,max2,max3,max4,max5 : integer;


begin

    for i1:=1 to lbprof-1 do

    begin

        for i2:=1 to lbprof-1 do

        begin

            if profil[i2].traf6
            begin

                sortuj;

            end;

        end;

    end;


    max:=0;

    for k1:=1 to lbprof do

    if profil[k1].traf6>max then max:=profil[k1].traf6;


    max1:=0;

    for k1:=1 to lbprof do

    if profil[k1].traf5>max1 then max1:=profil[k1].traf5;


    max2:=0;

    for k1:=1 to lbprof do

    if profil[k1].traf4>max2 then max2:=profil[k1].traf4;


    max3:=0;

    for k1:=1 to lbprof do

    if profil[k1].traf3>max3 then max3:=profil[k1].traf3;


    max4:=0;

    for k1:=1 to lbprof do

    if profil[k1].traf2>max4 then max4:=profil[k1].traf2;


    max5:=0;

    for k1:=1 to lbprof do

    if profil[k1].traf1>max5 then max5:=profil[k1].traf1;


    for k2:=max downto 0 do

    begin

        for i1:=1 to lbprof-1 do

        begin

            for i2:=1 to lbprof-1 do

            begin

                if (profil[i2].traf5
                sortuj;

            end;

        end;

    end;


    for k2:=max downto 0 do

    begin

        for k3:=max1 downto 0 do

        begin

            for i1:=1 to lbprof-1 do

            begin

                for i2:=1 to lbprof-1 do

                begin

                    if (profil[i2].traf4
                    sortuj;

                end;

            end;

        end;

    end;


    for k2:=max downto 0 do

    begin

        for k3:=max1 downto 0 do

        begin

            for k4:=max2 downto 0 do

            begin

                for i1:=1 to lbprof-1 do

                begin

                    for i2:=1 to lbprof-1 do

                    begin

                        if (profil[i2].traf3
                        sortuj;

                    end;

                end;

            end;

        end;

    end;


    for k2:=max downto 0 do

    begin

        for k3:=max1 downto 0 do

        begin

            for k4:=max2 downto 0 do

            begin

                for k5:=max3 downto 0 do

                begin

                    for i1:=1 to lbprof-1 do

                    begin

                        for i2:=1 to lbprof-1 do

                        begin

                            if (profil[i2].traf2
                               (profil[i2].traf3=k5) and (profil[i2+1].traf3=k5) then

                               sortuj;

                        end;

                    end;

                end;

            end;

        end;

    end;


    for k2:=max downto 0 do

    begin

        for k3:=max1 downto 0 do

        begin

            for k4:=max2 downto 0 do

            begin

                for k5:=max3 downto 0 do

                begin

                    for k6:=max4 downto 0 do

                    begin

                        for i1:=1 to lbprof-1 do

                        begin

                            for i2:=1 to lbprof-1 do

                            begin

                                if (profil[i2].traf1
                                   (profil[i2].traf3=k5) and (profil[i2+1].traf3=k5) and (profil[i2].traf2=k6) and (profil[i2+1].traf2=k6) then

                                   sortuj;

                            end;

                        end;

                    end;

                end;

            end;

        end;

    end;


    for k2:=max downto 0 do

    begin

        for k3:=max1 downto 0 do

        begin

            for k4:=max2 downto 0 do

            begin

                for k5:=max3 downto 0 do

                begin

                    for k6:=max4 downto 0 do

                    begin

                        for k7:=max5 downto 0 do

                        begin

                            for i1:=1 to lbprof-1 do

                            begin

                                for i2:=1 to lbprof-1 do

                                begin

                                    if (profil[i2].traf0
                                    (profil[i2].traf3=k5) and (profil[i2+1].traf3=k5) and (profil[i2].traf2=k6) and (profil[i2+1].traf2=k6) and (profil[i2].traf1=k7) and (profil[i2+1].traf1=k7) then

                                    sortuj;

                                end;

                            end;

                        end;

                    end;

                end;

            end;

        end;

    end;


end;


procedure pokaznw;

var ww: char;

label lab1;


begin;

    lab1:

    najwyniki;

    clrscr;

    writeln(' LISTA NAJLEPSZYCH WYNIKÓW');

    gotoxy(11,3);

    write(' Ilość trafień dla poszczególnych liczb:');

    gotoxy(1,4);

    write('Login:');

    gotoxy(15,4);

    write('6:');

    gotoxy(24,4);

    write('5:');

    gotoxy(33,4);

    write('4:');

    gotoxy(42,4);

    write('3:');

    gotoxy(51,4);

    write('2:');

    gotoxy(60,4);

    write('1:');

    gotoxy(69,4);

    write('0:');

    for i2:=1 to lbprof do

    begin

        gotoxy(1,5+i2);

        if (i2=1) or (i2=2) or (i2=3) then textcolor(white);

        write(i2,'. ',profil[i2].login);

        textcolor(lightgray);

        gotoxy(15,5+i2);

        write(profil[i2].traf6);

        gotoxy(24,5+i2);

        write(profil[i2].traf5);

        gotoxy(33,5+i2);

        write(profil[i2].traf4);

        gotoxy(42,5+i2);

        write(profil[i2].traf3);

        gotoxy(51,5+i2);

        write(profil[i2].traf2);

        gotoxy(60,5+i2);

        write(profil[i2].traf1);

        gotoxy(69,5+i2);

        write(profil[i2].traf0);

    end;

    writeln;

    writeln;

    writeln('Wpisz:');

    writeln(' - "m" aby powrócić do menu,');

    writeln(' - "q" aby wyjść z programu.');

    ww:=readkey;

    case (ww) of

    'm','M' : begin

                if a1=0 then menugosc;

                if a1>0 then menuzal;

              end;

    'q','Q' : wyjscie;

    else begin

            writeln('Zły klawisz. Spróbuj ponownie.');

            delay(1500);

            goto lab1;

         end;

    end;

end;


procedure wyjscie;

begin

    najwyniki;

    zapisdopliku;

    writeln('Miłego dnia');

    delay(900);

    halt;

end;


procedure statystyki;

var cc,dd: char;

    bb3,bb4,xxx : word;

    bb1,bb2,haslo2 : string;


label kkk1,kkk2;


begin

najwyniki;

kkk1:

clrscr;

writeln(' Witaj ',profil[a1].login,'!');

writeln;

writeln('Imię: ',profil[a1].imie);

writeln('Nazwisko: ',profil[a1].nazwisko);

writeln('Wiek: ',profil[a1].wiek);

writeln('Login: ',profil[a1].login);

writeln('Hasło: ',profil[a1].haslo);

writeln('Data zarejestrowania: ',profil[a1].dzien,'.',profil[a1].miesiac,'.',profil[a1].rok);

writeln('Pozycja w rankingu: ',a1);

writeln('Ilość trafień 6: ',profil[a1].traf6);

writeln('Ilość trafień 5: ',profil[a1].traf5);

writeln('Ilość trafień 4: ',profil[a1].traf4);

writeln('Ilość trafień 3: ',profil[a1].traf3);

writeln('Ilość trafień 2: ',profil[a1].traf2);

writeln('Ilość trafień 1: ',profil[a1].traf1);

writeln('Ilość trafień 0: ',profil[a1].traf0);

writeln;

writeln('Jeśli chcesz dokonać zmian w swoim profilu, naciśnij "z".');

writeln('Powrót do menu, naciśnij "m".');

writeln('Wylogowanie, naciśnij "w".');

writeln('Wyjście z gry, naciśnij "q".');

cc:=readkey;

case (cc) of

    'z','Z' : begin

        kkk2:

        clrscr;

        writeln('Dla zmiany:');

        writeln(' - imienia wpisz "i",');

        writeln(' - nazwiska wpisz "n",');

        writeln(' - wieku wpisz "w",');

        writeln(' - loginu wpisz "l",');

        writeln(' - hasła wpisz "h",');

        writeln(' - powrót wpisz "p".');

        dd:=readkey;

        case (dd) of

            'i','I' : begin

                writeln;

                writeln('Podaj swoje imię:');

                readln(profil[a1].imie);

                goto kkk1;

                end;

            'n','N' : begin

                writeln;

                writeln('Podaj swoje nazwisko:');

                readln(profil[a1].nazwisko);

                goto kkk1;

                end;

            'w','W' : begin

                repeat

                    writeln;

                    writeln('Podaj swój wiek:');

                    readln(bb1);

                    for bb3:=1 to 150 do

                    begin

                        str(bb3,bb2);

                        if bb1=bb2 then

                        begin

                            bb4:=2;

                            break;

                        end;

                    end;

                    if bb4=2 then val(bb1,profil[a1].wiek,xxx)

                    else writeln('Miałeś/aś podać swój wiek... . Spróbuj jeszcze raz.');

                until bb4=2;

                goto kkk1;

                end;

            'l','L' : begin

                writeln;

                writeln('Podaj nowy login:');

                readln(profil[a1].login);

                goto kkk1;

                end;

            'h','H' : begin

                repeat

                    writeln;

                    writeln('Podaj nowe hasło: ');

                    readln(profil[a1].haslo);

                    writeln;

                    writeln('Potwierdź hasło: ');

                    readln(haslo2);

                    if profil[lbprof].haslo<>haslo2 then

                    writeln;

                    writeln('Wprowadziłeś dwa różne hasła. Spróbuj jeszcze raz.');

                until profil[a1].haslo=haslo2;

                goto kkk1;

                end;

            'p','P' : goto kkk1;

            else begin

                    writeln;

                    writeln('Zły klawisz. Spróbuj jeszcze raz.');

                    delay(1500);

                    goto kkk2;

                 end;

        end;

        end;

    'm','M' : menuzal;

    'w','W' : wyloguj;

    'q','Q' : wyjscie

    else begin

            writeln;

            writeln('Zły klawisz. Spróbuj jeszcze raz.');

            delay(1500);

            goto kkk1;

         end;

    end;

end;


procedure menugosc;

var ll: char;

label ab1;


begin

    ab1:

    clrscr;

    writeln('WITAJ W SYMULATORZE DUŻEGO LOTKA');

    writeln;

    writeln('Wpisz:');

    writeln(' - "z" aby się zalogować,');

    writeln(' - "x" aby stworzyć nowy profil,');

    writeln(' - "r" aby zobaczyć ranking,');

    writeln(' - "g" aby zagrać jako gość,');

    writeln(' - "q" aby wyjść z programu.');

    ll:=readkey;

    case (ll) of

        'z','Z' : zaloguj;

        'x','X' : NowyProfil;

        'r','R' : pokaznw;

        'g','G' : gragosc;

        'q','Q' : wyjscie;

        else begin

                writeln('Zły klawisz. Spróbuj jeszcze raz.');

                delay(1500);

                goto ab1;

             end;

    end;

end;


procedure menuzal;

var vv: char;

label ab2;


begin

    ab2:

    clrscr;

    writeln('Witaj ',profil[a1].login,'!');

    writeln;

    writeln('Wpisz:');

    writeln(' - "g" aby zagrać,');

    writeln(' - "r" aby zobaczyć ranking,');

    writeln(' - "p" aby zobaczyć swój profil/edytować go,');

    writeln(' - "w" aby się wylogować,');

    writeln(' - "q" aby wyjść z programu.');

    vv:=readkey;

    case (vv) of

         'g','G' : grazal;

         'r','R' : pokaznw;

         'p','P' : statystyki;

         'w','W' : wyloguj;

         'q','Q' : wyjscie;

         else begin

                writeln('Zły klawisz. Spróbuj jeszcze raz.');

                delay(1500);

                goto ab2;

              end;

    end;

end;


procedure puruchom;


begin

    if not directoryexists('C:\Program Files') then

    mkdir('C:\Program Files');


    if not directoryexists('C:\Program Files\Symulator Duzego Lotka') then

    mkdir('C:\Program Files\Symulator Duzego Lotka');


    if not fileexists('C:\Program Files\Symulator Duzego Lotka\symdl1.dat') then

    begin

        assign(F,'C:\Program Files\Symulator Duzego Lotka\symdl1.dat');

        rewrite(F);

        close(F);

    end;

end;


procedure zapisdopliku;

var oo: word;


begin

    assign(F,'C:\Program Files\Symulator Duzego Lotka\symdl1.dat');

    rewrite(F);

    for oo:=1 to lbprof do

        write(F,profil[oo]);

    close(F);

end;


procedure odczytzpliku;

var pp: word;


begin

    pp:=0;

    assign(F,'C:\Program Files\Symulator Duzego Lotka\symdl1.dat');

    reset(F);

    while not eof(F) do

    begin

        inc(pp);

        read(F,profil[pp]);

    end;

    lbprof:=pp;

    close(F);

end;




{ ******************************************************* }

{część główna}


begin

    textcolor(lightgray);

    puruchom;

    odczytzpliku;

    menugosc;

end.[/code]

Wkleiłem cały kod programu, bo nie wiem w której procedurze jest błąd.

Z góry dzięki za odpowiedź.

PS Sory za kotwice, ale w niektórych miejscach chciałem skrócić kod, a w niektórych to nawet nie wiedziałem jak je zastąpić.