Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

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

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

Botsman Статус: Студент Рейтинг: 231 ∙ повысить рейтинг >>

Micren Статус: Практикант Рейтинг: 96 ∙ повысить рейтинг >>

Пупорев Юрий Борисович Статус: Специалист Рейтинг: 60 ∙ повысить рейтинг >>

/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Pascal

Выпуск № 857
от 19.04.2009, 14:35

Вопрос № 164889: Подскажите пожалуйста, как написать программу на Turbo Pascal считывающую названия всех текстовых файлов (с расширением .txt), лежащих вместе с ней в одной папке, и выводящую их названия в файл output.txt....

Вопрос № 164.889

Подскажите пожалуйста, как написать программу на Turbo Pascal считывающую названия всех текстовых файлов (с расширением .txt), лежащих вместе с ней в одной папке, и выводящую их названия в файл output.txt.

Отправлен: 14.04.2009, 11:01 Вопрос задал: Дорошенко Игорь Иванович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Boriss Здравствуйте, Дорошенко Игорь Иванович! Простейший вариант решения Вашей задачи в приложении Приложение: uses DOS; CONST FileName: String = 'output.txt'; VAR T: Text; sr: SearchREC; count: Integer; BEGIN Assign(t, FileName); Rewrite(t); FindFirst('*.txt', Archive, sr); count := 0; {На случай, если ни одного нет} while DOSerror = 0 do begin WriteLn(sr.Name); {Выводим на экран} WriteLn(t, sr.Name); {Выводим в файл} inc(count); FindNext(sr); end; if count = 0 then begin WriteLn(t,'Файлов с расширением txt нет'); WriteLn('Файлов с расширением txt нет'); end; Flush(t); Close(t); END. --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: Мордовский госуниверситет, Саранск, Факультет Электронной Техники WWW: Программирование на Паскале ICQ: 320096696 ---- Ответ отправлен: 14.04.2009, 19:21 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 247503 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Большое спасибо!

Вопрос № 164.893

Здравствуйте, у меня возникла проблема написания программ в POSCAL, прошу вас очень мне помочь.вот задача...(В одномерном массиве состоящему из 35 веществ элементов вычеслить: 1.Номер max элемента массива 2.Приобразовать массив таким образом чтоб в первой его половине распологались элементы стоявшие в нечётных, а во второй половине в четных позициях)....очень надеюсь на вашу помощь...зарание спасибо за помощь и понимание.

Отправлен: 14.04.2009, 11:52 Вопрос задал: Чередов Владимир Алексеевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Зенченко Константин Николаевич Здравствуйте, Чередов Владимир Алексеевич! Программа в приложении, выполняет последовательно обе задачи! Вывод массива производится после каждого обмена элементов массива, если нужен только результат, то код вывода можно перести в конец программы. Удачи! Приложение: uses crt; const n=35; type myType=real; var a:array[1..n]of myType; b,c,d,e:integer; f:myType; begin {в цикле создаем массив и ищем максимум} c:=1; for b:=1 to n do begin a[b]:=random;{случайное число} write(a[b]:10:7);{выводим} if (b mod 7)=0then writeln;{оформляем ввод} if a[c]<a[b]then c:=b;{проверяем максимум} end; writeln;{выводим результат первой задачи} write('Maximum a[',c,']:=',a[c]:10:7); readln; b:=2;{начинаем сортировку, первый элемент пропускаем т.к. он стоит на нечетном месте} c:=n; while b<c do begin d:=b;{начинаем обмен соседних элементов} e:=c; while d<e do begin f:=a[d];{сам обмен} a[d]:=a[d+1]; a[d+1]:=f; inc(d,2); end; TextColor(7); for d:=1 to n do begin{контрольный вывод, если нужно, то этот код можно вынести в конец программы} if d>=b then TextColor(15); if d>c then TextColor(7); write(a[d]:10:7); if (d mod 7)=0 then writeln; end; readln; inc(b);{следующие элементы} dec(c); end; readln; end.

