Форум
» Назад на решение задач по физике и термеху
Регистрация | Профиль | Войти | Забытый пароль | Присутствующие | Справка | Поиск

» Добро пожаловать, Гость: Войти | Регистрация
    Форум
    Информационные технологии
        Турбо Паскаль. Программирование на 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 ]
Модераторы: paradise, KMA
  

KMA



Долгожитель

Уважаемая просто скинутые сообщения ИГНОРИРУЮТСЯ. Просим ваших мыслей.

-----
Gentoo, FreeBSD 7.2, PHP, JavaScript (jQuery), Python, Shell
Помогаю с задачами только на форуме.
Все мои действия четко согласуются с правилами раздела. Поэтому никаких претензий и обид.

Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 25 фев. 2007 22:14 | IP
Guest



Новичок

вапвап

Всего сообщений: Нет | Присоединился: Never | Отправлено: 26 фев. 2007 9:18 | IP
Guest



Новичок

Привет всем!Пожалуйста помогите решить задачу!Создать нетекстовый файл о сотрудниках(фамилию,имя,номер телефона)1)Найти номер телефона по фамилии сотрудника.2)Переписать в алфавитном порядке в текстовый файл инфу о сотрудниках, у которых первые цифры телефона 41.Очень срочно нужно,в понедельник экзамен!!Заранее спасибо!

Всего сообщений: Нет | Присоединился: Never | Отправлено: 26 фев. 2007 9:20 | IP
KMA



Долгожитель

Guest за денежку сделают срочно так, как тебе надо, тут на тебя никто не работает. Поэтому хочешь быстро и точно, я готов сделать но за плату.

Могу сказать лишь одно, поищи по форуму, эту задачу я уже как-то здесь решал.

Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 26 фев. 2007 23:02 | IP
Guest



Новичок

Привет всем!Пожалуйста помогите решить задачу!Создать нетекстовый файл о сотрудниках(фамилию,имя,номер телефона)1)Найти номер телефона по фамилии сотрудника.2)Переписать в алфавитном порядке в текстовый файл инфу о сотрудниках, у которых первые цифры телефона 41.Очень срочно нужно,в субботу экзамен!!Заранее спасибо!
Ну помогите пожалуйста!Я тут пыталась решать,но не получается.program pr1;
var
f1:file of string;
i:integer;
a,surname,name,phone,search:string;
begin
assign(f1,'rabot.dat');
rewrite(f1);
for i:=1 to 4 do
begin
writeln('familia');
readln(surname);
writeln('imia');
readln(name);
writeln('nomer');
readln(phone);
write(f1,surname,name,phone);
end;
close(f1);
assign(f1,'rabot.dat');
reset(f1);
writeln('vvedite poisk polya');
readln(search);
while not eof(f1) do
begin
if surname=search then
begin
writeln('naideno :');
writeln(surname,' ',phone);
end;
end;
close(f1);
assign(f1,'rabot.dat');
reset(f1);
while not eof(f1) do
begin
a:=copy(phone,1,2);
if a='41' then
writeln(surname);
end;
readln;
end.

Всего сообщений: Нет | Присоединился: Never | Отправлено: 28 фев. 2007 18:53 | IP
Guest



Новичок

Помогите мне пожалуйста я же девчёнка.

Всего сообщений: Нет | Присоединился: Never | Отправлено: 28 фев. 2007 18:55 | IP
KMA



Долгожитель

А где запись??? Нет, так дело не пойдет, сказано же нетекстовый файл. Значит так. Создадим запись.

type people=record
        surname: strign [25];
        name: string [20];
        phone: longInt
       end;

C этим разобрались. Теперь давай зададим глобальный массив, состоящий из этих записей.

VAR peoples: array [1..10] of people;
      f: file of people;

здесь 10 просто для удобства маленькая, реально, тут может быть и 100, и 200 и т. д.  

Теперь напишем процедуру заполнения записями файла с клавиатуры пользователем.

procedure addPeoples;
Var buf: people;
     j, m: byte;
