• Добро пожаловать на компьютерный форум Tehnari.ru. Здесь разбираемся с проблемами ПК и ноутбуков: Windows, драйверы, «железо», сборка и апгрейд, софт и безопасность. Форум работает много лет, сейчас он переехал на новый движок, но старые темы и аккаунты мы постарались сохранить максимально аккуратно.

    Форум не связан с магазинами и сервисами – мы ничего не продаём и не даём «рекламу под видом совета». Отвечают обычные участники и модераторы, которые следят за порядком и качеством подсказок.

    Если вы у нас впервые, загляните на страницу о форуме и правила – там коротко описано, как задать вопрос так, чтобы быстро получить ответ. Чтобы создавать темы и писать сообщения, сначала зарегистрируйтесь, а затем войдите под своим логином.

    Не знаете, с чего начать? Создайте тему с описанием проблемы – подскажем и при необходимости перенесём её в подходящий раздел.
    Задать вопрос Новые сообщения Как правильно спросить
    Если пришли по старой ссылке со старого Tehnari.ru – вы на нужном месте, просто продолжайте обсуждение.

Паскаль. Задача о расписании поездов

virginia

Новые
Регистрация
29 Окт 2011
Сообщения
42
Реакции
0
Баллы
0
Паскаль. Задача о расписании поездов

{Создать массив(расписание движения),хранящий информацию о 20 поездах,отправляющихся со станции Воронеж.
Каждый элемент расписания содержит информацию:номер поезда,пункт назначения,время отправления,количество свободных мест
в вагонах типа св,купе,плацкарт.а)упорядочить массив по пункту назначения.Вывести информацию о поездах,отходящих в заданный период
времени и следующих до заданного пункта назначения в типизированный файл}.помогите сделать вывод в типизированный файл
Код:
program Project2;

{$APPTYPE CONSOLE}
uses
  SysUtils,
  Windows;
const
    n=20;
type
     traininfo=record
     numbertrain:integer;
     destination:string;
     timeofdeparture_h:integer;
     timeofdeparture_m:integer;
     sv:Integer;
     compartment:integer;
     plackart:integer;
     end;
tmas=array [1..n] of traininfo;
var
  train:tmas;
  i,t_h,t_m:Integer;
  time1,time2:real;
  destination,s:string;
  f,f1:Text;
//-----------------------------------------------------------------
procedure vvoddannuh;
var
 i,numbertrain,timeofdeparture_h,timeofdeparture_m,
 sv,compartment,plackart:Integer;
 destination:String;
 f:Text;
begin
  Assign(f,'train_1.txt');
  Rewrite(f);
  writeln (f,'------------------------------------------------------------');
  writeln (f,'номер / пункт назначения / время отпр. / св / купе / плацк. ');
  writeln (f,'------------------------------------------------------------');
  for i:=1 to n do
  begin
    Write('введи номер поезда: ');
    Readln(numbertrain);
    Write('введи пункт назначения: ');
    Readln(destination);
    Write('введи время отправления (чч мм): ');
    Readln(timeofdeparture_h,timeofdeparture_m);
    Write('введи количество свободных мест в св: ');
    Readln(sv);
    Write('введи количество свободных мест в купе: ');
    Readln(compartment);
    Write('введи количество свободных мест в плацкарте: ');
    Readln(plackart);
    writeln(f,numbertrain:5,destination:19,timeofdeparture_h:8,timeofdeparture_m:3,sv:8,compartment:7,plackart:8);
    writeln
  end;
 Close(f)
end;
//-----------------------------------------------------------------
Procedure vuvoddannuh(a:tmas);
var
 i:Integer;
 f:Text;
begin
   Assign(f,'train_2.txt');
   Rewrite(f);
   writeln (f,'------------------------------------------------------------');
   writeln (f,'номер / пункт назначения / время отпр. / св / купе / плацк. ');
   writeln (f,'------------------------------------------------------------');
   for i:=1 to n do
   writeln(f,a[i].numbertrain:5,a[i].destination:19,a[i].timeofdeparture_h:8,a[i].timeofdeparture_m:3,a[i].sv:8,a[i].compartment:7,a[i].plackart:8);
   Close(f)
