Версия для печати темы

{ NemoLaboratory.ru
Author: nemo
}

program directory;

uses crt;type integ=^int;
int=record nomer:integer;next:integ;end;

var
nach:integ;
tek:integ;
d:integ;
i:integer;
ch:char;
rozd:string;
nabor:integer;
men:array[1..16]of integer;
strok,stolb:integer;
lom:integer;
vof:boolean;
razdel:integer;
podrazd:integer;
mrazdel:integer;
stek:text;
scetrp:integer;
hod:integer;
kolvo:integer;
text1,text2,text3,text4:string[19];
f:text;
f1,f2,f3,f4,f8,pd,pu,f10:integer;
Prin:boolean;

baza:record
fsim:string;
fKod:integer;
frazdel:integer;
fpodrazdel:integer;
fname:string;
fseria:string;
fproizvod:string;
fopisan:string;
fmany:string;
end;

procedure shapka;
var mainname:string;

begin
gotoxy(30,1);textcolor(14);gotoxy(1,2);textcolor(11);
for i:=1to 80do write('-');for i:=3to 21do
begin gotoxy(20,i);textcolor(11);writeln('|');end;
gotoxy(1,22);for i:=1to 80do write('-');
gotoxy(1,23);textcolor(F1);writeln('About F1|');
gotoxy(11,23);textcolor(F2);writeln('New F2|');
gotoxy(20,23);textcolor(f3);writeln('Find F3|');
gotoxy(29,23);textcolor(f4);writeln('Copy F4|');
gotoxy(38,23);textcolor(f8);writeln('Delete F8|');
gotoxy(49,23);textcolor(pu);writeln('Back PUp|');
gotoxy(59,23);textcolor(pd);writeln('Next PDown|');
gotoxy(71,23);textcolor(f10);writeln('Exit F10');
gotoxy(1,24);for i:=1to 80do write('-');
gotoxy(1,17);textcolor(11);writeln('-------------------');
if rozd='0'then mainname:='DIRECTORY';
if rozd='1'then mainname:='DIRECTORY 2';
if rozd='2'then mainname:='DIRECTORY 2';
if rozd='3'then mainname:='DIRECTORY 3';
if rozd='4'then mainname:='DIRECTORY 4';
if rozd='5'then mainname:='DIRECTORY 5';
if rozd='6'then mainname:='DIRECTORY 6';
if rozd='7'then mainname:='DIRECTORY 7';
if rozd='8'then mainname:='DIRECTORY 8';
if rozd='9'then mainname:='DIRECTORY 9';
gotoxy(30,1);textcolor(13);writeln(mainname);
gotoxy(1,18);textcolor(12);writeln(text1);
gotoxy(1,19);textcolor(12);writeln(text2);
gotoxy(1,20);textcolor(12);writeln(text3);
gotoxy(1,21);textcolor(12);writeln(text4);
end;

procedure podrazdel;
var podraz:array[1..16]of string;
z:integer;
f:text;
d:string;

begin
assign(f,'C:\prog\razdel.dat');reset(f);nabor:=0;
while not Eof(f)do

begin 
readln(f,d);if d=rozd then

begin
nabor:=nabor+1;readln(f,d);podraz[nabor]:=d;end else readln(f,d);end;close(f);z:=3;
for i:=1to nabor do

begin
textcolor(men[i]);gotoxy(2,z);writeln(podraz[i]);z:=z+1
end;
end;

procedure addspisok;

begin
new(tek);
tek^.nomer:=baza.fkod;
tek^.next:=nach;
nach:=tek;
kolvo:=kolvo+1;
end;

procedure tablo;
var opis1,opis2,opis3:string;

begin
gotoxy(22,3);textcolor(10);writeln('Code the goods ');
gotoxy(33,3);textcolor(11);writeln(baza.fkod);
gotoxy(43,3);textcolor(10);writeln('Undress ');
gotoxy(50,3);textcolor(11);writeln(baza.frazdel);
gotoxy(60,3);textcolor(10);writeln('Subsection ');
gotoxy(70,3);textcolor(11);writeln(baza.fpodrazdel);
gotoxy(22,5);textcolor(10);writeln('Name: ');
opis1:=copy(baza.fname,1,58);
opis2:=copy(baza.fname,59,117);
opis3:=copy(baza.fname,118,126);
gotoxy(22,6);textcolor(11);writeln(opis1);
gotoxy(22,7);textcolor(11);writeln(opis2);
gotoxy(22,8);textcolor(11);writeln(opis3);
gotoxy(22,10);textcolor(10);writeln('Series:');
gotoxy(30,10);textcolor(11);writeln(baza.fseria);
gotoxy(22,12);textcolor(10);writeln('Manufacturer:');
gotoxy(22,13);textcolor(11);writeln(baza.fproizvod);
opis1:=copy(baza.fopisan,1,58);
opis2:=copy(baza.fopisan,59,117);
opis3:=copy(baza.fopisan,118,126);
gotoxy(22,15);textcolor(10);writeln('Description:');
gotoxy(22,16);textcolor(11);writeln(opis1);
gotoxy(22,17);textcolor(11);writeln(opis2);
gotoxy(22,18);textcolor(11);writeln(opis3);
gotoxy(22,20);textcolor(10);writeln('Cost');
gotoxy(35,20);textcolor(11);writeln(baza.fmany);
end;