Begin
        write ('How many records are you want to add ->');
        readLn (m);
        for j:=1 to m do
          begin
            write ('Name ->');
            readLn (buf.name);
            write ('Surname ->');
            readLn (buf.surname);
            write ('Phone ->');
            readLn (buf.phone);
            write (f, buf)
          end      
End;

Можно было бы и сразу вставить его в программу, просто так удобнее читать программу, да и сам метод намного лучше.

Теперь давай мы создадим процедуру вывода на экран сотрудника (чтобы удобно пользоваться было, т. к. ее не раз придется вызывать, уверяю).  

procedure showPeople (buf: people);
Begin
       with buf do
         begin
           write (name:20);
           write (surname: 25);
           writeLn (phone);
         end
End;

Теперь подготовительный курс закончили. Сейчас следует написать процедуру поиска человека по фамилии.

procedure searchPeopleSurname (searchSurname: string [25]);
Var buf: people;
      falg: boolean;
Begin
       seek (f, 0);
       flag:=true;
       while not eof (f) do
         begin
           read (f, buf);
           if buf.surname=searchSurname
              then
                begin
                  flag:=false;
                  showPeople (buf)
                end
         end;
      if flag
         then writeLn ('Sorry, no one record was found!')
End;

Итак первую часть мы сделали.

Теперь вторая часть, для этого опишем новую файловую переменную в разделе описания переменных, т. е. теперь она у тебя примет вид.

const n=10;
VAR ft: text;
      peoples: array [1..n] of people;
      f: file of people;
      buf: people;
      i: byte;

Замечательно, теперь я напишу процедуру сортировки по алфавиту. Для этого мне и нужен был этот массив peoples, и чтобы не возникало проблем с его адресацией и переносом, его все же лучше поместить в глобальный раздел описания переменных, т. е. сделать глобальным.

procedure sortAlphabet;
Var i, j, m: byte;
      buf: people;
Begin
       m:=1;
      while (m<>n) or (peoples[m].surname='') do
        inc (m);
     
      for i:=1 to m-1 do
       for j:=i to m-1 do
        if peoples[m].surname>peoples[m+1].surname
          then  
            begin
               buf:=peoples[m];
               peoples[m]:=peoples[m+1];
               peoples[m+1]:=buf;
            end;
End;

и последнее, что надо, это написать процедуру записи все в текстовый файл.

procedure writeToTXT (buf: people);
Var s: string
Begin
             str (buf.phone, s)
            writeLn (ft, buf.name, ' ', buf.surname, ' ', s);

End;  
Ну а теперь все. Пора оформлять саму программу =) Я упускаю первую часть (это создания файла, и поиск по номеру телефона). Достаточно просто запустить подпрограммы, написанные ранее, я сразу перехожу ко второй части.

BEGIN
          ...
          Assign (ft, 'result.txt');
          reWrite (ft);
          Seek (f, 0);
          i:=0;
          while not eof (f) do
             begin
                read (f, buf);
                if (buf.phone div 10000 =41) {для шестизначных номеров}
                   then
                    begin
                      inc (i);
                      peoples[ i ]:=buf;
                      if i=n
                         then
                           begin
                             sortAlpabet;
                             for i:=1 to n do
                               writeToTXT (peoples[ i ]);
                             i:=0
                            end;
                     end;
             end;
           if i<>0
               then
                 begin
                   sortAlphabet;
                   for j:=1 to i do
                     writeToTXT (peoples[j])
                 end;
         Close (ft);
         ...
END.


(Сообщение отредактировал KMA 28 фев. 2007 23:43)

-----
Gentoo, FreeBSD 7.2, PHP, JavaScript (jQuery), Python, Shell
Помогаю с задачами только на форуме.
Все мои действия четко согласуются с правилами раздела. Поэтому никаких претензий и обид.

Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 28 фев. 2007 23:33 | IP
Guest



Новичок

Я написала в Pascal всё как вы говорили, но у меня не чё не получается. Что мне делать? Помогите пожалуйста, в суботу зачёт.

