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

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

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

> Работа с файлами, Гистограмма
сообщение
Сообщение #1


Новичок
*

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

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


Помогите сделать так,чтобы не происходило переполнение стека.Что тут исправить?Заранее спасибо.

{$N+}
uses crt, dos;

const
maxDegree = 19;
step = 100 * 1024;

type

TLong = array[0..maxDegree] of Integer;
var
startDir : string;

sizes : TLong;

procedure GetFiles(fn, dir : string; var L : TLong);
var
search : SearchRec;
begin

if dir[length(dir)] <> '\' then
dir := dir + '\';

FindFirst(dir + fn, AnyFile, search);

while dosError = 0 do begin
if search.attr <> $10 then begin
writeln(search.name:15, (search.size div step) : 10);
inc(L[search.size div step])
end;
FindNext(search);
end;

FindFirst(dir + '*.*', Directory, search);

while doserror = 0 do begin
if (search.attr and 16 <> 0) and (search.name[1] <> '.') then
GetFiles(fn, dir + search.name, L);
FindNext(search);
end;

end;

Procedure Gyst(const arr: array of integer;
const size: integer);
var
i, j, max: integer;
mult_by: double;
begin
ClrScr;
max := arr[1];
for i := 1 to pred(size) do
if max < arr[i] then max := arr[i];

mult_by := 60 / max;
for i := 1 to pred(size) do begin
gotoxy(2, 2 + i); write((i*step div 1024):4, 'Kb: ');
for j := 1 to Trunc(arr[i]*mult_by) do write(chr(178-byte(odd(i))));
gotoxy(72, 2 + i); write(arr[i]:4);
end;

end;

var
i : byte;
begin

clrscr;

FillChar(sizes, sizeof(sizes),0);

GetFiles('*.*','c:\', sizes);

writeln;

Gyst(sizes, Succ(maxDegree));
ReadLn;
end.


не забываем пользоваться тегами !

Сообщение отредактировано: volvo -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Катя   Работа с файлами   16.01.2006 23:08
klem4   Если эта рограмма с нашего форума, написанная Vol…   16.01.2006 23:28
volvo   klem4, :yes2: Вот отсюда: Работа с каталогами и ф…   17.01.2006 1:01
Катя   Вы не думайте,я не пыталась эту задачу присвоить с…   17.01.2006 19:17
volvo   Примерное количество файлов и количество папок на …   17.01.2006 19:45
Катя   Папок примерно 3000,а файлов 50000   17.01.2006 22:35
volvo   Ясно... Тогда, как видно, придется все-таки испол…   17.01.2006 23:08
Катя   Хмм....У меня всё равно выдаёт перегрузку стека,а …   18.01.2006 18:20
volvo   Значит, все равно большая вложенность рекурсии... …   18.01.2006 18:37
Катя   А не могли бы Вы помочь??А тоя сама не успею,да и …   18.01.2006 22:42
volvo   Катя Вот программа... Попробуй ее прогнать...   18.01.2006 23:39
Катя   Volvo, огромное спасибо!   18.01.2006 23:48
Катя   Всё-таки есть проблема,программа не выводит ошибку…   21.01.2006 5:10
volvo   :blink: Это как так? А на каком этапе, сколько пап…   21.01.2006 5:47
Катя   Выводит ^C и останавливается, папок ну может около…   21.01.2006 14:05
volvo   :blink: А ты в курсе, что "^C" - это зна…   21.01.2006 15:18
Alenka   Попробывала сдать вашу программу, но препод сказал…   13.01.2007 19:15
volvo   Чтобы вывести результаты в файл, достаточно поменя…   13.01.2007 19:43
Alenka   Огромное, человеческое спасибо!   13.01.2007 19:57
Alenka   Ещё такой вопрос! Эта программа выводит размер…   13.01.2007 21:24
volvo   Procedure Gyst(const arr: array of integer; …   13.01.2007 21:30
Alenka   Спасибо!   13.01.2007 22:32


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

 





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