procedure writespisok;
var f:text;

begin
if scetrp<>0then

begin
tek:=nach;
assign(f,'C:\prog\bd.dat');
reset(f);
while not eof(f)do

begin
readln(f,baza.fkod);
readln(f,baza.frazdel);
readln(f,baza.fpodRazdel);
readln(f,baza.fname);
readln(f,baza.fseria);
readln(f,baza.fproizvod);
readln(f,baza.fopisan);
readln(f,baza.fmany);
readln(f,baza.fsim);
if baza.fkod=tek^.nomer then

begin
clrscr;
shapka; podrazdel;
gotoxy(1,1);
gotoxy(60,1);write('In total positions: ',scetrp);
tablo;
end;
end;

close(f);
end
else

begin
gotoxy(22,11);textcolor(10);writeln('The goods are not present, for an output from the given category press Esc');
f1:=7;f2:=11;f3:=7;f4:=7;f8:=7;pu:=7;pd:=7;f10:=7;
text1:='Move buttons';
text2:='PageDown,PageUp    ';
text3:='For an output press ';
text4:='Esc                ';
shapka;podrazdel;
end;
end;

procedure delspisok;

begin
tek:=nach;
nach:=tek^.next;
dispose(tek);
tek:=nach;
kolvo:=kolvo-1;
end;

procedure rp;

begin
assign(f,'C:\prog\bd.dat');
reset(f);
while(not eof(f))do

begin
readln(f,baza.fkod);
readln(f,baza.frazdel);
readln(f,baza.fpodRazdel);
readln(f,baza.fname);
readln(f,baza.fseria);
readln(f,baza.fproizvod);
readln(f,baza.fopisan);
readln(f,baza.fmany);
readln(f,baza.fsim);
if(baza.frazdel=mrazdel)and(baza.fpodrazdel=podrazd)then

begin
addspisok;
break;
end;
end;
end;

procedure poiskfpr;

var 
good,nal:boolean;
zed:integer;

begin
assign (f,'C:\prog\bd.dat');
reset(f);
nal:=false;
while(not eof(f))or(nal=false)do

begin
readln(f,baza.fkod);
readln(f,baza.frazdel);
readln(f,baza.fpodRazdel);
readln(f,baza.fname);
readln(f,baza.fseria);
readln(f,baza.fproizvod);
readln(f,baza.fopisan);
readln(f,baza.fmany);
readln(f,baza.fsim);
if((baza.frazdel=mrazdel)and(baza.fpodrazdel=podrazd))then

begin
zed:=0;
good:=false;
d:=nil;
tek:=nach;
while(tek<>nil)or(good=false)do

begin
if tek^.nomer=baza.fkod then good:=true;
d:=tek;
tek:=tek^.next;
zed:=zed+1;
if zed=kolvo then break;
end;
if good<>true then

begin
nal:=true;
break;
end;
end;
end;
close(f);
end;

procedure schet;

begin
ScetRP:=0;
assign(f,'C:\prog\bd.dat');
reset(f);
while not eof(f)do

begin
readln(f,baza.fkod);
readln(f,baza.frazdel);
readln(f,baza.fpodRazdel);
readln(f,baza.fname);
readln(f,baza.fseria);
readln(f,baza.fproizvod);
readln(f,baza.fopisan);
readln(f,baza.fmany);
readln(f,baza.fsim);
if (baza.frazdel=mrazdel)and(baza.fpodrazdel=podrazd)then
scetrp:=scetrp+1;
end;
close(f);
end;

procedure del;

var fdel:text;

begin
gotoxy(27,21);textcolor(21);
writeln('You really wish to delete a file Y/N');
ch:=readkey;
if(ord(ch)=121)or(ord(ch)=173)then

begin
assign(f,'C:\prog\bd.dat');
assign(fdel,'C:\prog\bdvr.dat');
reset(f);
rewrite(fdel);