Всего сообщений: Нет | Присоединился: Never | Отправлено: 1 марта 2007 20:02 | IP
KMA



Долгожитель

Правильно, потому что у меня, как у всех нормальных людей бывают опечатки, и некоторые слова (порой даже целенаправленно), написаны с ошибками, так вместо flag у меня встречается falg и т. д. Это значит, что нельзя просто бездумно копировать и вставлять текст, а потом компилировать. Нужно смотреть идеи. Я уже говорил, решение вашей задачи писать никто не будет, разбиритесь с кодом, кидайте его сюда, говорите что не понятно или не получается, соответственно я уже буду смотреть, иначе, заказывайте готовое решение.

Поймите, слова "не получается", не являются убедительными, подкрепите их фактами.


(Сообщение отредактировал KMA 1 марта 2007 23:16)

-----
Gentoo, FreeBSD 7.2, PHP, JavaScript (jQuery), Python, Shell
Помогаю с задачами только на форуме.
Все мои действия четко согласуются с правилами раздела. Поэтому никаких претензий и обид.

Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 1 марта 2007 23:15 | IP
Guest



Новичок

Привет это всё я, мне завтра сдавать работу, а я всё не могу её сделать.
Запускаю, она говорит что не открыт файл. Что бы я не делала ни чё не выходит.
type people=record
surname: strign [25];
name: string [20];
phone: longInt
end;
const n=10;
VAR ft: text;
peoples: array [1..n] of people;
f: file of people;
buf: people;
i: byte;
procedure addPeoples;
Var buf: people;
j, m: byte;
Begin
write ('How many records are you want to add ->');
readLn (m);
for j:=1 to m do
begin
write ('Name ->');
readLn (buf.name);
write ('Surname ->');
readLn (buf.surname);
write ('Phone ->');
readLn (buf.phone);
write (f, buf)
end
End;
procedure showPeople (buf: people);
Begin
with buf do
begin
write (name:20);
write (surname: 25);
writeLn (phone);
end
End;
procedure searchPeopleSurname (searchSurname: string [25]);
Var buf: people;
flag: boolean;
Begin
seek (f, 0); {Что обзначает 0?}
flag:=true;
while not eof (f) do
begin
read (f, buf);
if buf.surname=searchSurname then
begin
flag:=false;
showPeople (buf)
end
end;
if flag then writeLn ('Sorry, no one record was found!')
End;
procedure sortAlphabet;
Var i, j, m: byte;
buf: people;
Begin
m:=1;
while (m<>n) or (peoples[m].surname='') do
inc (m);

for i:=1 to m-1 do
for j:=i to m-1 do
if peoples[m].surname>peoples[m+1].surname
then
begin
buf:=peoples[m];
peoples[m]:=peoples[m+1];
peoples[m+1]:=buf;
end;
End;
procedure writeToTXT (buf: people);
Var s: string
Begin
str (buf.phone, s)
writeLn (ft, buf.name, ' ', buf.surname, ' ', s);
End;


BEGIN
procedure addPeoples;
procedure showPeople (buf: people);
procedure searchPeopleSurname (searchSurname: string [25]);
Assign (ft, 'result.txt');
reWrite (ft);
Seek (f, 0);
i:=0;
while not eof (f) do
begin
read (f, buf);
if (buf.phone div 10000 =41) {для шестизначных номеров}
then
begin
inc (i); {ЧТО такое inc(i)}
peoples[ i ]:=buf;
if i=n
then
begin
sortAlphabet;
for i:=1 to n do
writeToTXT (peoples[ i ]);
i:=0
end;
end;
end;
if i<>0
then
begin
sortAlphabet;
for j:=1 to i do
writeToTXT (peoples[j])
end;
Close (ft);
END.

Всего сообщений: Нет | Присоединился: Never | Отправлено: 2 марта 2007 12:23 | IP

Эта тема закрыта, новые ответы не принимаются

Переход к теме
<< Назад Вперед >>
Несколько страниц [ 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 ]

Форум работает на скрипте © Ikonboard.com