Помощь - Поиск - Пользователи - Календарь
Полная версия: Работа с файлами
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Катя
Помогите сделать так,чтобы не происходило переполнение стека.Что тут исправить?Заранее спасибо.

{$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.


не забываем пользоваться тегами !
klem4
Если эта рограмма с нашего форума, написанная Volvo (а она мне ее очень напоминает)То в ней все должно быть правильно ... Возможно файлов слишком много, но тогда переполнился бы массив а не стек, увелич MaxDegree ...

хотя опятьже из-за большего кол-ва файлов может произойти переполнение стека, так как процедура поиска рекурсивная.
volvo
klem4, yes2.gif Вот отсюда: Работа с каталогами и файлами

Катя,
если переполняется стек - то увеличь его размер:
второй строкой программы (после {$N+}) добавь:
{$M 50000, 0, 0}
, ибо с динамическими переменными программа не работает... Если стек опять будет переполняться - можешь увеличить его размер до 65520. Это максимум, после этого для увеличения глубины рекурсии придется принимать другие меры...
Катя
Вы не думайте,я не пыталась эту задачу присвоить себе.Я знаю,её делал Volvo.Щас попробую.Спасибо ещё раз за помощь.

Не помогает,всё равно происходит переполнение.Это вообще можно исправить?
volvo
Примерное количество файлов и количество папок на диске C: какое у тебя?
Катя
Папок примерно 3000,а файлов 50000
volvo
Ясно...

Тогда, как видно, придется все-таки использовать динамическую память:

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;

Тогда в стеке при рекурсивном вызове будет создаваться не переменная типа SearchRec, размером в 42 байта, а всего лишь указатель на нее (4-х байтовый)...
Только теперь тебе придется исправлять {$M} на {$M 65520, 65520, 655360}
Катя
Хмм....У меня всё равно выдаёт перегрузку стека,а сейчас почему так??
volvo
Значит, все равно большая вложенность рекурсии... Переделывай программу на итеративную ("разверни" рекурсию в итерацию).
Катя
А не могли бы Вы помочь??А тоя сама не успею,да и не смогу.Пожалуйста!Мне надо в пятницу сдавать уже.
volvo
Катя
Вот программа... Попробуй ее прогнать...
Катя
Volvo, огромное спасибо!
Катя
Всё-таки есть проблема,программа не выводит ошибку,а просто останавливается на определённом этапе.Почему так происходит?
volvo
blink.gif Это как так? А на каком этапе, сколько папок и файлов до этого сканируется (хотя бы приблизительно)? Просто klem4 насколько я помню прогонял программу на большем, чем у тебя количестве файлов и папок, и все отработало...

Кстати, на сколько останавливается? Может, просто считает? Или еще что-то делает?
Катя
Выводит ^C и останавливается, папок ну может около 300 проходит,а файлов 6000 где-то.
volvo
blink.gif А ты в курсе, что "^C" - это значит, что ТЫ САМА нажала Ctrl+Break, чтобы остановить программу? Какие могут быть к программе после этого претензии? Проверяй свою систему, ибо у меня только что отработало на 6700 папок и 92000 файлов... И я не видел никаких "^C"

Я даже приблизительно не знаю, что может быть у тебя неправильно: 300 папок (при условии, что они все вложены друг в друга - это самый плохой вариант) потребуют 300*(256+4) байт динамической памяти, это всего чуть больше 76К, тебе же доступно почти 640К !!! Так что проблем отсюда быть не должно. Стек вообще не расходуется (от рекурсии я избавился)... Добавляй отладочную информацию и отлаживай программу на своей системе (попробуй после каждого pushStack выводить количество оставшейся доступной памяти через MemAvail, еще какую-нибудь информацию, я не знаю какую, но искать, почему программа работает "здесь", и не работает "там" я не могу, для этого надо отлаживать программу "там"), здесь тебе никто не помощник, потому что сбой ПОКА произошел только у тебя.

Попробуй распечатывать имена папок, которые добавляются (pushStack), и те, которые извлекаются (PopStack)... Так ты хотя бы будешь точно знать, на какой папке остановилось сканирование, может это чем-то поможет... Ну, и наконец, что, обязательно СРАЗУ тестировать на огромных объемах? Начинай проверять с маленьких, вложенных папок, чтобы в них было 20-50 подпапок и несколько сотен файлов, потом переходи к чуть большим числам, кто же сразу начинает с максимальных тестов при поиске ошибок...
Alenka
Попробывала сдать вашу программу, но препод сказал вывести гистограмму из дохрена записей!
После изменения кол-ва записей больше 23х остальные не помещаются на экране, он сказал сделать либо прокрутку либо что бы гистограмма стоилась в файле(типа потом откроешь и покажешь!)
Я пыталась сделать, но не как не получается! Помогите пожалуйста, он сказал сделать до завтра!
unsure.gif
volvo
Чтобы вывести результаты в файл, достаточно поменять процедуру 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;


Вот так у меня выглядит в обычном блокноте файл GST.TXT (при выборе моноширинного шрифта Lucida Console, если оставить шрифт по умолчанию - то правый ряд цифр будет неровным... В DOS-овском редакторе, типа встроенного в Norton Commander, ничего менять не надо - там будет нормально отображаться...):
Нажмите для просмотра прикрепленного файла
Alenka
Огромное, человеческое спасибо!
Alenka
Ещё такой вопрос! Эта программа выводит размеры начиная с БОЛЬШИХ 1024, а например в папке windows основную часть составляют файлы меньшего 1024 размера. Не скажите как поправить? Ну что бы появился вначале гистограммы блок от 0-1024 dry.gif
volvo
Procedure Gyst(const arr: array of integer;
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;
Тип TLong, насколько я помню, описывается как положено - от 0...
Alenka
Спасибо!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.