end;
//------------------------------------------------------------------------------------------
Procedure Read_data(Var a: tmas);
Var
 i,j:Integer;
 f:Text;
 C:Char;
 begin
   Assign(f,'train_1.txt');
   Reset(f);
   readln(f);
   readln(f);
   readln(f);
   for i:=1 to n do
     begin
       read(f,a[i].numbertrain);
       repeat
        read(f,C);
       until C<>' ';
       a[i].destination:=C;
       repeat
         read(f,C);
         if C<>' ' then  a[i].destination:=a[i].destination+C;
       until C=' ';
       readln(f,a[i].timeofdeparture_h,a[i].timeofdeparture_m,a[i].sv,a[i].compartment,a[i].plackart);
     end;
   Close(f)
 end;
//------------------------------------------------------------------------------------------
Procedure Swap(Var k, l: traininfo);
Var m:traininfo;
 begin
   m := k;
   k := l;
   l := m;
 end;
// --------------------------------------------------------------------------
Procedure sortirovka;
var
 x:traininfo;
 i,j:Integer;
begin
 for i:=1 to n-1 do
  for j:=1 to n-i do
   if train[j].destination>train[j+1].destination then
  Swap(train[j],train[j+1]);
end;
//--------------------------------------------------------------------------------
Procedure search_train(a:tmas;destination:string;tm1,tm2:real);
var
 i,S:Integer;
 f:Text;
begin
   Assign(f,'train_2.txt');
   Append(f);
   Writeln(f);
   S:=0;
   for i:=1 to n do
   if (a[i].destination=destination) and
    (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100>=tm1) and
    (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100<=tm2) then
      begin
        Writeln(f,'номер поезда: ',a[i].numbertrain);
        Writeln(f,'пункт назначения: ',a[i].destination);
        Writeln(f,'время отправления: ',a[i].timeofdeparture_h,'-',a[i].timeofdeparture_m);
        Writeln(f,'количество мест в св: ',a[i].sv) ;
        Writeln(f,'количество мест в купе: ',a[i].compartment);
        Writeln(f,'количество мест в плацкарте: ',a[i].plackart);
        Writeln(f);
        S:=S+1
      end;
   if S=0 then writeln(f,'таких поездов нет');
   Close(f);
end;

begin
  SetConsoleOutputCP(1251);
  if FileExists('train_1.txt')then
  begin
  read_data(train);
  assign(f,'train_1.txt');
  reset(f);
   while not eof(f) do
   begin
   readln(f,s);
   writeln(s);
   end;
  close(f);
  sortirovka;
  vuvoddannuh(train);
  Writeln('введи пункт назначения:');
  Readln(destination);
  writeln('введи период времени(формат ввода чч мм) с');
  readln(t_h,t_m);
  time1:=t_h+t_m/100;
  writeln('по');
  Readln(t_h,t_m);
  time2:=t_h+t_m/100;
  search_train(train,destination,time1,time2);
  assign(f1,'train_2.txt');
  reset(f1);
   while not eof(f1) do
   begin
   readln(f1,s);
   writeln(s)
   end;
  close(f1)
  end
  else vvoddannuh;

 Writeln('Для выхода нажмите enter');
 readln
end.
 
Вывести информацию о поездах,отходящих в заданный период времени и следующих до заданного пункта назначения в типизированный файл.
То есть вместо текстового следует использовать файл записей? А первый (train_1) - тоже? Ладно, допустим, что так. Сделаю завтра утром.
 
Ну вот, как-то так. Вроде довёл до ума с типизированными файлами. Добавил немного украшений типа запроса о переписывании исходного файла, буде он существует, ну и еще по мелочи. Что касается функции FileExists, то в моём Паскале таковой среди стандартных не имеется, а потому я изготовил самодельную. Если не нужна, смахните ее.
Код:
program Project2a;
                  
{$APPTYPE CONSOLE}
uses
  SysUtils,
  Windows;   
const
    n=20;
