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

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

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

> Работа с файлами, Гистограмма
Катя
сообщение 16.01.2006 19:08
Сообщение #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 - 5.11.2006 21:25
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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


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

 



- Текстовая версия 20.07.2025 1:34
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"