Создать базу данных по компьютерной технике. База дынных организует хранение информации таким образом, чтобы ее было удобно: просматривать, пополнять, изменять, искать нужные сведения, делать любые выборки, осуществлять сортировку в любом порядке. Программа осуществляет упорядочение товара по следующим критериям: комплектующие, периферия, мультимедиа — Pascal(Паскаль)

Program baza;
Uses crt;
label 10;
type spisok=record
     imja:string;
     fam:string;
     nomer:integer;
     gorod:string;
     end;
FT= file of spisok;
Var a:ft;
    i,z:integer;
    s:real;
Procedure Sozd (var a:ft);
Var i,j:integer;
    zk:spisok;
begin
rewrite (a);
j:=1;
 while j<>80 do
          begin
          write ('vvedite imja ');
          readln (zk.imja);
          write ('Vvedite familiIo ');
          readln (zk.fam);
          write ('vvedite nomer telefona ');
          Readln (zk.nomer);
          write ('vvedite gorod ');
          readln (zk.gorod);
          write (a,zk);
          writeln ('Esli konec zapisi to nazhmite 80 ');
          readln (j);
          end;
close (a);
end;
Procedure vyvod (var a:ft);
Var i:integer;
    zk:spisok;
begin
reset (a);
 writeln ('=================================');
 writeln ('| imja| familija| telefon| gorod|');
 writeln ('=================================');
  while not eof(a) do
   begin
    read (a,zk);
    write ('|',zk.imja:6,'|');
    write ('|',zk.fam:9,'|');
    write ('|',zk.nomer:6,'|');
    write ('|',zk.gorod:9,'|');
    writeln;
    writeln ('-------------------------------');
   end;
close (a);
end;
procedure delete (var a:ft);
Var n,m:longint;
      i:byte;
      mas:array [1..20] of spisok;
begin
 i:=1;
 reset(a);
 writeln ('vvedite nomer zapisi dlja udalenija ');
 readln(n);
 m:=filesize(a)-n;
 seek (a,n);
 while not eof(a) do
           begin
            read (a,mas[i]);
            i:=i+1;
           end;
 close (a);
 reset (a);
 seek (a,n-1);
 truncate (a);
 close (a);
 reset (a);
 seek (a,n-1);
  for i:=1 to m do
   write (a,mas[i]);
end;
Procedure poisk (var a:ft);
var i:integer;
    zk:spisok;
    name:string;
begin
reset (a);
 writeln ('Vvedite imja dlja poiska ');
 readln (name);
 writeln ('spisok s zadannym imenem ');
 writeln ('=================================');
 writeln ('| imja| familija| telefon| gorod|');
 writeln ('=================================');
 while not eof(a) do
 begin
  read (a,zk);
  if zk.imja=name then
  begin
    write ('|',zk.imja:6,'|');
    write ('|',zk.fam:9,'|');
    write ('|',zk.nomer:6,'|');
    write ('|',zk.gorod:9,'|');
    writeln;
    writeln ('-------------------------------');
  end;
 end;
close(a);
end;
begin
clrscr;
10:
assign (a,'fff');
writeln ('       MEHIO      ');
writeln ('1:cozdanie ');
writeln ('2:vyvod ');
writeln ('3:delete ');
writeln ('4:poisk ');
writeln ('5:vyxod ');
readln (z);
 case z of
  1:sozd(a);
  2:vyvod (a);
  3:delete(a);
  4:poisk (a);
  5:exit;
  end; goto 10;
readln
end.

Вариант 2

Program baza;
Uses crt;
label 10;
type spisok=record
     imja:string;
     fam:string;
     nomer:integer;
     gorod:string;
     end;
FT= file of spisok;
Var a:ft;
    i,z:integer;
    s:real;
Procedure Sozd (var a:ft);
Var i,j:integer;
    zk:spisok;
begin
rewrite (a);
j:=1;
 while j<>80 do
          begin
          write ('vvedite imja ');
          readln (zk.imja);
          write ('Vvedite familiIo ');
          readln (zk.fam);
          write ('vvedite nomer telefona ');
          Readln (zk.nomer);
          write ('vvedite gorod ');
          readln (zk.gorod);
          write (a,zk);
          writeln ('Esli konec zapisi to nazhmite 80 ');
          readln (j);
          end;
close (a);
end;
Procedure vyvod (var a:ft);
Var i:integer;
    zk:spisok;
begin
reset (a);
 writeln ('=================================');
 writeln ('| imja| familija| telefon| gorod|');
 writeln ('=================================');
  while not eof(a) do
   begin
    read (a,zk);
    write ('|',zk.imja:6,'|');
    write ('|',zk.fam:9,'|');
    write ('|',zk.nomer:6,'|');
    write ('|',zk.gorod:9,'|');
    writeln;
    writeln ('-------------------------------');
   end;
close (a);
end;
procedure delete (var a:ft);
Var n,m:longint;
      i:byte;
      mas:array [1..20] of spisok;
begin
 i:=1;
 reset(a);
 writeln ('vvedite nomer zapisi dlja udalenija ');
 readln(n);
 m:=filesize(a)-n;
 seek (a,n);
 while not eof(a) do
           begin
            read (a,mas[i]);
            i:=i+1;
           end;
 close (a);
 reset (a);
 seek (a,n-1);
 truncate (a);
 close (a);
 reset (a);
 seek (a,n-1);
  for i:=1 to m do
   write (a,mas[i]);
end;
Procedure poisk (var a:ft);
var i:integer;
    zk:spisok;
    name:string;
begin
reset (a);
 writeln ('Vvedite imja dlja poiska ');
 readln (name);
 writeln ('spisok s zadannym imenem ');
 writeln ('=================================');
 writeln ('| imja| familija| telefon| gorod|');
 writeln ('=================================');
 while not eof(a) do
 begin
  read (a,zk);
  if zk.imja=name then
  begin
    write ('|',zk.imja:6,'|');
    write ('|',zk.fam:9,'|');
    write ('|',zk.nomer:6,'|');
    write ('|',zk.gorod:9,'|');
    writeln;
    writeln ('-------------------------------');
  end;
 end;
close(a);
end;

begin
clrscr;
assign (a,'fff');
repeat
clrscr;
writeln ('       MEHIO      ');
writeln ('1:cozdanie ');
writeln ('2:vyvod ');
writeln ('3:delete ');
writeln ('4:poisk ');
writeln ('5:vyxod ');
readln (z);
 case z of
  1:sozd(a);
  2:vyvod (a);
  3:delete(a);
  4:poisk (a);
  5:exit;
  end; 
until not(z in [1..4]);  
readln
end.

Похожие записи/страницы:

Leave a Comment

29 − 24 =