type
 traininfo=record
            numbertrain:integer;
            destination:string[30];
            timeofdeparture_h:integer;
            timeofdeparture_m:integer;
            sv:Integer;
            compartment:integer;
            plackart:integer;
           end;
 tmas=array [1..n] of traininfo;
 f_tr=file of traininfo;
var
  train:tmas;
  i,t_h,t_m,M,fd:Integer;
  time1,time2:real;
  destination,s:string;
  fx:f_tr;
//-----------------------------------------------------------------
function FileExists(Name:String):Boolean;
Var
 ffe:f_tr;
 IOres:Integer;
begin
 {$I-}
 Assign(ffe,Name);
 Reset(ffe);
 IOres:=IOResult;
 If IOres=0 then Close(ffe);
 FileExists:=IOres=0;
 {$I+}
end;
//-----------------------------------------------------------------
procedure vvoddannuh;
var
 i:Integer;
 destination:String;
 f:f_tr;
begin
  Assign(f,'train_1');
  Rewrite(f);
  for i:=1 to n do
   begin
    Write('Введите номер поезда: ');
    Readln(train[i].numbertrain);
    Write('Введите пункт назначения: ');
    Readln(train[i].destination);
    Write('Введите время отправления (чч мм): ');
    Readln(train[i].timeofdeparture_h,train[i].timeofdeparture_m);
    Write('Введите количество свободных мест в СВ: ');
    Readln(train[i].sv);
    Write('Введите количество свободных мест в купе: ');
    Readln(train[i].compartment);
    Write('Введите количество свободных мест в плацкарте: ');
    Readln(train[i].plackart);
    write(f,train[i]);
   end;
  Close(f)
end;
//-----------------------------------------------------------------
Procedure Show_data(a:tmas;Nshd:Integer);
var
 i:Integer;
begin
 If Nshd=0 then
  writeln('Таких поездов нет!')
 else
  begin
   writeln ('------------------------------------------------------------');
   writeln ('номер / пункт назначения / время отпр. / св / купе / плацк. ');
   writeln ('------------------------------------------------------------');
   for i:=1 to Nshd do
    writeln(a[i].numbertrain:5,a[i].destination:19,a[i].timeofdeparture_h:8,a[i].timeofdeparture_m:3,a[i].sv:8,a[i].compartment:7,a[i].plackart:8);
  end
end;
//-----------------------------------------------------------------
Procedure vuvoddannuh(F_Name:String;a:tmas;Nvuv:Integer);
var
 i:Integer;
 f:f_tr;
begin
 Assign(f,F_Name);
 Rewrite(f);
 for i:=1 to Nvuv do
  write(f,a[i]);
 Close(f)
end;
//------------------------------------------------------------------------------------------
Procedure Read_data(F_Name:String; Nrd:Integer; Var a: tmas);
Var
 i:Integer;
 f:f_tr;
 begin
   Assign(f,F_Name);
   Reset(f);
   for i:=1 to Nrd do
    read(f,a[i]);
   Close(f)
 end;
//------------------------------------------------------------------------------------------
Procedure Swap(Var k, l: traininfo);
Var m:traininfo;
 begin
   m:=k;
   k:=l;
   l:=m;
 end;
// --------------------------------------------------------------------------
Procedure sortirovka(a1:tmas;var a2:tmas);
var
 b:tmas;
 x:traininfo;
 i,j:Integer;
begin
 b:=a1;
 for i:=1 to n-1 do
  for j:=1 to n-i do
   if b[j].destination>b[j+1].destination then
  Swap(b[j],b[j+1]);
 a2:=b;
end;
//--------------------------------------------------------------------------------
Procedure search_train(a:tmas;destination:string;tm1,tm2:real;var Nst:Integer);
var
 i,S:Integer;
 f:f_tr;
begin
 S:=0;
 Assign(f,'train_3');
 Rewrite(f);
 for i:=1 to n do
  if (a[i].destination=destination) and
     (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100>=tm1) and
     (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100<=tm2) then
   begin
    Inc(S);
    Write(f,a[i]);
   end;
 Close(f);
 Nst:=S;
end;