while not eof(f)do
begin

readln(f,baza.fkod);
readln(f,baza.frazdel);
readln(f,baza.fpodRazdel);
readln(f,baza.fname);
readln(f,baza.fseria);
readln(f,baza.fproizvod);
readln(f,baza.fopisan);
readln(f,baza.fmany);
readln(f,baza.fsim);
if baza.fkod<>tek^.nomer then

begin
writeln(fdel,baza.fkod);
writeln(fdel,baza.frazdel);
writeln(fdel,baza.fpodrazdel);
writeln(fdel,baza.fname);
writeln(fdel,baza.fseria);
writeln(fdel,baza.fproizvod);
writeln(fdel,baza.fopisan);
writeln(fdel,baza.fmany);
writeln(fdel,baza.fsim);
end
end;
close(f);
close(fDel);
reset(fDel);
rewrite(f);
while not eof(fdel)do

begin
readln(fdel,baza.fkod);writeln(f,baza.fkod);
readln(fdel,baza.frazdel);writeln(f,baza.frazdel);
readln(fdel,baza.fpodRazdel);writeln(f,baza.fpodrazdel);
readln(fdel,baza.fname);writeln(f,baza.fname);
readln(fdel,baza.fseria);writeln(f,baza.fseria);
readln(fdel,baza.fproizvod);writeln(f,baza.fproizvod);
readln(fdel,baza.fopisan);writeln(f,baza.fopisan);
readln(fdel,baza.fmany);writeln(f,baza.fmany);
readln(fdel,baza.fsim);writeln(f,baza.fsim);
end;

close(fdel);
close(f);
gotoxy(27,21);textcolor(21);writeln('Record is remote for operation continuation press Esc');
end;

if ord(ch)=110then begin
gotoxy(27,21);textcolor(21);writeln('Removal is cancelled for operation continuation press Esc');
end;
end;

procedure printf;
var fname1,fname2,fname3:string;
fotchet:text;

begin
clrscr;
gotoxy(10,10);textcolor(11);writeln('For printing of all positions of current subsection press F3');
gotoxy(10,12);writeln('For the press flowing positions press F5');
gotoxy(10,14);writeln('For an output press Backspace');

repeat
ch:=readkey;
if(ord(ch)=61)or(ord(ch)=63)then 

begin
fname1:='C:\prog\';
fname3:='.txt';
gotoxy(10,16);writeln('Enter a filename in which it is necessary to save the report');
gotoxy(10,17);writeln('also press input. The report file is in a root folder');
gotoxy(10,19);readln(fname2);
assign(fotchet,fname1+fname2+fname3);
assign(f,'C:\prog\bd.dat');
reset(f);
rewrite(fotchet);
end;

if ord(ch)=61then

begin
writeln(fotchet,'The report on subsection  ');
writeln;
writeln(fotchet,'---------------------------------------------------------');
while not eof(f)do

begin
readln(f,baza.fkod);
readln(f,baza.frazdel);
readln(f,baza.fpodrazdel);
readln(f,baza.fname);
readln(f,baza.fseria);
readln(f,baza.fproizvod);
readln(f,baza.fopisan);
readln(f,baza.fmany);
readln(f,baza.fsim);
if(baza.frazdel=mrazdel)and(baza.fpodrazdel=podrazd)then

begin
write(fotchet,'Goods code    '); writeln(fotchet,baza.fkod);
write(fotchet,'Name      ');writeln(fotchet,baza.fname);
write(fotchet,'Series         ');writeln(fotchet,baza.fseria);
write(fotchet,'Manufacturer ');writeln(fotchet,baza.fproizvod);
write(fotchet,'Description      ');writeln(fotchet,baza.fopisan);
write(fotchet,'Price          ');writeln(fotchet,baza.fmany);
writeln(fotchet,'-----------------------------------------');
end;
end;
close(fotchet);
close(f);
end;

if ord(ch)=63then

begin
tek:=nach;
writeln(fotchet,'The report on the current goods');
writeln;
writeln(fotchet,'---------------------------------------------------------');
while not Eof(f) do

begin
readln(f,baza.fkod);
readln(f,baza.frazdel);
readln(f,baza.fpodRazdel);
readln(f,baza.fname);
readln(f,baza.fseria);
readln(f,baza.fproizvod);
readln(f,baza.fopisan);
readln(f,baza.fmany);
readln(f,baza.fsim);

if(baza.fkod=tek^.nomer)then

