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

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

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

 
 Ответить  Открыть новую тему 
> текстовый файл
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 61
Пол: Мужской

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


Помогите пожайлуста переделать из типизированого файла в текстовый. Задание : сделать анкету которая содержит поля фамилия, имя, степень родства(кто он брат, сестра, отец, мать и т.д), год рождения, город проживания, професия. Вывести всю информацию о родствениках возраст которых меньше среднего возраста. Все процедуры поместить в модуль. В теле основной программы осуществить вызов процедур из модуля Даные вводятся с клавиатуры и записываются в файл, потом этот файл используется. вот эта задача в типизированом файле. Заранее всем большое спасибо.
МОДУЛЬ
Код

unit ss;
interface
type
    peop=record
         fam:string[15];
         nam:string[15];
         rod:string[10];
         city:string[15];
         year:1900..2007;
         prof:string[15];
    end;

t=file of peop;


procedure create(var f1:t);
procedure obr(var f1:t);
procedure pech(var f1:t);

implementation

procedure create;
var
   n,i:byte;
   s:peop;
begin
reset(f1);
write('vvedite kol-vo= ');
readln(n);
for i:=1 to n do
  begin
   write('familiy= ');readln(s.fam);
   write('name= ');readln(s.nam);
   write('rod= ');readln(s.rod);
   write('city= ');readln(s.city);
   write('year= ');readln(s.year);
   write('Profession= ');readln(s.prof);
   write(f1,s);
  end;
close(f1);
end;


procedure pech;
var
  i,n:byte;
  s:peop;
begin
reset(f1);
for i:=1 to filesize(f1) do
  begin
   read(f1,s);
   with  s do
   write(fam,' ',nam,' ',rod,' ',city,' ',year,' ',prof,'  ');
   writeln;
  end;
end;


procedure obr;
var
   i:byte;
   s:peop;
   srv:integer;
begin
   reset(f1);
   srv:=0;
   for i:=1 to filesize(f1) do
       begin
          read(f1,s);
          srv:=srv+(2008-s.year);
       end;
   close(f1);
   srv:=srv div i;
   reset(f1);
   writeln('srednij vozrast = ',srv);
   writeln('rodstvenniki, vozrast kotorih menshe srednego:');
   writeln;
   for i:=1 to filesize(f1) do
         begin
           read(f1,s);
           if (2008-s.year)< srv then
               begin
                 with s do
                      begin
                         writeln(fam,' ',nam,' ',rod,' ',city,' ',year,' ',prof);
                         writeln('-------------------------------------------------');
                      end;
               end;
         end;
     close(f1);
end;

end.

ОСНОВНАЯ ПРОГРАММА
Код

program kk;
uses crt,SS;
var
i:byte;
f1:t;
begin
clrscr;
    assign(f1,'data.dbf');

{$I-}
reset(f1);
{$I+}
if Ioresult<>0 then
   begin
   rewrite(f1);
create(f1);
   end;
{create(f1);}

pech(f1);
obr(f1);
readln;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Пионер
**

Группа: Пользователи
Сообщений: 61
Пол: Мужской

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


вот тут я немного повозился с модулем получилось переделать две процедуры толькоя не уверен что я сделал правильно.
Код

unit ss;
interface
type
    peop=record
         fam:string[15];
         nam:string[15];
         rod:string[10];
         city:string[15];
         year:1900..2007;
         prof:string[15];
    end;

t1=text;
t= file of peop;


procedure create(var f1:t);
procedure obr(var f1:t);
procedure pech(var f1:t);

implementation

procedure create;
var
   kol,i:byte;
   chel:peop;
begin
rewrite(f1);
write('vvedite kol-vo= ');
readln(kol);
for i:=1 to kol do
with chel do
  begin
   write('familiy= ');readln(s.fam); writeln(f1, fam);
   write('name= ');readln(s.nam); writeln(f1, nam);
   write('rod= ');readln(s.rod); writeln(f1, rod);
   write('city= ');readln(s.city); writeln(f1, city);
   write('year= ');readln(s.year); writeln(f1, year);
   write('Profession= ');readln(s.prof);
  
  end;
