Организовать записи о жильцах гостиницы

@amosik · Регистрация: 25.03.2010

Студворк — интернет-сервис помощи студентам

Здраствуйте. мне необходимо было создать программу по записям и файлам. всё получилось, но не выполняется обработка. помогите правильно написать процедуру обработки по заданию:
в гостинице имеется 15 номеров, из них 5 одноместных и 10 двухместных. Составить программу, которая заполняет и (или) корректирует данные о жильцах и по фамилии определяет номер, где проживает жилец. Программа запрашивает фамилию жильца. Если жильца с такой фамилией нет, об этом выдается сообщение. Если жилец с такой фамилией в гостинице единственный, программа выдает фамилию жильца и номер проживания. Если в гостинице проживает два или более жильцов с такой фамилией, программа дополнительно запрашивает инициалы.
вот часть, но это основное в программе:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
program zapisi;
uses wincrt, windos, mod_at;
Label M1;
Type gost=record
          Nomer: integer;     {номер}
          Famil: string[15];  {фамилия жильца}
          IO   : string[5];   {инициалы жильца}
          end;
var w:char;
      gg: file of gost;
{переменная для доступа к файлу}
       g : gost;
{переменная для доступа к записи}
I,b,p,s,a:integer;
k,g1,g2,l: string;
F:string[20];
ff: boolean; {логич.тип}
WaitTime: word;
{-------таблица----------}
procedure Tabl;
begin
writeln('         Список жителей:');
writeln;
writeln('---------------------------------');
writeln('| Номер |   Фамилия  | Инициалы |');
writeln('---------------------------------');
end;
{--------создание файла записи-----------}
Procedure Org;
Begin
writeln ('     Введите данные о жильцах гостиницы:');
writeln;
writeln ('  Чтобы закончить ввод, введите номер = 101');
writeln;
Begin
write('  Введите имя файла ');readln(F);
Assign (gg,F+'.doc');
Rewrite(gg);{ создаем новый файл }
{для удобного обращения к полям записи используем With }
While True do
begin
  With g do
 begin
  writeln;
  write('Введите номер     '); readln(Nomer);
if nomer = 101 then
 begin
Close(gg); Exit
end;
  write('Введите фамилию   ');readln(Famil);
  write('Введите инициалы  ');readln(IO);
  writeln;
  write(gg,g);
end; end; end;
end; {org}
{--------расширение файла записи---------}
Procedure Rash; { процедура расширения файла}
   Begin
writeln ('     Введите данные о жильцах гостиницы:');
writeln;
writeln ('  Чтобы закончить ввод, введите номер = 101');
writeln;
write('  Введите имя файла ');readln(F);
Assign (gg,F+'.doc');
Reset(gg); { откроем существующий файл – при этом указатель файла будет установлен у первой записи }
{ установим указатель в конец файла процедурой Seek}
Seek(gg,FileSize(gg));
While True do
begin
 With g do
 begin
 writeln;
  write('Введите номер     '); readln(Nomer);
if nomer = 101 then
begin
Close(gg); Exit
end;
  write('Введите фамилию   ');readln(Famil);
  write('Введите инициалы  ');readln(IO);
  writeln;
  write(gg,g);
end;
end;  end;
{----------печать-----------}
 Procedure pr(a,b:integer;Nomer:integer;Famil:string;IO:string);
 begin
writeln(' ',Nomer:3,Famil:15,'    ',IO:5);
 end;
{------ввод информации из файла----------}
Procedure Vvod_f;
Begin
{присвоим файловой переменной имя}
writeln; write('  Введите имя файла ');readln(F);
Assign (gg,F+'.doc');
Reset(gg); { откроем существующий файл – при этом
указатель файла будет установлен у первой записи }
{для удобного обращения к полям записи используем With }
Tabl;
With g do
While not Eof(gg)do{пока не конец файла}
begin
read(gg,g); {прочитали запись}
        {вывели её на экран, используя форматный вывод }
pr(5,6,Nomer,Famil,Io);
end; {while}
close(gg); {закрыли файл}
end;

