Создать файл с данными

[Илья1112]

Ребят привет, столкнулся с такой задачей. Помогите пожалуйста
Создать файл с данными: в гостинице 150 номеров , из них 50 одноместных и 100 двухместных.
Составить программу, которая заполняет или корректирует данные о жильцах и по фамилии определяет его номер, где он проживает.
Программа:
1) сортирует данные по номерам или по фамилиям жильцов
2) запрашивает фамилию жильца и
Если жильца с такой фамилии нет, об это выдается сообщение
Если жилец с такой фамилией в гостиниц единственный, программа выдает фамилию жильца и номер проживания.
Если в гостинице проживает два или более жильцов с такой фамилией, программа дополнительно запрашивает инициалы.
Помогите , если нетрудно с этой задачей, всем спасибо

[Serge_Bliznykov]

Помогите , если нетрудно с этой задачей, всем спасибо

"помогите" - это в смысле "сделайте всё за меня" ?!!!

Лучше воспользуйтесь поиском (ищите типизированный файл, записи и т.п.), найдите похожие задачи, разбирайте код и дорабатывайте под свои задачи.
А делать вашу домашнюю/курсовую за Вас за спасибо никто не будет!

Если начнёте что-то делать и появятся вопросы - приходите, задавайте, будем разбираться!

[Илья1112]

Есть черновик, которую сделал сам

[Илья1112]

type BazSam = record
    ImTip, FamKonstr: string;
    Year, KolKres, Gruz: integer;
  end;

procedure ramki(x1, y1, x2, y2, cf, ct: byte; zag: string);
begin
  writeln(zag);
end;

procedure menu(x1, y1, x2, y2, cf, ct: byte; zag: string; var v: Byte);
begin
  ramki(x1, y1, x2, y2, cf, ct, zag);
  writeln('Sozdat bazu dannix - 1');
  writeln('Posmotret bazu dannix - 2');
  writeln('Sdelat viborku v baze - 3');
  writeln('Naiti informaciu v baze - 4');
  writeln('vixod - 5');
  readln(v);
end;

procedure ProvName(var name: string; var fe: boolean);
var f1: text;
begin
  Writeln('Vvedite imja bazi v formate name.txt');
  readln(name);
  assign(f1, name);
  reset(f1);
end;

procedure sozdbd(name: string);
var y1, x1, x2, y2, cf, ct: byte;
  f1: text;
  g: integer;
  s, zag: string;
begin
  Assign(f1, name);
  Rewrite(f1);
  g := 1;
  write(f1, 'tip': 5);
  write(f1, 'Famila konstruktora': 28);
  write(f1, 'god vipuska': 15);
  write(f1, 'koli4. Kresel': 17);
  writeln(f1, 'Gruzopodemnost': 19);
  while g <> 0 do begin
    Writeln('vvedite tip');
    readln(s);
    write(f1, s: 5);
    Writeln('vvedite Familiu konstruktora');
    readln(s);
    write(f1, s: 28);
    Writeln('vvedite God vipuska');
    readln(s);
    write(f1, s: 15);
    Writeln('vvedite koli4. Kresel');
    readln(s);
    write(f1, s: 17);
    Writeln('vvedite Gruzopodemnost');
    readln(s);
    writeln(f1, s: 19);
    writeln('Esho odin samoliot? 1-Yes 0-No');
    read(g); {
x1:=10; y1:=5; x2:=70; y2:=20;
ct:=0;
cf:=7;
zag:='';
ramki(x1,y1,x2,y2,cf,ct,zag);}
  end;
  close(f1);
end;


var
  fe: boolean;
  name, zag: string;
  y1, x1, x2, y2, cf, ct, v, r: byte;
begin
  x1 := 10; y1 := 5; x2 := 70; y2 := 20;
  ct := 0;
  cf := 7;
  zag := 'Zadanie';
  ramki(x1, y1, x2, y2, cf, ct, zag);
  Writeln('Razrabotat programmu obrabotki baz dannix samoliotov');
  Writeln('nazmite Enter dla prodolshenia');
  readln;
  while v <> 5 do
  begin
    x1 := 10; y1 := 5; x2 := 70; y2 := 20;
    ct := 0;
    cf := 7;
    zag := '';
    menu(x1, y1, x2, y2, cf, ct, zag, v);
    if v = 1 then
    begin
      x1 := 10; y1 := 5; x2 := 70; y2 := 20;
      ct := 0;
      cf := 7;
      ramki(x1, y1, x2, y2, cf, ct, zag);
      while r <> 1 do
      begin
        ProvName(name, fe);
        if fe = false then r := 1
        else begin
          writeln('takaia baza ushe est. Zamenit? 1-Yes 0-No');
          readln(r);
        end;
      end;
      x1 := 10; y1 := 5; x2 := 70; y2 := 20;
      ct := 0;
      cf := 7;
      ramki(x1, y1, x2, y2, cf, ct, zag);
      Sozdbd(name);
    end;
  end;
end.

___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE]
(кнопочка на панели форматирования с решёточкой #)
Не забывайте об этом!

Модератор.

[Serge_Bliznykov]

1) Какой у Вас компилятор Паскаля?
2) программка выглядит нормально. Что не получается конкретно?


p.s. я позволил себе отформатировать вашу программу...

p.s.s. Тю!! Так это же НЕ ВАША программа! Это программа по учёту самолётов!!
То, что Вы похожее нашли - это хорошо. Но теперь же надо всё переделывать под свою задачу!!

[Илья1112]

Pascal ABC
Конкретно не получается сделать меню и чтобы в этом меню присутствовала сортировка.
Меню есть, но нет сортировки

[Илья1112]

