Помогите сделать так,чтобы не происходило переполнение стека.Что тут исправить?Заранее спасибо.
{$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 (а она мне ее очень напоминает)То в ней все должно быть правильно ... Возможно файлов слишком много, но тогда переполнился бы массив а не стек, увелич MaxDegree ...
хотя опятьже из-за большего кол-ва файлов может произойти переполнение стека, так как процедура поиска рекурсивная.
klem4, Вот отсюда: http://forum.pascal.net.ru/index.php?s=&showtopic=7234&view=findpost&p=52353
Катя,
если переполняется стек - то увеличь его размер:
второй строкой программы (после {$N+}) добавь:
{$M 50000, 0, 0}, ибо с динамическими переменными программа не работает... Если стек опять будет переполняться - можешь увеличить его размер до 65520. Это максимум, после этого для увеличения глубины рекурсии придется принимать другие меры...
Вы не думайте,я не пыталась эту задачу присвоить себе.Я знаю,её делал Volvo.Щас попробую.Спасибо ещё раз за помощь.
Не помогает,всё равно происходит переполнение.Это вообще можно исправить?
Примерное количество файлов и количество папок на диске C: какое у тебя?
Папок примерно 3000,а файлов 50000
Ясно...
Тогда, как видно, придется все-таки использовать динамическую память:
type
PSearchRec = ^SearchRec;
procedure GetFiles(fn, dir : string; var L : TLong);
var
search : PSearchRec;
begin
new(search);
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;
dispose(search);
end;
Хмм....У меня всё равно выдаёт перегрузку стека,а сейчас почему так??
Значит, все равно большая вложенность рекурсии... Переделывай программу на итеративную ("разверни" рекурсию в итерацию).
А не могли бы Вы помочь??А тоя сама не успею,да и не смогу.Пожалуйста!Мне надо в пятницу сдавать уже.
Катя
Вот программа... Попробуй ее прогнать...
Прикрепленные файлы
iter.pas ( 2.53 килобайт )
Кол-во скачиваний: 225
Volvo, огромное спасибо!
Всё-таки есть проблема,программа не выводит ошибку,а просто останавливается на определённом этапе.Почему так происходит?
Это как так? А на каком этапе, сколько папок и файлов до этого сканируется (хотя бы приблизительно)? Просто klem4 насколько я помню прогонял программу на большем, чем у тебя количестве файлов и папок, и все отработало...
Кстати, на сколько останавливается? Может, просто считает? Или еще что-то делает?
Выводит ^C и останавливается, папок ну может около 300 проходит,а файлов 6000 где-то.
А ты в курсе, что "^C" - это значит, что ТЫ САМА нажала Ctrl+Break, чтобы остановить программу? Какие могут быть к программе после этого претензии? Проверяй свою систему, ибо у меня только что отработало на 6700 папок и 92000 файлов... И я не видел никаких "^C"
Я даже приблизительно не знаю, что может быть у тебя неправильно: 300 папок (при условии, что они все вложены друг в друга - это самый плохой вариант) потребуют 300*(256+4) байт динамической памяти, это всего чуть больше 76К, тебе же доступно почти 640К !!! Так что проблем отсюда быть не должно. Стек вообще не расходуется (от рекурсии я избавился)... Добавляй отладочную информацию и отлаживай программу на своей системе (попробуй после каждого pushStack выводить количество оставшейся доступной памяти через MemAvail, еще какую-нибудь информацию, я не знаю какую, но искать, почему программа работает "здесь", и не работает "там" я не могу, для этого надо отлаживать программу "там"), здесь тебе никто не помощник, потому что сбой ПОКА произошел только у тебя.
Попробуй распечатывать имена папок, которые добавляются (pushStack), и те, которые извлекаются (PopStack)... Так ты хотя бы будешь точно знать, на какой папке остановилось сканирование, может это чем-то поможет... Ну, и наконец, что, обязательно СРАЗУ тестировать на огромных объемах? Начинай проверять с маленьких, вложенных папок, чтобы в них было 20-50 подпапок и несколько сотен файлов, потом переходи к чуть большим числам, кто же сразу начинает с максимальных тестов при поиске ошибок...
Попробывала сдать вашу программу, но препод сказал вывести гистограмму из дохрена записей!
После изменения кол-ва записей больше 23х остальные не помещаются на экране, он сказал сделать либо прокрутку либо что бы гистограмма стоилась в файле(типа потом откроешь и покажешь!)
Я пыталась сделать, но не как не получается! Помогите пожалуйста, он сказал сделать до завтра!
Чтобы вывести результаты в файл, достаточно поменять процедуру Gyst вот на это:
Procedure Gyst(const arr: array of integer;
const size: integer);
var
i, j, max: integer;
mult_by: double;
f: text;
begin
ClrScr;
max := arr[1];
for i := 1 to pred(size) do
if max < arr[i] then max := arr[i];
mult_by := 60 / max;
assign(f, 'GST.TXT'); rewrite(f);
for i := 1 to pred(size) do begin
write(f, (i*step div 1024):4, 'Kb: ');
for j := 1 to Trunc(arr[i]*mult_by) do write(f, '*');
writeln(f, arr[i]:(80 - trunc(arr[i]*mult_by) - 7));
end;
close(f);
end;
Огромное, человеческое спасибо!
Ещё такой вопрос! Эта программа выводит размеры начиная с БОЛЬШИХ 1024, а например в папке windows основную часть составляют файлы меньшего 1024 размера. Не скажите как поправить? Ну что бы появился вначале гистограммы блок от 0-1024
Procedure Gyst(const arr: array of integer;Тип TLong, насколько я помню, описывается как положено - от 0...
const size: integer);
var
i, j, max: integer;
mult_by: double;
f: text;
begin
ClrScr;
max := arr[0]; { <--- Первое исправление }
for i := 0 to pred(size) do { <--- Второе исправление }
if max < arr[i] then max := arr[i];
mult_by := 60 / max;
assign(f, 'GST.TXT'); rewrite(f);
for i := 0 to pred(size) do begin { <--- Третье исправление }
write(f, (i*step div 1024):4, 'Kb: ');
for j := 1 to Trunc(arr[i]*mult_by) do write(f, '*');
writeln(f, arr[i]:(80 - trunc(arr[i]*mult_by) - 7));
end;
close(f);
end;
Спасибо!