Вопрос чайника

← →
Малограмотный (2002-08-01 13:52) [0]

Здравствуйте!

Пусть имеется одномерный массив переменной длины DynamicArray, элементами которого (если это имеет значение) являются записи. Как передать его в процедуру или функцию, чтобы внутри неё можно было изменять его длину?

← →
Skier © (2002-08-01 13:54) [1]

>Малограмотный
опиши массив в разделе type и усё...

← →
MBo © (2002-08-01 13:54) [2]

объявить тип
type
DynArr=array of SomeRec;

завести переменную этого типа и в параметрах процедуры тоже его указать

← →
Малограмотный (2002-08-01 14:21) [3]

... type FileInfoRec = record Name : String; .............. end; procedure Search (..., FileInfo : array of FileInfoRec); implementation procedure Search (..., FileInfo : array of FileInfoRec); ... begin ... SetLength (FileInfo, 3000); ... end; end.

Эту процедуру я вызываю из другого модуля:

unit Unit1;
...
procedure TMainForm.FormCreate(Sender: TObject);
var
FileInfo : array of FileInfoRec;
begin
Search(..., FileInfo); {ЗДЕСЬ ВОЗНИКАЕТ ОШИБКА: TYPES OF ACTUAL AND FORMAL VAR PARAMETERS MUST BE IDENTICAL}
end.

← →
Skier © (2002-08-01 14:23) [4]

>Малограмотный

procedure Search (..., FileInfo : array of FileInfoRec);

FileInfo : array of FileInfoRec - это открытый массив !

Тебе же говорят type !

← →
Малограмотный (2002-08-01 14:36) [5]

...

type
FileInfoRec = record
Name : String;
..............
end;
FileInfoArray = array of FileInfoRec;

procedure Search (..., FileInfo : FileInfoArray);

implementation

procedure Search (..., FileInfo : FileInfoArray);
...
begin
...
SetLength (FileInfo, 3000);
...
end;

end.

Эту процедуру я вызываю из другого модуля:

unit Unit1;
...
procedure TMainForm.FormCreate(Sender: TObject);
var
FileInfo : FileInfoArray;
begin
Search(..., FileInfo); {ТА ЖЕ САМАЯ ОШИБКА}
end.

← →
Skier © (2002-08-01 14:44) [6]

>Малограмотный
Ошибка не из-за FileInfo !

Давай полное описание Search и "полный" вызов
без "..."

← →
Anatoly Podgoretsky © (2002-08-01 14:52) [7]

Тебе же говорят type !

← →
Skier © (2002-08-01 14:55) [8]

>Anatoly Podgoretsky
Дык, type он уже "сказал"...
Видимо баг где-то ащё (?)

← →
Anatoly Podgoretsky © (2002-08-01 15:05) [9]

Невнимательно смотрел и всегда сбивает отсутствие Т

← →
Малограмотный (2002-08-01 15:07) [10]

unit File_Search;

interface

uses Windows, SysUtils, Classes, Masks;

type
FileInfoRec = record
Name : String;
Folder : String;
Size : Integer;
DateOfCreate : TDateTime;
DateOfChange : TDateTime;
DateOfLastAccess : TDateTime;
end;
FileInfoArray = array of FileInfoRec;
var
FileInfo : FileInfoArray;

function SearchInDir (BeginDir, Mask : String; Attr, MaxSize : Integer;
var FileInfo : FileInfoArray; var CurrentLength : Integer) : Boolean;

implementation

{ Функция поиска в заданном каталоге }
function SearchInDir (BeginDir, Mask : String; Attr, MaxSize : Integer;
var FileInfo : FileInfoArray; var CurrentLength : Integer) : Boolean;
var
Res, Index : Integer;
F : TSearchRec;
Agree : Boolean;
FileTime : TFileTime;
SystemTime : TSystemTime;
begin
Result := False;
{$I-} { Отключить проверку ошибок ввода-вывода }
ChDir (BeginDir); { Перейти в указанный каталог }
{$I+} { Включить проверку }
if IOResult<>0 then Exit; { Перейти не удалось }
Index := CurrentLength;
Res := FindFirst (Mask, Attr, F); { Первая запись в каталоге }
while Res = 0 do
begin
Agree := False;
if (MatchesMask (F.Name, Mask)) then Agree := True; { Удовлетворяет хотя бы одной маске }
if (MaxSize<>-1) then if (F.Size > MaxSize) then Agree := False; { Если MaxSize = -1, это значит, что проверка на размер не нужна }
if (F.Attr and faDirectory) = faDirectory then { Если это каталог }
begin
Agree := False; { Не подходит, т.к. нужно получить список только файлов }
if (F.Name<>".") and (F.Name<>"..") then { Если каталог не текущий и не родительский }
begin
SearchInDir (ExpandFileName (F.Name), Mask,
Attr, MaxSize, FileInfo, Index); {Рекурсия}
ChDir (BeginDir); { Возвращаемся в исходный каталог }
end;
end;
if Agree then
begin
if Frac (Index / 1000) = 0 then { Если Index = 1000, 2000, 3000... }
SetLength (FileInfo, Index + 1000); { Увеличиваем длину массива на 1000 }
with FileInfo [Index] do
begin
Name := F.Name;
Folder := ExtractFileDir (ExpandFileName (F.Name));
{ Дальше здесь идёт определение даты создания, изменения, последнего доступа... }
end;
Inc (Index);
end;
Res := FindNext (F);
end;
FindClose (F);
SetLength (FileInfo, Index); { Удаляем пустые элементы массива }
CurrentLength := Index;
Result := True;
end;

end.

Вызов процедуры (из другого модуля):

procedure TMainForm.FormCreate(Sender: TObject); var i, CurrentLength : Integer; FileInfo : FileInfoArray; ListItem : TListItem; begin SetLength (FileInfo, 0); if SearchInDir ("C:\", "*.*", faAnyFile, -1, FileInfo, 0) then begin if CurrentLength = 0 then { Не найдено ни одного файла } begin Application.MessageBox ({Не удалось найти и т.д.}) Exit; end; for i := 0 to CurrentLength - 1 do with FileInfo [i] do begin ListItem := ListView_Results.Items.Add; ListItem.Caption := Name; ListItem.SubItems.Add (Folder); end; end; end; end;

>Anatoly Podgoretsky

> и всегда сбивает отсутствие Т

Да уж :)
Это MBo "виноват" :)))

>Малограмотный

type
FileInfoRec = record
Name : String;
Folder : String;
Size : Integer;
DateOfCreate : TDateTime;
DateOfChange : TDateTime;
DateOfLastAccess : TDateTime;
end;
FileInfoArray = array of FileInfoRec;
var
FileInfo : FileInfoArray; (1)

function SearchInDir (BeginDir, Mask : String; Attr, MaxSize :
Integer;
var FileInfo : FileInfoArray (2); var
CurrentLength : Integer) : Boolean;

var
i, CurrentLength : Integer;
FileInfo : FileInfoArray; (3)
ListItem : TListItem;

Три одинаковых идентификатора !

>Малограмотный
И ещё :
SearchInDir ("C:\", "*.*", faAnyFile, -1, FileInfo, 0)

Так нельзя ! Нужна переменная поскольку
CurrentLength имеет модификатор var

← →
Малограмотный (2002-08-01 15:29) [14]

За подсказку про CurrentLength - спасибо огромное. Теперь всё работает.

Вопрос чайника Найти похожие ветки