var
  mas1: array[0..4] of string;  //  Жильцы по одноместным номерам
  mas2: array[0..1, 0..9] of string;  //  Жильцы по двухместным номерам
  s: string;
  nom: byte;  //  Выбор меню
 
function Dos(mes:string): string;  //  Перекодировка OEM->ANSI, что бы не было кракозябров после ввода строки
begin
  SetLength(Result, Length(mes));  // Устанавливаем длину выходной строки равной входящей
  if Length(Result)> 0 then  //  Если длина больше 0 перекодируем строку OemToAnsi(PChar(mes), PChar(Result));
end;
 
 
procedure Zag;  // Процедура загрузки данных из файла
var
  f: Text;
  i, j:
integer;
    s0, s1: string;
begin
  if not
FileExists('Gostin.txt') then  //  Проверяем существование файла
 
  begin
       writeln('Файла Gostin.txt не существует');
    Exit;  //  Выход из процедуры
    end;
  Assign(f,'Gostin.txt');   //  Связали файловую переменную с файлом
 
Reset(f);  //  Встали на начало файла
  Readln(f, s0);  //  Считываем одну строку
  for i:= 0 to 4 do  //  Загружаем данные по одноместным номерам
    begin
      Readln(f, s0);  //  Считываем строку
 
delete(s0, 1, 2);  //  Удаляем первые два символа
      mas1[i]:= s0;  // Записали в массив
    end;
  Readln(f, s0);  //  Считали строку
 
 for i:= 0 to 9 do  //  Загружаем данные по двухместным номерам
 
begin
     Readln(f, s0);  //  Считали строку
      While s0[1] <> ' ' do  //  Делаем пока не дойдём до пробела
 
delete(s0, 1, 1);  //  Удаляем первый символ
    delete(s0, 1, 1);  // Удаляем первый символ
     s1:= '';
      for j:= 1 to
Length(s0) do
       if s0[j] <> ',' then
 
s1:= s1 + copy(s0, j, 1)  //  Копируем символы пока не дойдём до символа ,
      else
          break;  //  Досрочный выход из цикла
 
mas2[0, i]:= s1;  //  Записали в массив строку
      While s0[1] <> ',' do //  Удаляем первый символ пока не дойдём до символа ,
 
   delete(s0, 1, 1);
    delete(s0, 1, 1);  //  Удаляем первый символ
    mas2[1, i]:= s0;  //  Записали строку в массив
    end;
 
Close(f);  //  Закрыли файл
end;
 
 
procedure Find;  // Процедура поиска жильца
var
    s0, s1: string;
  i: integer;
  fnd: boolean;
begin
  fnd:= false;
    for i := 0 to 4 do  // Ищем по одноместным номерам
    if (Pos(s, mas1[i]) <> 0) AND ((mas1[i][length(s) + 1] = ' ') OR (length(mas1[i]) = length(s)) OR (mas1[i][length(s) + 1] = '.')) then
    {Нашли вхождение фамилии в массиве}
      begin
    if fnd then
       begin
          writeln('Таких жильцов несколько! Введите инициалы жильца');
        readln(s0);  // Запомнили введёные данные с клавиатуры
        s0:= dos(s0);  // Перекодировали строку
           s:= s + ' ' + s0;  //  Добавили к фамилии инициалы
        Find;  //  Запуск процедуры поиска с начала
        exit;  //  Выход из процедуры
         end;
 
       s1:= ('Жилец с фамилией ' + s + ' проживает в номере') + IntToStr(i + 1);
        fnd:= true;
      end;
  for
i:= 0 to 9 do  //  Ищем по двухместным номерам
    begin
     if
(Pos(s, mas2[0, i]) <> 0) AND ((mas2[0, i][length(s) + 1] = '')
                              OR
(length(mas2[0, i]) = length(s))
 
          OR (mas2[0, i][length(s) + 1] = '.')) then
 
{Нашли вхождение фамилии в массиве}
     begin
          if fnd
then
          begin
           writeln('Таких жильцов несколько! Введите инициалы жильца');
          readln(s0);  // Запомнили введёные данные с клавиатуры
          s0:= dos(s0);  // Перекодировали строку
         s:= s + ' ' + s0;  // Добавили к фамилии инициалы
           Find;  //  Запуск процедуры поиска с начала
           exit;  //  Выход из процедуры
 
  end;
          s1:= ('Жилец с фамилией ' + s + ' проживает в номере ') + IntToStr(i + 6);
        fnd:= true;
 
     end;
      if (Pos(s, mas2[1, i]) <> 0) AND ((mas2[1,i][length(s) + 1] = ' ')
 
        OR (length(mas2[1, i]) = length(s))
 
                 OR (mas2[1, i][length(s) + 1] = '.'))
then
    {Нашли вхождение фамилии в массиве}
     begin
 
      if fnd then
       begin
 
writeln('Таких жильцов несколько! Введите инициалы жильца');
 
         readln(s0);  //  Запомнили введёные данные с клавиатуры
 
    s0:= dos(s0);  //  Перекодировали строку
            s:= s + ' ' + s0;  //  Добавили к фамилии инициалы
          Find;  //  Запуск процедуры поиска с начала
         exit;  //  Выход из процедуры
       end;
           s1:= ('Жилец с фамилией ' + s + ' проживает в номере ') + IntToStr(i + 6);
 
fnd:= true;
     end;
    end;
  if not fnd then
 
writeln('Жильца с фамилией ' + s + ' нет') //  Вывод результата поиска
  else
    begin
    writeln(s1);  //  Вывод результата поиска
    end;
 
end;

___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE]
(кнопочка на панели форматирования с решёточкой #)
Не забывайте об этом!

Модератор.