Ответ отправил: Зенченко Константин Николаевич (статус: Профессор) Ответ отправлен: 14.04.2009, 20:50 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 247509 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает: Тимошенко Дмитрий Здравствуйте, Чередов Владимир Алексеевич! Программа в приложении. Только она Pascal, а Poscal - какой-то незнакомый язык. С уважением, Дмитрий Приложение: program massiv; uses crt; const count=35; {Количество элементов в массиве} var a: array [1..count] of real; i,j: word; tmp: real; begin ClrScr; {Заполним массив случайными числами от 0 до 1000} randomize; for i:=1 to count do a[i]:=random*1000; {Выведем исходный массив на экран} for i:=1 to count do if i mod 6<>0 then write(a[i]:11:7,' ') else writeln(a[i]:11:7); writeln; writeln; {Найдем максимальный элемент} j:=1; for i:=2 to count do if a[i]>a[j] then j:=i; writeln('Максимальный элемент N',j:2,' = ',a[j]:11:7); writeln; {Преобразуем массив} for j:=3 to count div 2+2 do begin i:=j; repeat tmp:=a[i]; a[i]:=a[i-1]; a[i-1]:=tmp; inc(i,2); until i>count-j+3; end; {Выведем преобразованный массив на экран} for i:=1 to count do if i mod 6<>0 then write(a[i]:11:7,' ') else writeln(a[i]:11:7); writeln; end.

Ответ отправил: Тимошенко Дмитрий (статус: 5-й класс) Ответ отправлен: 14.04.2009, 21:40 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 247515 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Вопрос № 164.895

Здравствуйте уважаемые эксперты! Очень прошу Вас помочь мне с решением задачи:Дана последовательность символов. Вывести на экран те из них, которые входят в последовательность два, три и более раз. С благодарностью, Наталья.

Отправлен: 14.04.2009, 12:20 Вопрос задала: Улитина Наталья Владимировна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Botsman Здравствуйте, Улитина Наталья Владимировна! Помогаю. Код программы - в приложении. Комментарии - внутри кода Все. Рад был помочь! Приложение: var s:string; found:set of char;{множество различных найденных символов} printed:set of char;{множество напечатанных символов} i:integer; BEGIN writeln('Введите последовательность символов:'); readln(s); writeln('Символы, встречающиеся более одного раза:'); for i:=1 to length(s) do begin if not(s[i] in found) then {если текущий символ еще ни разу не встречался} found:=found+[s[i]] {значит, теперь он встретился хотя бы один раз} else if not(s[i] in printed) then{иначе это искомый символ и смотрим, печатали ли мы его, и если нет,то...} begin write(s[i]); {... печатаем...} printed:=printed+[s[i]];{...и добавляем к напечатанным} end; end; if printed=[] then writeln('таких нет'); readln; END. --------- Хочешь победить Excel? Спроси меня как! ;)

Ответ отправил: Botsman (статус: Студент) Ответ отправлен: 14.04.2009, 13:11 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 247474 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Большое спасибо Вам!Вы мне очень помогли!!!

Вопрос № 164.906

Уважаемые эксперты! Снова прошу Вас о помощи! Пожалуйста помогите решить еще одну задачу:Создать файл K, компонентами которого являются все четные числа в диапазоне от 2 до20.Переписать в файл E все компоненты файла K, предварительно уменьшив их в десять раз. Прочитать файл E. Спасибо за помощь!

Отправлен: 14.04.2009, 13:48 Вопрос задала: Улитина Наталья Владимировна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Botsman Здравствуйте, Улитина Наталья Владимировна! В приложении - решение вашей задачи. Комментарии - в коде. Все. Рад был помочь! Приложение: var k:file of integer; e:file of real; tmp_k,i:integer; tmp_e:real; BEGIN {связываем файловые переменные с именами файлов} assign(e,'E'); assign(k,'K'); {создаем файл K} rewrite(k); {заполняем его целыми четными числами от 2 до 20} i:=2; while i<=20 do begin write(k,i); inc(i,2); end; {закрываем файл K} close(k); {создаем файл E} rewrite(e); {открываем для чтения файл K} reset(k); {пока не достигнут конец файла К} while not eof(k) do {в E пишем считанные из K данные, уменьшенные в 10 раз} begin read(k,tmp_k); tmp_e:=tmp_k/10; write(e,tmp_e); end; {закрываем файлы} close(k); close(e); {читаем и выводим на экран сдержимое файла E} reset(e); writeln('Содержимое файла Е:'); while not eof(e) do begin read(e,tmp_e); writeln(tmp_e:6:2); end; close(e); readln; END. --------- Хочешь победить Excel? Спроси меня как! ;)

