IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Телефонный справочник, Помогите найти ошибку :)
annna
сообщение 4.10.2004 9:56
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 19

Репутация: -  0  +


Была написана програмка, простейший тел.справочник(поиск владельца по номеру и наоборот).Она правильная:
Код

program lab12_1;
uses crt;
type
sprav=record
name:string;
num:integer;
end;
var
y:array [1..5] of sprav;
z,x,i:integer;
n:string;
procedure nam;
begin
writeln('enter the name');
readln(n);
for i:=1 to 6 do begin
if i=6 then begin
writeln('Error!');
readln;
break;
end;
 if n=y[i].name then begin    {n-name}
 writeln(y[i].num);
 break;
 end else continue;
 end;end;
procedure nom;
begin
writeln('enter the number');
readln(x);
for i:=1 to 6 do begin
if i=6 then begin
writeln('Error!');
readln;
break;
end;
 if x=y[i].num then begin            {x-number}
 writeln(y[i].name);
 break;
 end else continue;
 end;end;
begin
clrscr;
with y[1] do begin
name:='man1';
num:=1;
end;
with y[2] do begin
name:='man2';
num:=2;
end;
with y[3] do begin
name:='man3';
num:=3;
end;
writeln('Enter the way of the search:');
writeln('1.by the name');
writeln('2.by the number');
readln(z);
if z=1 then nam;
if z=2 then nom;
readln;
end.

Теперь надо её передалать, используя в качестве баз данных,два текстовых файла(имена и телефоны).Но что-то не получается sad.gif
Код

program lab12_2;
uses crt;
type
sprav=record
name:string;
num:integer;
end;
var
y:array [1..5] of integer;
z,x,i:integer;
n,l:string;
a,b:text;
procedure nam;
begin
assign(a,'c:\dos\files\spr.dat');  {file name}
writeln('enter the name');
reset(a);
for i:=1 to 6 do begin
if i=6 then begin
close(a);
writeln('Error!');
readln;
break;
end;
 if n=l[i] then begin
 close(a);
 writeln(y[i]);
 break;
 end else continue;
 end;end;
procedure nom;
begin
writeln('enter the number');
readln(x);
for i:=1 to 6 do begin
if i=6 then begin
close(a);
writeln('Error!');
readln;
break;
end;
 if x=y[i] then begin
 close(a);
 writeln(y[i]);
 break;
 end else continue;
 end;end;
begin
clrscr;
assign(a,'c:\dos\files\f.dat');         {file number}
reset(a);
for i:=1 to 5 do begin
readln(a,l[i]);
readln(a,y[i]);
end;
writeln('Enter the way of the search:');
writeln('1.by the name');
writeln('2.by the number');
readln(z);
if z=1 then nam;
if z=2 then nom;
readln;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Altair
сообщение 5.10.2004 13:24
Сообщение #2


Ищущий истину
******

Группа: Модераторы
Сообщений: 4 824
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


ВОТ:

Код

Program DataBase;
uses crt;
Const
MaxRec=10;
Type
REC=record
     Name:string;
     Number:string[8];
    end;
aRec=array[1..MaxRec] of rec;

Procedure ReadBD(var DBB:aREC);
Var
I:byte;
S:string;
f:text;
Begin
write('Enter path: (введите путь к файлу):'); readln(s);
assign(f,s);
reset(f);
for i:=1 to MaxRec do
begin
 with DBB[I] do
 begin
  readln(f,name);
  readln(f,number)
 end
end;
close(f)
end;

Procedure SaveBD(DBB:aRec);
var
I:byte;
f:text;
s:string;
begin
write('Enter path: (введите путь к файлу):'); readln(s);
assign(f,s);
rewrite(f);
for i:=1 to MaxRec do
begin
 with DBB[I] do
 begin
  writeln(f,name);
  writeln(f,number)
 end
end;
close(f);
writeln('Сохраненно! нажмите любую клавишу ...');
readkey
end;

Procedure EnterBD(var DBB:aRec);
var
i:byte;
begin
for i:=1 to MaxRec do
begin
 with DBB[i] do
 begin
  write('Enter name:');
  readln(name);
  write('Enter numbel:');
  readln(number)
 end
end
end;

Procedure PrintBD(DBB:aRec);
var i:byte;
begin
for i:=1 to MaxRec do
begin
 writeln(i,'. NAME= ',DBB[I].NAME);
 writeln('Number = ',DBB[I].NUMBER);
end;
writeln('нажмите любую клавишу ...');
readkey
end;

Procedure NAM(DBB:Arec);
var i:byte;
s:string;
begin
writeln('введите имя для поиска');
readln(s);
for i:=1 to MaxRec do if DBB[i].name=s then writeln(DBB[i].number);
writeln(' нажмите любую клавишу ...');
readkey
end;

Procedure NUM(DBB:Arec);
var i:byte;
s:string[8];
begin
writeln('введите номер для поиска');
readln(s);
for i:=1 to MaxRec do if DBB[i].number=s then writeln(DBB[i].name);
writeln('нажмите любую клавишу ...');
readkey
end;


var
c:byte;
a:ARec;
Begin
repeat
 Clrscr;
 writeln('Что сделать?'); writeln;
 writeln('1. Ввод базы вручную');
 writeln('2. ввод базы из файла');
 writeln('3. сохранение базы в файле');
 writeln('4. Вывод базы на экран');
 writeln('5. поиск по имени');
 writeln('6. Поиск по номеру'); writeln;
 writeln( 'ВЫХОД - нажмите Esc!');
 c:=ORD(readkey);
 case c of
  49: EnterBD(A);
  50: ReadBD(a);
  51: SaveBD(a);
  52: PrintBD(A);
  53: NAM(A);
  54: NUM(A);
 end;
 Until c=27;
end.

Заначит так ... вот я тут кое-что наклепал ...

Procedure ReadBD(var DBB:aREC);
Эта процедура загружает базу из файла. Структура файла:
Код

name1
number1
name2
number2
...
nameMAXREC
numberMAXREC


Procedure SaveBD(DBB:aRec);
Сохранение в файл. Получается файл вышеуказанной схемы
Procedure EnterBD(var DBB:aRec);
ввод бызы вручную.Программа предлагает ввести имя, пользователь вводит имя,
программа предлагает ввести номер пользователь вводит номер и так делее.

Procedure PrintBD(DBB:aRec);
Вывод на экран базы.
Procedure NAM(DBB:Arec);
Поиск по имени, телефона
Procedure NUM(DBB:Arec);
Поиск по номеру имени.
Так ... что-от еще хотел ... а да, могу вообще для ВАС, такую базу сделать!
smile.gif
С динамическими структурами, анимационным меню, под win32!!
;)

Сообщение отредактировано: Oleg_Z - 5.10.2004 15:06


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 24.06.2025 20:43
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"