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

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

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

> Телефонный справочник, Помогите найти ошибку :)
сообщение
Сообщение #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 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


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

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

Репутация: -  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 -


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

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


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

 





- Текстовая версия 2.06.2024 11:16
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name