{---------обрабока информации------------}
эта процедура вряд ли правильна!

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
procedure obr;
label m2,m3;
begin
writeln; write('  Введите имя файла ');readln(F);
writeln;
write('    Введите искомую фамилию   ');readln(k);
i:=1; b:=0; p:=0; s:=0;
Assign (gg,F+'.doc');
Reset(gg); 
Tabl;
While not Eof(gg)do{пока не конец файла}
begin
m3: read(gg,g);
with g do  {прочитали запись}
if k=famil then
        begin if b=0 then
                begin Famil:=k; IO:= g1; p:=i; i:=i+1; goto m3; end
           else begin Famil:=k; IO:= g2; s:=i;  end;
               m2: writeln('Введите инициалы   ');readln(l);
                 if l=g1 then p:=a
                          else begin if l=g2 then s:=a
                                              else goto m2; end; end
           else begin i:=i+1; goto m3; end;  close(gg);
writeln(k:15,l:5,a:5); }
end; end; 
end; end;{while}

.....
спасибо.

@Пётр Нефедов · 08.12.2010, 16:37

Здравствуйте, задали эту же программу, право она не работает - чуть доработал, но все равно ошибка: задание тоже:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
program zapisi;
 
Label M1;
Type gost=record
          Nomer: integer;     
          Famil: string[15]; 
          IO   : string[5];   
          end;
var w:char;
      gg: file of gost;
{ia?aiaiiay aey ainooia e oaeeo}
       g : gost;
{ia?aiaiiay aey ainooia e caiene}
I,b,p,s,a:integer;
k,g1,g2,l: string;
F:string[20];
ff: boolean; {eiae?.oei}
WaitTime: word;
{-------oaaeeoa----------}
 
procedure Tabl;
begin
writeln('         Nienie ?eoaeae:');
writeln;
writeln('---------------------------------');
writeln('| Iiia? |   Oaieeey  | Eieoeaeu |');
writeln('---------------------------------');
end;
{--------nicaaiea oaeea caiene-----------}
Procedure Org;
Begin
writeln ('     Aaaaeoa aaiiua i ?eeuoao ainoeieou:');
writeln;
writeln ('  ?oiau caeii?eou aaia, aaaaeoa iiia? = 101');
writeln;
Begin
write('  Aaaaeoa eiy oaeea ');readln(F);
Assign (gg,'C:\Primer.txt');
Rewrite(gg);
While True do
begin
  With g do
 begin
  writeln;
  write('Aaaaeoa iiia?     '); readln(Nomer);
if nomer = 101 then
 begin
Close(gg); Exit
end;
  write('Aaaaeoa oaieee?   ');readln(Famil);
  write('Aaaaeoa eieoeaeu  ');readln(IO);
  writeln;
  write(gg,g);
end; end; end;
end; {org}
Procedure Rash; { i?ioaao?a ?anoe?aiey oaeea}
   Begin
writeln ('     Aaaaeoa aaiiua i ?eeuoao ainoeieou:');
writeln;
writeln ('  ?oiau caeii?eou aaia, aaaaeoa iiia? = 101');
writeln;
write('  Aaaaeoa eiy oaeea ');readln(F);
Assign (gg,'C:\Primer.txt');
Reset(gg); 
Seek(gg,FileSize(gg));
While True do
begin
 With g do
 begin
 writeln;
  write('Aaaaeoa iiia?     '); readln(Nomer);
if nomer = 101 then
begin
Close(gg); Exit
end;
begin
  write('Aaaaeoa oaieee?   ');readln(Famil);
  write('Aaaaeoa eieoeaeu  ');readln(IO);
  writeln;
  write(gg,g);
end;
end;  end;
 
 Procedure pr(a,b:integer;Nomer:integer;Famil:string;IO:string);
 begin
writeln(' ',Nomer:3,Famil:15,'    ',IO:5);
 end;
 
Procedure Vvod_f;
Begin
 
writeln; write('  Aaaaeoa eiy oaeea ');readln(F);
Assign (gg,'C:\Primer.txt');
Reset(gg); 
Tabl;
With g do
While not Eof(gg)do
begin
read(gg,g); 
pr(5,6,Nomer,Famil,Io);
end; {while}
close(gg); 
end;
end.

Правда с кириллицей проблемы, не могу доработать ее( Помогите, пожалуйста.

Новые блоги и статьи Все статьи Все блоги /
Символьное дифференцирование igorrr37 13.02.2026 / * Программа принимает математическое выражение в виде строки и выдаёт его производную в виде строки и вычисляет значение производной при заданном х Логарифм записывается как: (x-2)log(x^2+2) -. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»
SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image 8Observer8 10.02.2026 Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .	Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .