Данный алгоритм содержит в себе главные основы в паскале, как работать с файлами, использование разного типа переменных, использование меню.
program myprg; uses crt; type user=record number:string; percode:string; fname:string; lname:String; adress:string; diag:string; end; {--} const dBase='database.dat'; var i,z,m,en:integer; answ,answ1:char; s,r:string; f:text; users:array[1..10] of user; {-----} procedure checkData; begin assign(f,dBase); {$I-}reset(f);{$I+} if IoResult<>0 then rewrite(f); close(f); end; {-----} procedure add; begin assign(f,dBase); append(f); clrscr; writeln('Pievienot pie saraksta jaunus pacientus'); writeln(''); for i:=1 to 3 do begin writeln('Informacija par paciantu (',i,'/3):'); write('Numuru(ID):'); readln(users[i].number); writeln(f,users[i].number); write('Personas kods:'); readln(users[i].percode); writeln(f,users[i].percode); write('Vards:'); readln(users[i].fname); writeln(f,users[i].fname); write('Uzvards:'); readln(users[i].lname); writeln(f,users[i].lname); write('Adrese:'); readln(users[i].adress); writeln(f,users[i].adress); write('Slimiba:'); readln(users[i].diag); writeln(f,users[i].diag); writeln(f,'==NEXT=='); if(i<3) then begin writeln(''); write('Pievienot informaciju par citu pacientu? Izvele(y/n):'); readln(answ); if(answ='n') then break; end else begin writeln(''); writeln('***********************************************************'); writeln('*Atvainojiet, viena reizi var pievienot tikai 3 pierakstus*'); writeln('***********************************************************'); writeln(''); end; end; close(f); writeln(''); end; {-----} procedure search; begin clrscr; writeln('Pacientu meklesana'); writeln(''); write('Ievadiet klienta numuru:'); readln(s); writeln(''); assign(f,dBase); reset(f); i:=0; en:=0; repeat inc(i); readln(f,r); if(i=1) and (r=s) then en:=1; if(i=1) and (en=1) then writeln('Clienta numurs (ID):',r); if(i=2) and (en=1) then writeln('Personas code:',r); if(i=3) and (en=1) then writeln('Vards:',r); if(i=4) and (en=1) then writeln('Uzvards:',r); if(i=5) and (en=1) then writeln('Adress:',r); if(i=6) and (en=1) then writeln('Diagnoss:',r); if(r='==NEXT==') then begin i:=0; if en=1 then break; end; until eof(f); writeln(''); writeln(''); close(f); if(en=0) then writeln('Atvainojiet, pacientu ar tadu numuru nav'); writeln(''); writeln(''); write('Meklet citu pacientu?(y/n):'); readln(answ); if(answ='y') then search; end; {-----} procedure exit; begin while (answ1<>'n') and (answ1<>'y') do begin write('Iziet no programmas? Izvele(y/n):'); readln(answ1); end; end; {-----} procedure viewAll; begin clrscr; writeln('Parskats par pacientiem:'); writeln(''); assign(f,dBase); reset(f); i:=0; en:=0; while eof(f)=false do begin inc(i); readln(f,r); en:=1; if(i=1) then writeln('Pacienta numurs (ID):',r); if(i=2) then writeln('Personas code:',r); if(i=3) then writeln('Vards:',r); if(i=4) then writeln('Uzvards:',r); if(i=5) then writeln('Adress:',r); if(i=6) then writeln('Diagnoss:',r); if(r='==NEXT==') then begin i:=0;writeln('');writeln(' *** ');writeln(''); end; end; writeln(''); close(f); if(en=0) then writeln('Nav informacijas'); writeln(''); end; {-----} procedure clearData; begin clrscr; writeln('Visu datu dzesana'); writeln(''); write('Dzest visu informaciju? (y/n):'); readln(answ); writeln(''); if(answ='y') then begin assign(f,dBase); rewrite(f); close(f); writeln('Visa informacija tika dzesta!'); end; writeln(''); writeln(''); end; {-----} procedure menu; begin answ1:='0'; clrscr; checkData; writeln('Menu:'); writeln('1.Pievienot jaunu lietotaju'); writeln('2.Parskatit visus pacientus'); writeln('3.Meklet paciantu'); writeln('4.Dzest visu informaciju'); writeln('5.Iziet'); write('Jusu izvele:'); readln(m); if(m<>1) and (m<>2) and (m<>3) and (m<>4) and (m<>5) then menu; case m of 1:add; 2:viewAll; 3:search; 4:clearData; end; if(m<>5) then begin writeln(''); write('Pariet pie galvena satura? Izvele(y/n):'); readln(answ); if(answ='y') then menu; end; writeln(''); writeln(''); exit; if answ1='n' then menu; end; {-----} begin menu; {readln; } end.
Автор: LLIypuk