begin
write(fotchet,'Goods code    '); writeln(fotchet,baza.fkod);
write(fotchet,'Name      ');writeln(fotchet,baza.fname);
write(fotchet,'Series         ');writeln(fotchet,baza.fseria);
write(fotchet,'Manufacturer ');writeln(fotchet,baza.fproizvod);
write(fotchet,'Description      ');writeln(fotchet,baza.fopisan);
write(fotchet,'Price          ');writeln(fotchet,baza.fmany);
writeln(fotchet,'-----------------------------------------');
end;
end;

close(fotchet);
close(f);
end;

until(ord(ch)=8)or(ord(ch)=61)or(ord(ch)=63);
clrscr;
shapka;
writespisok;
end;

procedure NewTovar;

var 
f1,f2,f3:text;
kod:integer;

begin
clrscr;
baza.frazdel:=mrazdel;baza.fpodrazdel:=podrazd;
gotoxy(10,1);textcolor(10);writeln('Fill the form. After filling of the next item press input');
gotoxy(3,4);writeln('Undress ',baza.frazdel);
gotoxy(3,5);writeln('Subsection ',baza.fpodRazdel);
gotoxy(3,6);writeln('Will be taken aback goods assignment');
gotoxy(3,8);writeln('Enter a goods series if there is no that enter the character "-" ');
gotoxy(3,10);writeln('Enter the manufacturer');
gotoxy(3,12);writeln('Will be taken aback the goods more in detail');
gotoxy(3,22);writeln('The goods price');
gotoxy(3,5);textcolor(11);
gotoxy(3,7);readln(baza.fname);
gotoxy(3,9);readln(baza.fseria);
gotoxy(3,11);readln(baza.fproizvod);
gotoxy(3,13);readln(baza.fopisan);
gotoxy(20,22);readln(baza.fmany);
gotoxy(10,23);textcolor(10);writeln('Save Y, Close N');
ch:=readkey;

if(ord(ch)=121)or(ord(ch)=173)then

begin
clrscr;
assign(f2,'C:\prog\kod.dat');
reset(f2);
while not eof(f2)do readln(f2,kod);
close(f2);
baza.fkod:=kod+1;
append(f2);
write(f2,'');
writeln(f2,baza.fkod);
close(f2);
assign(f3,'C:\prog\bd.dat');
append(f3);
writeln(f3,baza.fkod);
writeln(f3,baza.frazdel);
writeln(f3,baza.fpodrazdel);
writeln(f3,baza.fname);
writeln(f3,baza.fseria);
writeln(f3,baza.fproizvod);
writeln(f3,baza.fopisan);
writeln(f3,baza.fmany);
writeln(f3,'*');
close(f3);
gotoxy(18,12);writeln('Record is saved for continuation press input');
readln;
end;

clrscr;
shapka;
podrazdel;
gotoxy(27,21);textcolor(21);writeln('For operation continuation press Esc');
end;

procedure vivod;

var hod:integer;

begin
schet;
f1:=7;f2:=11;f3:=7;f4:=11;f8:=11;pu:=11;pd:=11;f10:=7;
Text1:='Move';
Text2:='- PageDown,PageUp';
Text3:='Exit';
Text4:='- Esc';
rp;
hod:=1;

writespisok;

repeat
ch:=readkey;
if(ord(ch)=81)and(ScetRP<>0)then

begin
if scetrp<>hod then

begin
hod:=hod+1;
poiskfpr;
addspisok;
writespisok;
end;
end;

if(ord(ch)=73)and(scetrp<>0)then

begin
if hod<>1then

begin
hod:=hod-1;
delspisok;
writespisok;
end;
end;

if ord(ch)=60then newtovar;
if(ord(ch)=66)and(scetrp<>0)then del;
if(ord(ch)=62)and(scetrp<>0)then printf;
until ord(ch)=27;
end;

procedure Vhod;

begin
lom:=1;
if ord(ch)=13then

begin
for i:=1to nabor do

begin
if (men[i]=15)then

begin
if razdel=1then

begin
podrazd:=lom;
vivod;
kolvo:=0;
end;

if(lom=1)and(razdel=0)then

begin
rozd:='1';
MRazdel:=1;
razdel:=1;
end;

if(lom=2)and(razdel=0)then begin rozd:='2';mrazdel:=2;razdel:=1;end;
if(lom=3)and(razdel=0)then begin rozd:='3';mrazdel:=3;razdel:=1;end;
if(lom=4)and(razdel=0)then begin rozd:='4';mrazdel:=4;razdel:=1;end;
if(lom=5)and(razdel=0)then begin rozd:='5';mrazdel:=5;razdel:=1;end;
if(lom=6)and(razdel=0)then begin rozd:='6';mrazdel:=6;razdel:=1;end;
if(lom=7)and(razdel=0)then begin rozd:='7';mrazdel:=7;razdel:=1;end;
if(lom=8)and(razdel=0)then begin rozd:='8';mrazdel:=8;razdel:=1;end;
if(lom=9)and(razdel=0)then begin rozd:='9';mrazdel:=9;razdel:=1;end;
end;
lom:=lom+1;
end;
end;

