Телефонный справочник на TC

[Qai]

помогите написать телефонный справочник на TC в его функции входят занесение новых имен и телефонов . редактирование старых . возможность их удаления + поиск по имени и телефоны или по части имени или телефону ... пожалуйста очень надо может у кого есть что то готовое а то срок сдачи поджимает .

[werser]

ТС - это что?

[werser]

Могу написать на турбо паскале!

[Qai]

ах да простите TC =turbo c

[werser]

Могу дать исходник на паскале передерёш там бегины на дужки и синтаксис и сдаш! Писал её на первом курсе

program adres_kn;
uses crt, graph;
label 1,2;
type baz=record
  fam:string[50];
  nam:string[50];
  fath:string[50];
  adr:string[50];
  tel:longint;
  end;
  file_baz=file of baz;
var
F:file_baz;
procedure mk_bd(var F:file_baz);
var
   s:string;
   c:char;
   x:baz;
begin
clrscr;
write('Vvedit imya stovoruvanogo failu - ');
readln(s);
assign(f,s);
rewrite(F);
repeat
     with x do
     begin
          write('Prizvushe  : '); readln(fam);
          write('Imya       : '); readln(nam);
          write('Po-batkovi : '); readln(fath);
          write('Adressa    : '); readln(adr);
          write('Telefon    : '); readln(tel);
     end;
     write(F,x);
     write('Chu budete vvodutu dani she? y/n - '); readln(c);
until (c='n') or (c='N');
close(F);
end;

procedure poisk(var F:file_baz);
var s,sc:string; n:integer;  y:longint;
    x:baz;
begin
clrscr;
write('Vvedit imya bazu dannuh - ');
   readln(s);
   assign(f,s);
   {$I-}
   reset(f);
   if IOResult<>0 then
   begin
   writeln('Takogo failu nemae ');
   while not keypressed do;
   halt
   end;
   {$I+}
   read(f,x);
writeln('Vuberit regum poshuku');
writeln;
writeln('Za Pruzvushem    - 1');
writeln('Za adressou      - 2');
writeln('Za telefonom     - 3');
readln(n);
case n of
1:begin
  write('Vvedit prusvushe - ');
  readln(sc);
  if sc=(x.fam) then
  begin
  Writeln(x.nam,' ',x.fath,' ',x.adr,' ',x.tel);
  end
  else writeln('Takogo prizvush v bazi nemae');end;
2:begin
  write('Vvedit adresuu - ');
  readln(sc);
  if sc=(x.adr) then
  begin
  Writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.tel);
  end
  else writeln('Takoi adressu v bazi nemae');end;
3:begin
  write('Vvedit telefon - ');
  readln(y);
  if y=(x.tel) then
  begin
  Writeln(x.fam,' ',x.nam,' ',x.fath,' ',x.adr);
  end
  else writeln('Takogo telefonu v bazi nemae');end;
end;
end;

procedure  prosm_bd(var F:file_baz);
var
  s:string;
  x:baz;
begin
clrscr;
   write('Vvedit imya bazu dannuh - ');
   readln(s);
   assign(f,s);
   {$I-}
   reset(f);
   if IOResult<>0 then
   begin
   writeln('Takogo failu nemae ');
   while not keypressed do;
   halt
   end;
   {$I+}
        while not eof(f) do
        begin
        read(f,x);
          with x do
          write('Prizvushe : ',fam,' Imya : ',nam,' Po-batkovi : ',fath,' Adressa : ',adr,' Telefon : ',tel,'  ');
        end;
close(f);
end;
procedure append_bd(var F:file_baz);
var
   s:string;
   c:char;
   x:baz;
begin
clrscr;
write('Vvedit imya failu bazu dannuh - ');
readln(s);
assign(f,s);
  {$I-}
   reset(f);
   if IOResult<>0 then
   begin
   writeln('Takogo failu nemae ');
   while not keypressed do;
   halt
   end;
   {$I+}
seek(f,filesize(f));
repeat
     with x do
     begin
          write('Prizvushe  : '); readln(fam);
          write('Imya       : '); readln(nam);
          write('Po-batkovi : '); readln(fath);
          write('Adressa    : '); readln(adr);
          write('Telefon    : '); readln(tel);
     end;
     write(F,x);
     write('Chu budete vvodutu dani she? y/n - '); readln(c);
until (c='n') or (c='N');
close(F);
end;
var z,c:integer;
begin
textbackground(blue);
1:clrscr;
textcolor(yellow);
gotoxy(26,9);
  write(chr(201));
      for c:=1 to 38 do write(chr(205));
        writeln(chr(187));
      for c:=10 to 21 do
        begin
          gotoxy(26,c);
          write(chr(186));
          gotoxy(65,c);
          writeln(chr(186));
        end;
      gotoxy(26,21);
      write(chr(200));
        for c:=1 to 38 do write(chr(205));
      gotoxy(65,21); write(chr(188));
writeln ;
gotoxy(27,10); textcolor(red);writeln(' A D R E S N A   K N U G A':20);
gotoxy(29,11);textcolor(yellow); writeln('=============================');
textcolor(yellow);
gotoxy(29,12);writeln('Sozdat bazu dannuh              - 1':30);
gotoxy(29,13);writeln('Prosmotret bazu dannuh          - 2':30);
gotoxy(29,14);writeln('Dobavit zapisi v  bazu dannuh   - 3':30);
gotoxy(29,15);writeln('Poisk v baze dannuh             - 4':30);
gotoxy(29,16);writeln('Vuhod                           - 5':30);
writeln;
2:gotoxy(29,17);textcolor(white);write('Vuberit regum robotu - ');readln(z);
if z>5 then begin gotoxy(29,18);textcolor(red); writeln('Takogo regumu nemae'); goto 2;
            end
  else
  repeat
  case z of
     1:begin
         mk_bd(f);
         readln; goto 1;
       end;
     2:begin
         prosm_bd(f);
         readln; goto 1;
       end;
     3:begin
         append_bd(f);
         readln; goto 1;
       end;
     4:begin
         poisk(f);
         readln; goto 1;
         end;end;
until z=5;
end.

Это час работы!

П.С. Если помогло то добавь отзыв плиз)

[Qai]

Всё это конечно хорошо тока мы Паскаль проходили так сказать на шару . то езь 2 недели ....((( так что переводить буду видимо долго ..так спасибо конечно большое .... И всё таки если у кого нить есть что нить еще кидайте сюда плз ....Принимается любая помощь . Заранее спсибо