Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

lamed Статус: Практикант Рейтинг: 2371 ∙ повысить рейтинг »

Boriss Статус: Академик Рейтинг: 2113 ∙ повысить рейтинг »

_Ayl_ Статус: Практикант Рейтинг: 1863 ∙ повысить рейтинг »

Вопрос № 177944: Уважаемые эксперты, требуется ваша помощь в написании программы в Борланд Паскаль. На диске D, в текстовом файле хранится информация о работниках фирмы: Фамилия и инициалы - 30символов Стаж - 10 символов Оклад - 10 символов Требуется ...

Уважаемые эксперты, требуется ваша помощь в написании программы в Борланд Паскаль.
На диске D, в текстовом файле хранится информация о работниках фирмы:
Фамилия и инициалы - 30символов
Стаж - 10 символов
Оклад - 10 символов
Требуется написать программу, через которую можно:
выполнять поиск по заданному критерию
дополнять записи
удалять записи
изменять записи.

Прошу написать комментарии к шагам программы. Заранее благодарен.

Отправлен: 19.04.2010, 22:31
Вопрос задал: Xrom1989, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
{ в текстовом файле хранится информация о работниках фирмы: Фамилия и инициалы - 30символов Стаж - 10 символов Оклад - 10 символов Требуется написать программу, через которую можно: выполнять поиск по заданному критерию дополнять записи удалять записи изменять записи. } program q177944; uses crt; type str30 = string[30]; PTEmploye = ^TEmploye; TEmploye = record next, prev : PTEmploye; name : str30; experience : real; salary : real; end; function trim_end( s: string ): string; var i : integer; begin i := length( s ); while i > 0 do begin if (s[i] <> \' \') and (s[i] <> #9) then break; dec( i ); end; s[0] := chr(i); trim_end := s; end; { загрузка данных из форматированного текстового файла } function load_data( var f: text ): PTEmploye; var pHead, pTail, p : PTEmploye; lin,s : string; code: integer; begin write( \'File name: \' ); readln( lin ); assign( f, lin ); reset( f ); write( \'Loading data...\' ); pHead := nil; pTail := nil; while not eof( f ) do begin readln( f, lin ); lin := trim_end( lin ); if length( lin ) > 0 then begin New( p ); with p^ do begin name := trim_end( copy( lin, 1, 30 )); s := trim_end( copy(lin,31,10)); val( trim_end(copy(lin,31,10)), experience, code ); s := copy(lin,41,10); val( copy(lin,41,10), salary, code ); { вставляем новый элемент в конец списка } prev := pTail; next := nil; { следующего элемента пока нет } end; if pHead = nil then { первый элемент в списке } pHead := p else { добавляем в конец } pTail^.next := p; pTail := p; end; end; load_data := pHead; close( f ); writeln( \'OK.\' ); end; { дополнение строки пробелами (для форматированного вывода) } function pad_with_spaces( name: string; len: integer ): string; var s: string; n: integer; begin s := name; n := length( s ); while n < len do begin inc(n); s[n] := \' \'; end; s[0] := chr( n ); pad_with_spaces := s; end; { сохранение данных в файл } procedure save_data( var f: text; pList: PTEmploye ); begin if pList = nil then begin writeln( \'No data\' ); exit; end; write( \'Saving data...\' ); rewrite( f ); while pList <> nil do begin with pList^ do writeln( f, pad_with_spaces(name,30), experience:10:2, salary:10:2 ); pList := pList^.next; end; close( f ); writeln( \'OK.\' ); end; { вывод списка на экран } procedure list_data( pList: PTEmploye ); begin if pList = nil then begin writeln( \'No data\' ); exit; end; writeln( \'Name Experience Salary\' ); writeln( \'--------------------------------------------------\' ); while pList <> nil do begin with pList^ do writeln( pad_with_spaces(name,30), experience:10:2, salary:10:2 ); pList := pList^.next; end; writeln( \'--------------------------------------------------\' ); end; { сохранение данных в файл под другим именем } procedure save_as( var f: text; pList: PTEmploye ); var fname: string; begin write( \'File name: \' ); readln( fname ); assign( f, fname ); save_data( f, pList ); end; { поиск по фамилии работника } function search_employe( pList: PTEmploye; name: str30 ): PTEmploye; var p: PTEmploye; begin { сначала ищем точное совпадение } p := pList; while p <> nil do begin if p^.name = name then begin search_employe := p; exit; end; p := p^.next; end; { точное совпадение не найдено, ищем частичное } p := pList; while p <> nil do begin if pos( name, p^.name ) <> 0 then begin search_employe := p; exit; end; p := p^.next; end; search_employe := nil; end; { вывод одной записи на экран } procedure type_rec( p: PTEmploye ); begin if p <> nil then with p^ do writeln( \' Name : \', name, #13#10\' Experience: \', experience:2:2, #13#10\' Salary : \', salary:2:2 ); end; { запрос фамилии/имени и поиск } procedure search( pList: PTEmploye ); var p: PTEmploye; name: str30; begin if pList = nil then begin writeln( \'No data\' ); exit; end; write( \'Name to search: \' ); readln( name ); p := search_employe( pList, name ); if p <> nil then begin writeln( \'Match found: \' ); type_rec( p ); end else writeln( \'No matches\' ); end; { Удаление записи. Обновляет указатель на список, если удаляется первая запись. } procedure delete_rec( var pList: PTEmploye ); var p: PTEmploye; name: str30; begin if pList = nil then begin writeln( \'No data\' ); exit; end; write( \'Employe\'\'s name to delete: \' ); readln( name ); p := search_employe( pList, name ); if p <> nil then begin writeln( \'Match found: \' ); type_rec( p ); if p^.prev <> nil then p^.prev^.next := p^.next else pList := p^.next; if p^.next <> nil then p^.next^.prev := p^.prev; dispose( p ); { освобождаем память } writeln( \'Record deleted\' ); end else writeln( \'No matches\' ); end; { редактирование записи } procedure edit_rec( pList: PTEmploye ); var p: PTEmploye; buf: str30; code: integer; begin if pList = nil then begin writeln( \'No data\' ); exit; end; write( \'Employe\'\'s name to edit: \' ); readln( buf ); p := search_employe( pList, buf ); if p <> nil then begin writeln( \'Match found: \' ); type_rec( p ); with p^ do begin write( \'New name or [Enter] to leave current: \' ); readln( buf ); if buf[0] <> #0 then name := buf; write( \'New experience or [Enter] to leave current: \' ); readln( buf ); if buf[0] <> #0 then val( buf, experience, code ); write( \'New salary or [Enter] to leave current: \' ); readln( buf ); if buf[0] <> #0 then val( buf, salary, code ); end; end else writeln( \'No matches\' ); end; { добавление записи } procedure add_rec( var pList: PTEmploye ); var p, pTail: PTEmploye; name: str30; begin write( \'Employe\'\'s name: \' ); readln( name ); if name[0] = #0 then exit; New( p ); p^.name := name; write( \'Experience: \' ); readln( p^.experience ); write( \'Salary: \' ); readln( p^.salary ); { вставляем новый элемент в конец списка } pTail := pList; if pTail <> nil then begin while pTail^.next <> nil do pTail := pTail^.next; end; p^.prev := pTail; p^.next := nil; { следующего элемента пока нет } if pList = nil then { первый элемент в списке } pList := p else { добавляем в конец } pTail^.next := p; end; { удаление всего списка } procedure clear_data( pList: PTEmploye ); var p: PTEmploye; begin while pList <> nil do begin p := pList^.next; dispose( pList ); pList := p; end; end; var f : text; pList : PTEmploye; ch : char; begin pList := nil; repeat writeln( \'-------------------------\' ); writeln( \'1. Load data...\'#13#10\'2. List\'#13#10\'3. Save\'#13#10\'4. Save As...\' ); writeln( \'5. Search...\'#13#10\'6. Delete record...\'#13#10\'7. Edit record...\'#13#10\'8. Add record...\' ); writeln( \'9. Clear data\'#13#10\'0. Exit\' ); writeln( \'-------------------------\' ); ch := readkey; case ch of \'1\': pList := load_data( f ); \'2\': list_data( pList ); \'3\': save_data( f, pList ); \'4\': save_as( f, pList ); \'5\': search( pList ); \'6\': delete_rec( pList ); \'7\': edit_rec( pList ); \'8\': add_rec( pList ); \'9\': begin clear_data( pList ); pList := nil; end; end; until ch = \'0\'; end.

Ответ отправил: amnick, 9-й класс
Ответ отправлен: 20.04.2010, 22:50
Номер ответа: 260940

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 260940 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Здравствуйте ) Меня попросили решить контрольную, но я столкнулся с проблемой, паскаль не учил и не могу выполнить последнее задание (
Нужно составить блок-схему алгоритма и программу на языке программирования Паскаль для решения задачи, включающей ввод исходных данных, организацию цикла, и выбор по заданному условию.
Функция - Y = системе
tg(X)+sin(21/2) при х<=0.8
x^2+9*X^2*21*tg(X)^2 при x >0.8
интервал изменения аргумента x=0.1-1.5
шаг 0,1
Выручите пожалуйста )

