.. 22.11.09 9-4--07 .. 22.11.09 2009. , , , - . . - , , . , , , , . , . , . . , . - , , . , . , . , , , , . . , , . , . -. , . : , , . , , , . , , . , . 1 1.1 - , , , , . . (). . , . , , . . 1.2 . , (16231662). 1968 . , , . , . (), . , . : 1) , ; 2) , , ; 3) ; 4) ; 5) "" , , ; 6) : , . , , , , . - z Z, _ ( ASCII 95). , . -2147483648 +2147483647. , , , . , . . , , . , $ ( 36 ASCII). - $00000000 $FFFFFFFF. - : + - * / = ,' . : ; < > [ ] ( ) { } ^ @ $ #. : <> <= >= := (* *) (. .). , . - , , , , , , , , . , ( ) 63 . , . , , . . , , , , , NIL. - FALSE (), TRUE (). - , : 'z' - z; '' - . , : '''' - . , # ( 35), : #97 - ; #90 - Z; #39 - '; #13 - CR. - ( CR - ), . , , : ' - ; 'That' 's string.'. - , , : [1,2,4..7,12] [blue, red]. ( : , , ) , .. . , , , . , -5520 . , , , . , . (). , , , , . , . , . . -, : , . , . . , . . , , . . , . , , . : . - . , . , , . , , , . , - . . : PROCEDURE <> ( <.. . > ) ; : FUNCTION <> ( <...> ) : <>; <> - ( ); <...> - ; <> - . . , , : Procedure SB(a: Real; b: Integer; c: Char) , . , , Function F(a: Real; b: Real): Real; : Function F(a,b: Real): Real; : . . , . , , : . , , : ProcedureS (a: array [1..10] ofReal); -, . , , , , . : type atype = array [1..10] of Real; Procedure S (a: atype); , : type intype = String [15] ; outype = String [30] ; Function St (s : intype): outype; - , . , , , ( , ). : , , 8 . , . , True () False (), , . If: If () then 1; else 2; () - ( True False ); ( 1) ( 2) . True (), ( 1) ; ( 2). else , , if : If () then 1; ( 1) , True. ( 1) . , , , True () False (), . - begin, end. Case - . If. Case () , , . , , . , , Case , else. case , , (:). , - ( ), , . : While ( ), Repeat ( ) For ( ). While . While: While () do ; While . - True (), . . Repeat...until . Repeat...until : Repeat 1; 2; until (). Repeat...until While: - Repeat , . While, False, .; - Repeat True (), , While , True (); - Repeat , . begin...end, While. Reeat , , While . For , For: For :=(1) to (2) do - ( , , c ); (1) (2) - , ; - . 1 . 1. to downto. For - 1. - , [5]. : - ; - ; - . , , Assign. . CR/LF. . , . Text. : VarFi: Text; , . . : VarF: File; [6]. . : Type TRec = Record A: Real; B: Integer; C: Char; End; Var F : File of Real; Q : File of String[100]; Fr: File of TRec; F . , . Q , 100. Fr , TRec, Type. 2 2.1 , . , , , , . : - ; - ; - 10 ; - I- , IV- ; : - , ; : - , , , . 2.2 Crt. , , . -, , Crt BIOS . 2.3- Crt. , . , . , , . : 1) ProcedureZastavka- , , , , , . 2) ProcedureMenu- . 3) ProcedurePassword , - , - ( ). 4) ProcedureNovoedelo (: ). 5) ProcedureArhieve (), (: ). 6) Procedureend . 2.3 - , , , , , , , , . , . , . . , , (a..z) (A..Z). , 63 . 2.4 .1 .2 , . . , , , , . . , . , . , , . , . C 1) . ., .., . . . : . / .: . . , 1991. 400 . 2) .., .. . .: , 1987. 112 . 3) .. .: , 1987-31 . 4) : . . / .. , .. , .. . .: . ., 1990 479 . 5) .. TurboPascal. .: 2003-75 . 6) .., .. TurboPascal 7.0 .: +, .: , 1998. 496 . 7) .. TurboPascal 8) . . . 9) .. TurboPascal. .: 2003-198 . 1. 2. 1 , . , . , , . , . 2 . 3 : , . . 4 4.1 . 4.1.1 : - ; - ; - 10 ; - I- , IV- . 4.1.2. : - . 4.2. : 4.2.1. . 4.2.2. . 4.3 4.3.1 IBM . 4.3.2 : - Pentium; - 16; - VGA SVGA. 4.4 - Windows (Windows95, Windows98,Windows2000,WindowsNT ..), MS-DOS. 5 5.1 , ; 5.2 ; 5.3 : 5.3.1 25-30 , ; 5.3.2 ; 6 1- . ( ) program Baza; uses crt, REGUNIT; begin{Baza Dannyh} zastavka; {} user; { } menus; { } end.{Baza Dannyh} ( Unit ) {******************************************************************} { Zastavka - } { Makeramka - } { Lines - } { Archieve - } { User - } { Menus - } { Password - , } {******************************************************************} Unit REGUNIT; Interface uses crt; const illcount=100; NameProg='Baza dannyh'; PasswordX='password'; Line1=''; mmenu:array [1..5] of string[16]=(' Novoe delo ', ' ... ',' ... ',' ...', ' '); menunew:array [1..2] of string[16]=(' ', ' ⬥ '); menuarch:array [1..3] of string[16]=(' ', ' 㧨',' ⬥ '); menufind:array [1..2] of string[16]=(' ', ' ⬥ '); menuuser:array [1..2] of string[40]= (' ', ' 짮 ⥫'); simvV : set of char = ['A'..'Z','a'..'z','0'..'9','_','\',':', '(',')','!','#','%','^','~','-','''','&','@']; simvN : set of char = ['A'..'Z','a'..'z',''..'',' '..'']; simvD : set of char = ['0'..'9','.']; simvDIG : set of char = ['0'..'9']; krifind: array [1..8] of string[8]=('number','sur','name','otch', 'dateburn','surdoc','namedoc','otchdoc'); type ill = record number: integer;{ 窨} sur: string[20];{ } name: string[20];{} otch: string[20];{⢮} dateburn: string[20];{ } surdoc: string[20];{ } namedoc: string[20];{ } otchdoc: string[20];{⢮ } end; masi = array[1..illcount] of ill; fff = file of ill; max = array[1..3,1..28] of integer; var pass, flag, open, admin: boolean; m: max; numb, numfind, illind, posx, simv, sim, i: integer; tempmas: array[1..9] of string; masill: masi; fileill: fff; Procedure menucl; Procedure Screen(color:byte); Function GotoCen(s:string):integer; Procedure lines(color:byte); Procedure space(n:byte); Procedure clear; Procedure MakeRamka(x0,y0:integer; s:string; x,y:integer;color,fon:byte); Procedure field; Procedure archieve; Procedure menuarchh; Procedure menunewkar; Procedure menufinder; Procedure user; Procedure menus; Procedure zastavka; Procedure password; Implementation procedure menucl; var i:integer; begin{menucl} textbackground(blue); for i:=1 to 20 do begin gotoxy(2,i+2); writeln(' '); end; end;{menucl} Procedure Screen(color:byte); Var i:integer; begin{screen} textbackGround(color); for i:=1 to 25 do writeln(' '); gotoXY(1,1); end;{screen} Function GotoCen(s:string):integer; begin{gotocen} GotoCen:=(80-length(s)) div 2; end;{gotocen} Procedure lines(color:byte); var i:byte; begin{lines} textcolor(color); gotoXY(gotocen(nameprog),1);writeln(NameProg); write(line1); for i:=3 to 25 do begin gotoxy(19,i); write(''); end; textcolor(yellow); end;{lines} Procedure space(n:byte); Var i:byte; begin{space} for i:=1 to n do write(' '); end;{space} Procedure Clear; var x,y:byte; begin{clear} textbackground(blue); For y:=3 to 24 do For x:=20 to 80 do Begin gotoxy(x,y); write(' '); end; end;{clear} Procedure MakeRamka(x0,y0:integer; s:string; x,y:integer;color,fon:byte); var i,j:integer; begin {MakeRamka} textbackground(fon); textcolor(color); gotoxy(x0,y0);write(''); for i:=x0+1 to x-1 do begin gotoxy(i,y0); write(''); end; Write(''); gotoxy(10+gotocen(s),y0); textcolor(white); write(s); for i:=y0+1 to y-1 do begin j:=x0; textcolor(color); gotoxy(j,i); write(''); textcolor(white); for j:=x0+1 to x-1 do write(' '); TextColor(color); write(''); end; gotoxy(x0,y); write(''); for i:=x0+1 to x-1 do write(''); write(''); textcolor(yellow); end; {MakeRamka} procedure field; var i:integer; begin{field} MakeRamka(22,3,'Delo uchschegosya',78,24,white,cyan); textcolor(black); gotoxy(24,5); write(' Dela '); gotoxy(24,7); write(' '); gotoxy(24,9); write(''); gotoxy(24,11); write(' '); gotoxy(24,13); write(' '); gotoxy(24,15); write('Familiya kuratora '); gotoxy(24,17); write('Imya kuratora '); gotoxy(24,19); write('Otchestvo kuratora '); gotoxy(24,23); write(' F8 - '); textbackground(black); textcolor(white); for i:=1 to 9 do begin gotoxy(50,3+i*2); write(' '); end; end;{field} procedure archieve; var i:integer;{ 横 } begin{archieve} MakeRamka(22,3,' / 㧪 ',78,24,white,cyan); textcolor(black); textbackground(cyan); gotoxy(30,13); write(' '); {뢮 ।०} gotoxy(30,15); write(' ! 饣 '); gotoxy(30,16); write(' , 독'); gotoxy(30,17); write(' ᮤন!'); textbackground(black); textcolor(white); gotoxy(40,13); write(' '); end;{archieve} procedure menuarchh; var io, pos, i, ii, ind: integer; ch: char; s: string; begin{menuarchh} s:=''; menucl; ind:=1; pos:=41; ii:=1; archieve; repeat repeat for i:=1 to 3 do begin if i=ind then begin textbackground(white); textcolor(black); end else begin textcolor(white); textbackground(black); end; gotoxy(2,i*2+1); write(menuarch[i]); end; ch:=readkey; gotoxy(30,19); textbackground(cyan); write(' '); textcolor(white); case ch of #8:{backspace} if (s<>'') then begin dec(ii); delete(s,ii,1); textbackground(black); textcolor(white); gotoxy(40,13); write(' '); gotoxy(40,13); write(s); end; #80: if ind<>3 then inc(ind); #72: if ind<>1 then dec(ind); else if chr(ord(ch)) in simvv then if ii<=8 then begin gotoxy(40,13); s:=s+chr(ord(ch)); textbackground(black); textcolor(white); write(s); inc(ii); end; end; until ch=#13; assign(fileill,s+'.dat'); case ind of 1: begin rewrite(fileill); for i:=1 to illcount do write(fileill,masill[i]); close(fileill); ind:=3; end; 2: begin {$i-} reset(fileill); io:=ioresult; {$i+} If io = 0 then begin for i:=1 to illcount do read(fileill,masill[i]); close(fileill); end; end; end; if (ind = 2) then if (io = 0) then ind:=3 else begin textcolor(red); textbackground(cyan); gotoxy(30,19); write(' !'); end; until ind=3; clear; end;{menuarchh} procedure menunewkar; var numerr, tmp, code,ii, posy, i, ind:integer; ch:char; tempm:array [1..9] of string[20]; s,ss:string[20]; sd: char; errd, flagg:boolean; begin{menunewkar} menucl; ind:=1; field; posy:=1; ii:=1; s:=''; if flag then numb:=numfind else for i:=illcount downto 1 do if (masill[i].number = 0) then numb:=i; {+++++++++++++++++++++} gotoxy(50,posy*2+3); write(numb); if flag then begin str(numb,ss); tempm[1]:=ss; tempm[2]:=masill[numb].sur; tempm[3]:=masill[numb].name; tempm[4]:=masill[numb].otch; tempm[5]:=masill[numb].dateburn; tempm[6]:=masill[numb].surdoc; tempm[7]:=masill[numb].namedoc; tempm[8]:=masill[numb].otchdoc; for i:=1 to 8 do begin gotoxy(50,i*2+3); write(' '); gotoxy(50,i*2+3); write(tempm[i]); end; end else begin tempm[1]:=''; tempm[2]:=''; tempm[3]:=''; tempm[4]:=''; tempm[5]:=''; tempm[6]:=''; tempm[7]:=''; tempm[8]:=''; tempm[9]:=''; end; repeat repeat for i:=1 to 2 do begin if i=ind then begin textbackground(white); textcolor(black); end else begin textcolor(white); textbackground(black); end; gotoxy(2,i*2+1); write(menunew[i]); end; gotoxy(50,posy*2+5); ch:=readkey; errd:=false; case ch of #66: if admin then begin masill[numb].number:=0; masill[numb].sur:=''; masill[numb].name:=''; masill[numb].otch:=''; masill[numb].dateburn:=''; masill[numb].surdoc:=''; masill[numb].namedoc:=''; masill[numb].otchdoc:=''; ch:=#13; ind:=2; end; #9: begin textbackground(black); textcolor(white); s:=''; if posy = 8 then posy:=1 else inc(posy); ii:=1; end; #83: {delete} if admin then {if ch=chr(0) { then } begin gotoxy(50,posy*2+5); write(' '); s:=''; ii:=1; end; #8:{backspase} if admin then if (s<>'') then begin dec(ii); delete(s,ii,1); textbackground(black); textcolor(white); gotoxy(50,posy*2+5); write(' '); gotoxy(50,posy*2+5); write(s); end; #80: if ind=1 then inc(ind); #72: if ind=2 then dec(ind); else if admin then begin if (posy=4) or (posy=8) then flagg:=true else flagg:=false; if ((chr(ord(ch)) in simvN) and not(flagg)) or ((chr(ord(ch)) in simvD) and flagg) then if ii<=15 then begin if flagg then begin case ii of 1,2,4,5,7,8,9,10: if not((chr(ord(ch)) in simvdig)) then errd:=true; 3,6: if (ch<>'.') then errd:=true; else errd:=true; end; end; if not(errd) then begin s:=s+chr(ord(ch)); tempm[posy+1]:=s; textbackground(black); textcolor(white); gotoxy(50,posy*2+5); write(' '); gotoxy(50,posy*2+5); write(s); inc(ii); end; end; end; end; until ch=#13; case ind of 1: if admin then begin if flag then numb:=numfind; masill[numb].number:=numb; masill[numb].sur:=tempm[2]; masill[numb].name:=tempm[3];; masill[numb].otch:=tempm[4]; masill[numb].dateburn:=tempm[5]; masill[numb].surdoc:=tempm[6]; masill[numb].namedoc:=tempm[7]; masill[numb].otchdoc:=tempm[8]; ind:=2 end; 2: begin dec(numb); ind:=2 end; end; until ind=2; tempm[posy+1]:=s; s:=''; clear; flag:=false; end;{menunewkar} procedure menufinder;{+++++++++++++++++++++++++++++++++++++++++} var t, code, tt, tmp, ii, posy, i, ind:integer; ch:char; tempm:array [1..8] of string[20]; s:string[20]; flagg:boolean; begin{menufinder} menucl; ind:=1; field; posy:=1; ii:=1; s:=''; for i:=1 to 8 do tempm[i]:=''; repeat repeat for i:=1 to 2 do begin if i=ind then begin textbackground(white); textcolor(black); end else begin textcolor(white); textbackground(black); end; gotoxy(2,i*2+1); write(menufind[i]); end; gotoxy(50,posy*2+3); ch:=readkey; case ch of #9: begin s:=''; if posy = 9 then posy:=1 else inc(posy); for tmp:=1 to 9 do begin gotoxy(50,tmp*2+3); write(' '); end; ii:=1; end; #8:{backspase} if (s<>'') then begin dec(ii); delete(s,ii,1); textbackground(black); textcolor(white); gotoxy(50,posy*2+3); write(' '); gotoxy(50,posy*2+3); write(s); end; #80: if ind=1 then inc(ind); #72: if ind=2 then dec(ind); else begin if (posy=1) or (posy=5) or (posy=9) then flagg:=true else flagg:=false; if ((chr(ord(ch)) in simvN) and not(flagg)) or ((chr(ord(ch)) in simvD) and flagg) then if ii<=15 then begin gotoxy(50,posy*2+3); s:=s+chr(ord(ch)); textbackground(black); textcolor(white); write(s); inc(ii); end; end; end; until ch=#13; if ind=1 then begin MakeRamka(22,3,'᮪ :',78,24,white,cyan); tt:=1; for tmp:=1 to illcount do begin flag:=false; val(s,t,code); case posy of 1: if ((masill[tmp].number = t) and (t<>0)) then flag:=true; 2: if (masill[tmp].sur = s) then flag:=true; 3: if (masill[tmp].name = s) then flag:=true; 4: if (masill[tmp].otch = s) then flag:=true; 5: if (masill[tmp].dateburn = s) then flag:=true; 6: if (masill[tmp].surdoc = s) then flag:=true; 7: if (masill[tmp].namedoc = s) then flag:=true; 8: if (masill[tmp].otchdoc = s) then flag:=true; end; if s='' then flag:=false; if flag then begin textcolor(black); textbackground(cyan); gotoxy(40,tt+5); write(': ',masill[tmp].number); gotoxy(47,tt+5); write(' : '+masill[tmp].sur); inc(tt); end; end; textcolor(black); textbackground(cyan); gotoxy(24,4); write(' 祩:'); textcolor(white); textbackground(black); gotoxy(24,5); write(' '); gotoxy(24,5); s:=''; flag:=false; repeat ch:=readkey; if chr(ord(ch)) in simvdig then begin s:=s+chr(ord(ch)); flag:=true; val(s,t,code); if ((t>100) or (t<0) or (s='00')) then begin s:=''; gotoxy(24,5); write(' '); flag:=false; end; gotoxy(24,5); write(' '); gotoxy(24,5); write(s); end; until ((ch=#13) or (ch=#27)); if ch=#27 then begin ind:=2; flag:=false end else if ((ch=#13) and flag) then begin ind:=2; val(s,t,code); numfind:=t; end; end; until ind=2; clear; end;{menufinder} procedure user; var ind:shortint; ch:char; begin {user} ind:=1; MakeRamka(22,8,'롥⥯짮 ⥫:',78,13,white,cyan); repeat for i:=1 to 2 do{ᮢ 㭪 롮 } begin if i=ind then begin textcolor(black); textbackground(white) end else begin textcolor(white); textbackground(black) end; gotoxy(30,9+i); write(menuuser[i]); end; ch:=readkey; if ((ch=#80) and (ind=1)) then inc(ind); if ((ch=#72) and (ind=2)) then dec(ind); until ch=#13;{ } if ind=1 then password else admin:=false; clear; end; {user} procedure menus; var i, ind:integer; ch:char; begin{menus} flag:=false; ind:=1; menucl; numb:=0; repeat repeat for i:=1 to 5 do begin if i=ind then begin textbackground(white); textcolor(black); end else begin textcolor(white); textbackground(black); end; gotoxy(2,i*2+1); write(mmenu[i]); end; ch:=readkey; if ((ch=#80) and (ind<>5)) then inc(ind); if ((ch=#72) and (ind<>1)) then dec(ind); until ch=#13; case ind of 1: if admin then menunewkar; 2: if admin then menuarchh; 3: menufinder; 4: user; end; if flag then menunewkar; until ind=5; end;{menus} procedure zastavka; var mart, mart2: boolean; schmart: integer; begin{zastavka} mart:=false; mart2:=false; schmart:=0; TextBackGround(Black); TextColor(Green); Randomize; Clrscr; sim:=0; repeat if schmart=80 then mart:=true; if schmart=100 then mart2:=true; if schmart=200 then begin mart:=false; mart2:=false; schmart:=0; end; if sim<25 then begin repeat posx:=random(27)+1 until m[1,posx]=0; if mart then case posx of 9: simv:=84; 10, 23: simv:=72; 11: simv:=69; 12: simv:=95; 13: simv:=66; 14, 16: simv:=65; 15: simv:=90; 17, 18, 19: simv:=33; else simv:=random(24)+97 end else simv:=random(24)+97; m[1,posx]:=posx; m[2,posx]:=simv; m[3,posx]:=m[3,posx]+1; sim:=sim+1; end; delay(7000); for i:=1 to 27 do begin if m[1,i]<>0 then if not((m[3,i]=12) and mart2 and (m[1,i]>8) and (m[1,i]<20)) then begin gotoxy(m[1,i]*3-2,m[3,i]); write(chr(m[2,i])); gotoxy(m[1,i]*3-2,m[3,i]-1); write(' '); gotoxy(m[1,i]*3-2,m[3,i]); m[3,i]:=m[3,i]+1; end; if m[3,i]>25 then begin m[1,i]:=0; m[2,i]:=0; m[3,i]:=0; gotoxy(m[1,i]*3-2,m[3,i]); write(chr(m[2,i])); sim:=sim-1; end; end; inc(schmart); until keypressed; screen(blue); lines(white); end;{zastavka} procedure password; var s:string[16]; i,ii:integer; ch:char; begin{password} MakeRamka(22,8,'⥯ 㯪 :',78,14,white,cyan); textcolor(white); textbackground(black); gotoxy(42,11); writeln(' '); gotoxy(42,11); ii:=0; s:=''; admin:=false; repeat ch:=readkey; case ch of #72:; #75:; #77:; #80:; #8:{backspase} if (s<>'') then begin delete(s,ii,1); dec(ii); textbackground(black); textcolor(white); gotoxy(42,11); write(' '); gotoxy(42,11); for i:=1 to ii do write('*'); end; else if (chr(ord(ch)) in simvV) then if ii<=15 then begin gotoxy(42,11); s:=s+chr(ord(ch)); textbackground(black); textcolor(white); inc(ii); for i:=1 to ii do write('*'); end; end; until ((ch=#13) or (ch=#27)); if ch=#27 { Esc} then admin:=false else if s=PasswordX then admin:=true else begin s:=''; textcolor(red); textbackground(cyan); gotoxy(42,13); write(' !'); gotoxy(42,11); textcolor(white); textbackground(black); write(' '); gotoxy(42,11); ch:=readkey; password; end; clear; end;{password} .1 , ASCII .2 ( : password ) .3 .4 .5 \ .6 , .7 .8 , Reg.exe, - . ( ): ) ( :password); ) Esc .
|