if ord(ch)=8then

begin
rozd:='0';
razdel:=0;
end;
podrazdel;
end;

procedure poisk;

var 
punkt:integer;
nsp:string;
fol:integer;

begin
clrscr;
fol:=0;
gotoxy(10,2);textcolor(10);writeln('Will select criteria of search');
textcolor(11);gotoxy(12,6);writeln('1: Name');
gotoxy(12,8);writeln('2: Series');
gotoxy(12,10);writeln('3: Manufacturer');
gotoxy(12,12);writeln('4: Close');

repeat

ch:=readkey;
if(ord(ch)=49)or(ord(ch)=50)or(ord(ch)=51)then

begin
gotoxy(12,14);writeln('Enter a condition and press input');
gotoxy(12,16);readln(nsp);
assign(f,'C:\prog\bd.dat');
reset(f);
while(not eof(f))do

begin
readln(f,baza.fkod);
readln(f,baza.frazdel);
readln(f,baza.fpodRazdel);
readln(f,baza.fname);
readln(f,baza.fseria);
readln(f,baza.fproizvod);
readln(f,baza.fopisan);
readln(f,baza.fmany);
readln(f,baza.fsim);

if(baza.fname=nsp)or(baza.fseria=nsp)or(baza.fproizvod=nsp)then

begin
clrscr;
tablo;
f1:=7;f2:=7;f3:=7;f4:=7;f8:=7;pu:=7;pd:=11; f10:=7;
text1:='Move';
text2:='- PageDown';
text3:='Exit';
text4:='- Esc';
shapka;
fol:=fol+1;

repeat

ch:=readkey;
until(ord(ch)=81)or(ord(ch)=27);
f1:=11;f2:=7;f3:=11;f4:=7;f8:=7;pu:=7;pd:=11;f10:=11;
if ord(ch)=27then break;
end;
end;

close(f);
clrscr;
gotoxy(15,12);textcolor(4);
if fol>0then writeln('More coincidences are not present, for operation continuation press input')
else writeln('Coincidences are not present, for operation continuation press input');
readln;
break;
end;

until ord(ch)=52;
clrscr;
text1:='Back';
text2:='- Backspase';
text3:='Next';
text4:='- Enter';
shapka;
podRazdel;
end;

procedure help;

var
k:string;
n:integer;

begin
clrscr;
n:=0;
assign(f,'C:\prog\help.dat');
reset(f);
while not eof(f)do

begin
if(n=24)or(n=48)or(n=72)or(n=96)or(n=120)or(n=120)then readln;
readln(f,k);
writeln(k);
n:=n+1;
end;

readln;
close(f);
clrscr;
Shapka;
podRazdel;
end;

procedure perem;

begin
men[1]:=15;men[2]:=2;men[3]:=2;men[4]:=2;men[5]:=2;men[6]:=2;men[7]:=2;
 men[8]:=2;men[9]:=2;men[10]:=2;men[11]:=2;men[12]:=2;men[13]:=2;men[14]:=2;men[1
5]:=2;

repeat

podRazdel;
strok:=1;
gotoxy(79,1);
ch:=readkey;
if(ord(ch)=80)then

begin
for i:=1to nabor do

begin
if(men[i]=15)and(strok<>nabor)then

begin
men[strok]:=2;
men[strok+1]:=15;
end
else strok:=strok+1;
end;
end;

if ord(ch)=72then

begin
for i:=1to nabor do

begin
if(men[i]=15)and(strok<>1)then

begin
men[strok]:=2;
men[strok-1]:=15;
end
else strok:=strok+1;
end;
end;

if ord(ch)=59then help;
if ord(ch)=61then poisk;
until(ord(ch)=13)or(ord(ch)=8)or(ord(ch)=68);
vof:=true;
if(ord(ch)<>68)then vhod;
end;

begin
rozd:='0';
razdel:=0;
vof:=false;

repeat

clrscr;
f1:=11;f2:=7;f3:=11;f4:=7;f8:=7;pu:=7;pd:=7;f10:=11;
text1:='Back';
text2:='- Backspase';
text3:='Next';
text4:='- Enter';
shapka;
gotoxy(79,1);
perem;
until(ord(ch)=68);
end.