KMA 
Долгожитель
|
     
Уважаемая просто скинутые сообщения ИГНОРИРУЮТСЯ. Просим ваших мыслей.
|
Всего сообщений: 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)
|
Всего сообщений: 940 | Присоединился: декабрь 2005 | Отправлено: 28 фев. 2007 23:33 | IP
|
|
Guest
Новичок
|
Я написала в Pascal всё как вы говорили, но у меня не чё не получается. Что мне делать? Помогите пожалуйста, в суботу зачёт.
|
Всего сообщений: Нет | Присоединился: Never | Отправлено: 1 марта 2007 20:02 | IP
|
|
KMA
Долгожитель
|
Правильно, потому что у меня, как у всех нормальных людей бывают опечатки, и некоторые слова (порой даже целенаправленно), написаны с ошибками, так вместо flag у меня встречается falg и т. д. Это значит, что нельзя просто бездумно копировать и вставлять текст, а потом компилировать. Нужно смотреть идеи. Я уже говорил, решение вашей задачи писать никто не будет, разбиритесь с кодом, кидайте его сюда, говорите что не понятно или не получается, соответственно я уже буду смотреть, иначе, заказывайте готовое решение.
Поймите, слова "не получается", не являются убедительными, подкрепите их фактами.
(Сообщение отредактировал KMA 1 марта 2007 23:16)
|
Всего сообщений: 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
|
|
|
Форум
Турбо Паскаль. Программирование на Pascal