Отправлен: 19.04.2010, 22:46
Вопрос задал: Ананьев Рудольф Олегович, 1-й класс
Всего ответов: 1
Страница вопроса »

Приложение:
uses crt; const t=0.0001;{точность определения заданных значений} var x,xn,xk,dx,y:real; begin clrscr; xn:=0.1;{исходные данные} xk:=1.5; dx:=0.1; x:=xn;{начало табулирования} while x<=xk+t do{пока не дойдем до конца интервала} begin if x<=0.8+t then y:=sin(x)/cos(x)+sin(21/2){первое условие} else y:=x*x+9*x*x+21*sqr(sin(x)/cos(x));{второе условие} writeln(\'x=\',x:4:1,\' y=\',y:6:2);{вывод результатом, форматированный вывод, под х 4 позиции и 1 знак после запятой, под у 6 позиций и 2 знака после запятой} x:=x+dx;{наращиваем арнумент} end; readln end. Прикрепленный файл: загрузить »

Ответ отправил: Пупорев Юрий Борисович, Специалист
Ответ отправлен: 20.04.2010, 06:21
Номер ответа: 260923

Оценка ответа: 5

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 260923 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Добрый вечер уважаемые эксперты, прошу помочь в написании следующей программы: надо написать программу преобразования списка-
изначально: U1,U2...Un
конечный результат:Un,Un-1,...U1.
Прошу писать комменты к шагам программы. Заренее очень благодарен.

Отправлен: 19.04.2010, 23:01
Вопрос задал: Xrom1989, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
{ программа преобразования списка - изначально: U1,U2...Un конечный результат: Un,Un-1,...U1. } program q177947; type PTList = ^TList; TList = record next: PTList; data: integer; end; { Формирование списка } function make_list: PTList; var pList, p: PTList; i: integer; begin pList := nil; { указатель на начало списка - список пуст } for i := 0 to 9 do begin New( p ); { выделяем память для очередного элемента } p^.data := i; { сохраняем данные } p^.next := pList; { вставляем новый элемент в начало списка } pList := p; { указатель на начало списка } end; make_list := pList; end; { функция возвращает указатель на инвертированный список } function invert_list( pList: PTList ) : PTList; var p, tmp : PTList; begin p := nil; while pList <> nil do begin tmp := pList; pList := pList^.next; tmp^.next := p; p := tmp; end; invert_list := p; end; { Печать списка (в конце выводится лишняя запятая) } procedure print_list( p: PTList ); begin while p <> nil do begin write( p^.data, \',\' ); p := p^.next; end; writeln; end; { удаление списка } procedure delete_list( pList: PTList ); var p: PTList; begin while pList <> nil do begin p := pList^.next; Dispose( pList ); pList := p; end; end; var pList: PTList; { указатель на начало списка } begin writeln(\'---------------------\'); pList := make_list; { Формируем список } print_list( pList ); { Печатаем список } pList := invert_list( pList ); print_list( pList ); { Печатаем список } delete_list( pList ); { Освобождаем память } end.

Ответ отправил: amnick, 9-й класс
Ответ отправлен: 20.04.2010, 15:49
Номер ответа: 260933

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 260933 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »