Работа с файлами, Гистограмма Опции

[Катя]

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

{$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 - 5.11.2006 21:25

[klem4]

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

хотя опятьже из-за большего кол-ва файлов может произойти переполнение стека, так как процедура поиска рекурсивная.

Сообщение отредактировано: klem4 - 16.01.2006 19:39

[volvo]

klem4, Вот отсюда: Работа с каталогами и файлами

Катя,
если переполняется стек - то увеличь его размер:
второй строкой программы (после {$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]

Это как так? А на каком этапе, сколько папок и файлов до этого сканируется (хотя бы приблизительно)? Просто klem4 насколько я помню прогонял программу на большем, чем у тебя количестве файлов и папок, и все отработало...

Кстати, на сколько останавливается? Может, просто считает? Или еще что-то делает?

[Катя]

Выводит ^C и останавливается, папок ну может около 300 проходит,а файлов 6000 где-то.

[volvo]

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

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

Попробуй распечатывать имена папок, которые добавляются (pushStack), и те, которые извлекаются (PopStack)... Так ты хотя бы будешь точно знать, на какой папке остановилось сканирование, может это чем-то поможет... Ну, и наконец, что, обязательно СРАЗУ тестировать на огромных объемах? Начинай проверять с маленьких, вложенных папок, чтобы в них было 20-50 подпапок и несколько сотен файлов, потом переходи к чуть большим числам, кто же сразу начинает с максимальных тестов при поиске ошибок...

[Alenka]

Попробывала сдать вашу программу, но препод сказал вывести гистограмму из дохрена записей!
После изменения кол-ва записей больше 23х остальные не помещаются на экране, он сказал сделать либо прокрутку либо что бы гистограмма стоилась в файле(типа потом откроешь и покажешь!)
Я пыталась сделать, но не как не получается! Помогите пожалуйста, он сказал сделать до завтра!


Сообщение отредактировано: Alenka - 13.01.2007 15:16

[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