begin                      
 SetConsoleOutputCP(1251);    
 if FileExists('train_1') then
  begin
   Writeln('Файл данных существует. Что с ним делать?');
   Writeln('   1 - удалить и ввести данные заново');
   Writeln('   2 - работать с существующими данными');
   Readln(fd);
   if fd=2 then
    begin
     Read_Data('train_1',n,train);
     Writeln('Исходное расписание:');
     Show_Data(train,n);
     Writeln('Нажмите "Enter" для продолжения...');
     Readln;
     sortirovka(train,train);
     vuvoddannuh('train_2',train,n);
     Read_Data('train_2',n,train);
     Writeln('Упорядоченное расписание:');
     Show_Data(train,n);
     Writeln('Нажмите "Enter" для продолжения...');
     Readln;
     Writeln('Введите пункт назначения:');
     Readln(destination);
     writeln('Введите период времени (формат ввода чч мм):');
     write('с  ');
     readln(t_h,t_m);
     time1:=t_h+t_m/100;
     write('по ');
     Readln(t_h,t_m);
     time2:=t_h+t_m/100;
     search_train(train,destination,time1,time2,M);
     Read_Data('train_3',M,train);
     Show_Data(train,M);
   end
   else
    begin
     Assign(fx,'train_1');
     Erase(fx);
     vvoddannuh;
    end;
  end
  else vvoddannuh;
 Writeln('Для выхода нажмите "Enter"');
 readln
end.
 
задача не запускается
 
задача не запускается
Ну вот те здрасьте!
Несколько часов отлаживал, гонял в хвост и в гриву и пожалуйста!
На всякий случай, перечень отличий. Поскольку у меня DOS Free Pascal, то:
1. Были закомментарены указание транслятору {$APPTYPE CONSOLE} и радел Uses - у меня таких модулей нет, да и не нужны.
2. В начале тела программы была закомментарена строка
SetConsoleOutputCP(1251);
По той же причине.
3. В путях к файлам был прописан диск D, т.е, например, не
Assign(f,'train_2');
а
Assign(f,'D:\train_2');
Вроде и всё.

А подробнее можно? На что именно ругается, что сообщает и т.п.
 
type traininfo needs finalization-not allowed in file type
 
type traininfo needs finalization-not allowed in file type
А, ну это уже задвиги транслятора. Если он такой убогий, что не переваривает файлов записей, то даже и не знаю, чем помочь. Сейчас пошарю по Сети, посмотрю, может кто что подскажет, как быть в такой ситуации.
 
Ага - ну понял! Вернее, вычитал.
Всё дело во втором поле записи - destination. Этот Ваш Object-Pascal, как и Delphi, не переносит в записи строк необъявленной длины. Поставьте вместо
destination:string;
что-нибудь типа
destination:string[30];
и всё пойдет.
Мой-то Паскаль жрёт и не давится.
 
Некоторые делфи не давятся от строк не объявленной длины, но проще конечно поставить в строке 200 символов, и все.
 
Что-то мне подсказывает, что у ТС какая-нибудь версия не к добру упомянутого ПаскальАБС
 
Procedure search_train(a:tmas;destination:string;tm1,tm2:real);
var
i,S:Integer;
f:Text;
begin
Assign(f,'train_2.txt');
Append(f);
Writeln(f);
S:=0;
for i:=1 to n do
if (a.destination=destination) and
(a.timeofdeparture_h+a.timeofdeparture_m/100>=tm1) and
(a.timeofdeparture_h+a.timeofdeparture_m/100<=tm2) then
begin
Writeln(f,'номер поезда: ',a.numbertrain);
Writeln(f,'пункт назначения: ',a.destination);
Writeln(f,'время отправления: ',a.timeofdeparture_h,'-',a.timeofdeparture_m);
Writeln(f,'количество мест в св: ',a.sv) ;
Writeln(f,'количество мест в купе: ',a.compartment);
Writeln(f,'количество мест в плацкарте: ',a.plackart);
Writeln(f);
S:=S+1
end;
if S=0 then writeln(f,'таких поездов нет');
Close(f);
end;

а как эту процедуру для типизированного файла сделать?
 
а как вывести содержимое файла f3 на экран?
 