close(f1);
end;


procedure pech(var f:t1; var kol:byte);
var
  i,kol:byte;
  chel:peop;
begin
rewrite(f);
while not(f) do
  with chel do
      begin
readln(f,fam); write(fam,' ');
readln(f,name); write(name,' ');
readln(f,rod); write(rod,' ');
readln(f,city); write(city,' ');
readln(f,year); write(year,' ');
readln(f,prof); write(prof,' ');
writeln;
{writeln(fam,' ',),}
end;
close(f);
end;


procedure obr;
var
   i:byte;
   s:peop;
   srv:integer;
begin
   reset(f1);
   srv:=0;
   for i:=1 to filesize(f1) do
       begin
          read(f1,s);
          srv:=srv+(2008-s.year);
       end;
   close(f1);
   srv:=srv div i;
   reset(f1);
   writeln('srednij vozrast = ',srv);
   writeln('rodstvenniki, vozrast kotorih menshe srednego:');
   writeln;
   for i:=1 to filesize(f1) do
         begin
           read(f1,s);
           if (2008-s.year)< srv then
               begin
                 with s do
                      begin
                         writeln(fam,' ',nam,' ',rod,' ',city,' ',year,' ',prof);
                         writeln('-------------------------------------------------');
                      end;
               end;
         end;
     close(f1);
end;

end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Пионер
**

Группа: Пользователи
Сообщений: 61
Пол: Мужской

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


Вот ещё я исправил.
Код

unit ss;
interface
type
        zap=record
            fam:string[10];
        nam:string[10];
        rod:string[10];
        town:string[10];
        byear:1900..2050;
        work:string[10];
            end;
    t1=text;
    
var
    ft1:t1;
procedure create(var f1:t1);
procedure obr(var f1:t1);
procedure pech(var f1:t1);

implementation

procedure create(var f1:t1); var
            lzap:zap;
            i:byte;
begin
    rewrite(f1);
        for i:=1 to 3 do
                with lzap do
            begin
                writeln('fam='); readln(fam); writeln(f1,fam);
                  writeln('nam='); readln(nam); writeln(f1,nam);
                writeln('rod='); readln(rod); writeln(f1,rod);
                writeln('town='); readln(town); writeln(f1,town);
                writeln('byear='); readln(byear); writeln(f1,byear);
                writeln('work='); readln(work); writeln(f1,work);
                            end;
                writeln(f1,#26);
                    close(f1);
    end;


procedure pech(var f1:t1);
    var
       lzap:zap;
       i:byte;
    begin
    reset(f1);
        while not eof(f1) do
            with lzap do
                begin
                    readln(f1,fam);
                      readln(f1,nam);                                                                readln(f1,rod);
                      readln(f1,town);
                             readln(f1,byear);
                    readln(f1,work);
                      writeln(fam,' ',nam,' ',rod,' ',town,' ', byear,' ',work);
                  writeln('------------------------------------');
            end; close(f1);
end;

procedure obr;
var
   i:byte;
   s:zap;
   srv:integer;
begin
   reset(f1);
   srv:=0;
   for i:=1 to filesize(f1) do
       begin
          read(f1,s);
          srv:=srv+(2008-s.year);
       end;
   close(f1);
   srv:=srv div i;
   reset(f1);
   writeln('srednij vozrast = ',srv);
   writeln('rodstvenniki, vozrast kotorih menshe srednego:');
   writeln;
   for i:=1 to filesize(f1) do
         begin
           read(f1,s);
           if (2008-s.year)< srv then
               begin
                 with s do
                      begin
                         writeln(fam,' ',nam,' ',rod,' ',city,' ',year,' ',prof);
                         writeln('-------------------------------------------------');
                      end;
               end;
         end;
     close(f1);
end;

end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Пионер
**

Группа: Пользователи
Сообщений: 61
Пол: Мужской

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


Всё я сделал, если кому надо будет то я выложу.
P.S проверте форум на вирусы а то мне касперский вылаёт что тут троянская программа
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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