Ответ отправил: Botsman (статус: Студент) Ответ отправлен: 14.04.2009, 14:23 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 247482 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Можно было бы поставить 100 поставила бы 100!!! Большое спасибо вам!!!

Вопрос № 164.909

Пожалуйста помогите еще с одной задачей!Опишите запись СТУДЕНТ и поместите в неё следующую информацию: Ф.И.О., оценки (математика, физика, черчение, химия, сопромат ). Определите, сколько студентов имеют неудовлетворительную оценку хотя бы по одному предмету,Воспользовавшись этой записью , определить количество отличных оценок, полученных группой по всем предметам. С благодарностью и уважением, Наталья!

Отправлен: 14.04.2009, 13:56 Вопрос задала: Улитина Наталья Владимировна (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Botsman Здравствуйте, Улитина Наталья Владимировна! Помогаю! Код решения - в приложении, комментарии - внутри. Рад был помочь! Приложение: uses crt; const maxQty=100;{максимальное количество студентов в группе} n=5;{количество предметов} predmety:array[1..n] of string =( 'математика', 'физика', 'черчение', 'химия', 'сопромат' );{названия предметов} type TMark=2..5; student=record fio:string[30]; marks:array[1..n] of TMark; end; var baza:array[1..maxQty] of student; qty:integer;{фактическое количество студентов в группе} i,j:integer; tmp:string;{для ввода данных} group5:integer;{общее кол-во отличных оценок в группе} groupOnly5:integer;{количество студентов в группе, у которых все 5} has2qty:integer;{количество двоечников} has2:boolean;{флаг наличия неудовлетворительных оценок} hasOnly5:boolean;{флаг отличника} BEGIN clrscr; writeln('Ввод данных'); i:=0; writeln('Запись#',i+1,':'); write('введите ФИО:');readln(tmp); while (tmp<>'0') and (i<=maxQty) do begin inc(i,1); baza[i].fio:=tmp; writeln('введите оценки студента:'); for j:=1 to n do repeat write('предмет: ',predmety[j],', оценка='); readln(baza[i].marks[j]); until (baza[i].marks[j])in [2..5]; writeln; writeln('Запись#',i+1,':'); write('введите ФИО или 0, чтобы закончить ввод:'); readln(tmp); end; qty:=i;{запоминаем количество фактически сделанных записей} {анализируем введенные данные} group5:=0;{кол-во пятерок в группе} groupOnly5:=0;{кол-во отличников} has2qty:=0; for i:=1 to qty do begin has2:=false;{двоек у этого студента пока не нашли} hasOnly5:=true;{по умолчанию каждый студент - отличник} for j:=1 to n do begin if baza[i].marks[j]=5 then inc(group5,1){увеличиваем кол-во пятерок} else begin hasOnly5:=false;{студент-не отличник} if baza[i].marks[j]=2 then has2:=true;{студент-двоечник} end; end; if has2 then inc(has2qty,1){если двоечник, увеличиваем их число} else if hasOnly5 then inc(groupOnly5,1);{если отличник, наращиваем количество отличников} end; {выводим итоги анализа} writeln; writeln('Итого:'); writeln('Количество отличных оценок в группе: ',group5); writeln('Количество отличников в группе: ',groupOnly5); writeln('Количество двоечников в группе: ',has2qty); writeln('Справочно:'); writeln('Общее количество студентов в группе:',qty); writeln('Общее количество полученных оценок:',qty*n); readln; END. --------- Хочешь победить Excel? Спроси меня как! ;)

Ответ отправил: Botsman (статус: Студент) Ответ отправлен: 14.04.2009, 16:28 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 247489 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Как клево что есть такие добросердечные люди, как Вы! Спасибо Вам огромное!

© 2001-2009, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 5.13 от 01.12.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru RusIRC.ru | Kalashnikoff.ru | RadioLeader.ru