а как вывести содержимое файла f3 на экран?
Там всё выводится. В частности, это - посредством команд
Код:
     Read_Data('train_3',M,train);
     Show_Data(train,M);
в теле программы.
Оттранслируйте программу, запустите - и всё увидите. Перед этим советую уменьшить количество поездов, изменив значение константы n, поставив, например, n=3. Иначе уж очень долго и скучно.
 
а если задача должна остаться как исходник,как поместить в типизированный файл f3,то что находится в f2?
 
program Project2;

{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;
const
n=20;
type
traininfo=record
numbertrain:integer;
destination:string[10];
timeofdeparture_h:integer;
timeofdeparture_m:integer;
sv:Integer;
compartment:integer;
plackart:integer;
end;
tmas=array [1..n] of traininfo;
var
train:tmas;
i,t_h,t_m:Integer;
time1,time2:real;
destination,s:string;
f,f1:Text;
f3:file of traininfo ;
//-----------------------------------------------------------------
procedure vvoddannuh; //заполнение файла данными
var
i,numbertrain,timeofdeparture_h,timeofdeparture_m,
sv,compartment,plackart:Integer;
destination:String;
f:Text;
begin
Assign(f,'train_1.txt');
Rewrite(f);
writeln (f,'------------------------------------------------------------');
writeln (f,'номер / пункт назначения / время отпр. / св / купе / плацк. ');
writeln (f,'------------------------------------------------------------');
for i:=1 to n do
begin
Write('введи номер поезда: ');
Readln(numbertrain);
Write('введи пункт назначения: ');
Readln(destination);
Write('введи время отправления (чч мм): ');
Readln(timeofdeparture_h,timeofdeparture_m);
Write('введи количество свободных мест в св: ');
Readln(sv);
Write('введи количество свободных мест в купе: ');
Readln(compartment);
Write('введи количество свободных мест в плацкарте: ');
Readln(plackart);
writeln(f,numbertrain:5,destination:19,timeofdeparture_h:8,timeofdeparture_m:3,sv:8,compartment:7,plackart:8);
writeln
end;
Close(f)
end;
//-----------------------------------------------------------------
Procedure vuvoddannuh(a:tmas); //вывод данных в файл
var
i:Integer;
f:Text;
begin
Assign(f,'train_2.txt');
Rewrite(f);
writeln (f,'------------------------------------------------------------');
writeln (f,'номер / пункт назначения / время отпр. / св / купе / плацк. ');
writeln (f,'------------------------------------------------------------');
for i:=1 to n do
writeln(f,a.numbertrain:5,a.destination:19,a.timeofdeparture_h:8,a.timeofdeparture_m:3,a.sv:8,a.compartment:7,a.plackart:8);
Close(f)
end;
//------------------------------------------------------------------------------------------
Procedure Read_data(Var a: tmas); //считывание информации
Var
i,j:Integer;
f:Text;
C:Char;
begin
Assign(f,'train_1.txt');
Reset(f);
readln(f);
readln(f);
readln(f);
for i:=1 to n do
begin
read(f,a.numbertrain);
repeat
read(f,C);
until C<>' ';
a.destination:=C;
repeat
read(f,C);
if C<>' ' then a.destination:=a.destination+C;
until C=' ';
readln(f,a.timeofdeparture_h,a.timeofdeparture_m,a.sv,a.compartment,a.plackart);
end;
Close(f)
end;
//------------------------------------------------------------------------------------------
Procedure Swap(Var k, l: traininfo); //метод пузырька
Var m:traininfo;
begin
m := k;
k := l;
l := m;
end;
// --------------------------------------------------------------------------
Procedure sortirovka; //процедура сортировки
var
x:traininfo;
i,j:Integer;
begin
for i:=1 to n-1 do
for j:=1 to n-i do
if train[j].destination>train[j+1].destination then
Swap(train[j],train[j+1]);
end;
//--------------------------------------------------------------------------------
Procedure search_train(a:tmas;destination:string;tm1,tm2:real); //поиск по заданным параметрам
var
i,S:Integer;
f:Text;
begin
Assign(f,'train_2.txt');
Append(f);
Writeln(f);
S:=0;
for i:=1 to n do
if (a.destination=destination) and
(a.timeofdeparture_h+a.timeofdeparture_m/100>=tm1) and
(a.timeofdeparture_h+a.timeofdeparture_m/100<=tm2) then
begin
Writeln(f,'номер поезда: ',a.numbertrain);
Writeln(f,'пункт назначения: ',a.destination);
Writeln(f,'время отправления: ',a.timeofdeparture_h,'-',a.timeofdeparture_m);
Writeln(f,'количество мест в св: ',a.sv) ;
Writeln(f,'количество мест в купе: ',a.compartment);
Writeln(f,'количество мест в плацкарте: ',a.plackart);
Writeln(f);
S:=S+1
end;
if S=0 then writeln(f,'таких поездов нет');
Close(f);
end;
procedure vvoddannuhtype;
var
s:string;
z:traininfo;
k:integer;
begin
Assign(f1,'train_2.txt');
Reset(f1);
Assign(f3,'train_3');
Rewrite(f3);
for i:=1 to 3 do readln(f1,s);
while not eof(f1) do
begin
readln(f1,s);
while pos(' ',s)>0 do
delete(s,pos(' ',s),1);
if s[length(s)]=' ' then delete(s,length(s),1);
val(copy(s,1,pos(' ',s)-1),z.numbertrain,k);
delete(s,1,pos(' ',s));
z.destination:=copy(s,1,pos(' ',s)-1);
delete(s,1,pos(' ',s));
val(copy(s,1,pos(' ',s)-1),z.timeofdeparture_h,k);
delete(s,1,pos(' ',s));
val(copy(s,1,pos(' ',s)-1),z.timeofdeparture_m,k);
delete(s,1,pos(' ',s));
val(copy(s,1,pos(' ',s)-1),z.sv,k);
delete(s,1,pos(' ',s));
val(copy(s,1,pos(' ',s)-1),z.compartment,k);
delete(s,1,pos(' ',s));
val(s,z.plackart,k);
write(f3,z);
end;
Close(f1);
close(f3);
end;

Procedure vuvoddannuhtype;
var z:traininfo;
begin
reset(f3);
writeln ('------------------------------------------------------------');
writeln ('номер/ пункт назначения / время отпр. / св /купе / плац. ');
writeln ('------------------------------------------------------------');
while not eof(f3) do
begin
read(f3,z);
writeln(z.numbertrain:5,z.destination:19,z.timeofdeparture_h:8,z.timeofdeparture_m:3,z.sv:8,z.compartment:7,z.plackart:8);
end;
close(f3);
end;
begin
SetConsoleOutputCP(1251);
if FileExists('train_1.txt')then
begin
read_data(train);
assign(f,'train_1.txt');
reset(f);
while not eof(f) do
begin
readln(f,s);
writeln(s);
end;
close(f);
sortirovka;
vuvoddannuh(train);
Writeln('введи пункт назначения:');
Readln(destination);
writeln('введи период времени(формат ввода чч мм) с');
readln(t_h,t_m);
time1:=t_h+t_m/100;
writeln('по');
Readln(t_h,t_m);
time2:=t_h+t_m/100;
search_train(train,destination,time1,time2);
assign(f1,'train_2.txt');
reset(f1);
while not eof(f1) do
begin
readln(f1,s);
writeln(s)
end;
close(f1);
vvoddannuhtype;
vuvoddannuhtype
end
else vvoddannuh;

Writeln('Для выхода нажмите enter');
readln
end.

вот добавила эти процедуры.только запускается с ошибкой.помогите найти
 
вот добавила эти процедуры.только запускается с ошибкой.помогите найти
Ох, даже и не знаю... Чувствую, что, похоже, придется посвятить остаток жизни разработке вариантов этой программы...
Прежде всего, в листинге куча ошибочных пробелов, типа
Их все надо убрать.
Потом - объясните толком, что требуется? Есть два варианта: с текстовыми файлами и файлами записей. Обязательно создавать гибрид?
 
да(((((((((((.нужно чтобы f и f1 были текстовыми,а f3 типизированным ,но стаким же содержанием как и у f1
 
Ну вроде как добил. Получите. Основная ошибка в том, что Вы кое о чем забыли, а именно о том, что после поиска в текстовый файл добавляются строки, содержащие информацию об отобранных поездах, и на них-то процедура преобразования и спотыкается. Кстати, и сама эта процедура у Вас излишне усложнена: совершенно нет никакой необходимости вычленять числовые форматы из строкового: достаточно лишь правильно организовать считывание пункта назначения, а остальные данные так и читать, как числа.
Функцию FileExists (она закомментарена) можете удалить. Просто у меня такой среди стандартных нету, вот и пришлось добавить самодельную.

Код:
program Project2a;
                  
{$APPTYPE CONSOLE}
uses
  SysUtils,
  Windows;   
const
 n=20;
type
 traininfo=record
            numbertrain:integer;
            destination:string[15];
            timeofdeparture_h:integer;
            timeofdeparture_m:integer;
            sv:Integer;
            compartment:integer;
            plackart:integer;
           end;
 tmas=array [1..n] of traininfo;
var
 train:tmas;
 i,t_h,t_m:Integer;
 time1,time2:real;
 destination,s:string;
 f,f1:Text;
 f3:file of traininfo ;
(*
//-----------------------------------------------------------------
function FileExists(Name:String):Boolean;
Var
 ffe:Text;
 IOres:Integer;
begin
 {$I-}
 Assign(ffe,Name);
 Reset(ffe);
 IOres:=IOResult;
 If IOres=0 then Close(ffe);
 FileExists:=IOres=0;
 {$I+}
end; *)
//-----------------------------------------------------------------
procedure vvoddannuh; //заполнение файла данными
var
 i,numbertrain,timeofdeparture_h,timeofdeparture_m,
 sv,compartment,plackart:Integer;
 destination:String;
 f:Text;
begin
 Assign(f,'train_1.txt');
 Rewrite(f);
 writeln (f,'------------------------------------------------------------');
 writeln (f,'номер / пункт назначения / время отпр. / св / купе / плацк. ');
 writeln (f,'------------------------------------------------------------');
 for i:=1 to n do
  begin
   Write('Введите номер поезда: ');
   Readln(numbertrain);
   Write('Введите пункт назначения: ');
   Readln(destination);
   Write('Введите время отправления (чч мм): ');
   Readln(timeofdeparture_h,timeofdeparture_m);
   Write('Введите количество свободных мест в СВ: ');
   Readln(sv);
   Write('Введите количество свободных мест в купе: ');
   Readln(compartment);
   Write('Введите количество свободных мест в плацкарте: ');
   Readln(plackart);
   writeln(f,numbertrain:5,destination:19,timeofdeparture_h:8,timeofdeparture_m:3,sv:8,compartment:7,plackart:8);
   writeln
  end;
 Close(f)
end;
//-----------------------------------------------------------------
Procedure vuvoddannuh(a:tmas); //вывод данных в файл
var
 i:Integer;
 f:Text;
begin
 Assign(f,'train_2.txt');
 Rewrite(f);
 writeln (f,'------------------------------------------------------------');
 writeln (f,'номер / пункт назначения / время отпр. / св / купе / плацк. ');
 writeln (f,'------------------------------------------------------------');
 for i:=1 to n do
  writeln(f,a[i].numbertrain:5,a[i].destination:19,a[i].timeofdeparture_h:8,a[i].timeofdeparture_m:3,a[i].sv:8,a[i].compartment:7,a[i].plackart:8);
 Close(f)
end;
//------------------------------------------------------------------------------------------
Procedure Read_data(Var a: tmas); //считывание информации
Var
 i,j:Integer;
 f:Text;
 C:Char;
begin
 Assign(f,'train_1.txt');
 Reset(f);
 readln(f);
 readln(f);
 readln(f);
 for i:=1 to n do
  begin
   read(f,a[i].numbertrain);
   repeat
    read(f,C);
   until C<>' ';
   a[i].destination:=C;
   repeat
    read(f,C);
    if C<>' ' then a[i].destination:=a[i].destination+C;
   until C=' ';
   readln(f,a[i].timeofdeparture_h,a[i].timeofdeparture_m,a[i].sv,a[i].compartment,a[i].plackart);
  end;
 Close(f)
end;
//------------------------------------------------------------------------------------------
Procedure Swap(Var k, l: traininfo); //метод пузырька
Var m:traininfo;
begin
 m:=k;
 k:=l;
 l:=m;
end;
// --------------------------------------------------------------------------
Procedure sortirovka; //процедура сортировки
var
 x:traininfo;
 i,j:Integer;
begin
 for i:=1 to n-1 do
  for j:=1 to n-i do
   if train[j].destination>train[j+1].destination then
    Swap(train[j],train[j+1]);
end;
//--------------------------------------------------------------------------------
Procedure search_train(a:tmas;destination:string;tm1,tm2:real); //поиск по заданным параметрам
var
 i,S:Integer;
 f:Text;
begin
 Assign(f,'train_2.txt');
 Append(f);
 Writeln(f);
 S:=0;
 for i:=1 to n do
 if (a[i].destination=destination) and
  (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100>=tm1) and
  (a[i].timeofdeparture_h+a[i].timeofdeparture_m/100<=tm2) then
  begin
   Writeln(f,'Номер поезда: ',a[i].numbertrain);
   Writeln(f,'Пункт назначения: ',a[i].destination);
   Writeln(f,'Время отправления: ',a[i].timeofdeparture_h,'-',a[i].timeofdeparture_m);
   Writeln(f,'Количество мест в св: ',a[i].sv) ;
   Writeln(f,'Количество мест в купе: ',a[i].compartment);
   Writeln(f,'Количество мест в плацкарте: ',a[i].plackart);
   Writeln(f);
   S:=S+1
  end;
 if S=0 then writeln(f,'Таких поездов нет');
 Close(f);
end;
//--------------------------------------------------------------------------------
procedure vvoddannuhtype;
var
 s:string;
 s19:string[19];
 z:traininfo;
 {k:integer;}
begin
 Assign(f1,'train_2.txt');
 Reset(f1);
 Assign(f3,'train_3');
 Rewrite(f3);
 for i:=1 to 3 do readln(f1);
 for i:=1 to n do
  begin
   read(f1,z.numbertrain);
   read(f1,s19);
   s:=s19;
   readln(f1,z.timeofdeparture_h,z.timeofdeparture_m,z.sv,z.compartment,z.plackart);
   while pos(' ',s)>0 do
    delete(s,pos(' ',s),1);
   z.destination:=s;
   write(f3,z);
  end;
 Close(f1);
 close(f3);
end;

Procedure vuvoddannuhtype;
var z:traininfo;
begin
 reset(f3);
 writeln ('------------------------------------------------------------');
 writeln ('номер/ пункт назначения / время отпр. / св /купе / плац. ');
 writeln ('------------------------------------------------------------');
 while not eof(f3) do
  begin
   read(f3,z);
   writeln(z.numbertrain:5,z.destination:19,z.timeofdeparture_h:8,z.timeofdeparture_m:3,z.sv:8,z.compartment:7,z.plackart:8);
  end;
 close(f3);
end;

begin
 SetConsoleOutputCP(1251);
 if FileExists('train_1.txt')then
  begin
   read_data(train);
   assign(f,'train_1.txt');
   reset(f);
   while not eof(f) do
    begin
     readln(f,s);
     writeln(s);
    end;
   close(f);
   sortirovka;
   writeln;
   vuvoddannuh(train);
   writeln;
   Writeln('Введите пункт назначения:');
   Readln(destination);
   write('Введите период времени (формат ввода чч мм) с ');
   readln(t_h,t_m);
   time1:=t_h+t_m/100;
   write('по ');
   Readln(t_h,t_m);
   time2:=t_h+t_m/100;
   search_train(train,destination,time1,time2);
   assign(f1,'train_2.txt');
   reset(f1);
   while not eof(f1) do
    begin
     readln(f1,s);
     writeln(s)
    end;
   close(f1);
   vvoddannuhtype;
   vuvoddannuhtype
  end
 else vvoddannuh;

 Writeln('Для выхода нажмите "Enter"');
 readln
end.
 
Назад
Сверху