Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.08.15;
Скачать: [xml.tar.bz2];

Вниз

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

 
Малограмотный   (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;


 
Skier   (2002-08-01 15:07) [11]

>Anatoly Podgoretsky

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


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


 
Skier   (2002-08-01 15:12) [12]

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

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;

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


 
Skier   (2002-08-01 15:20) [13]

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

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


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

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



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.08.15;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.48 MB
Время: 0.009 c
1-48195
Evyshka
2002-08-02 15:54
2002.08.15
Kernel32.dll


3-48012
cooluser
2002-07-28 08:59
2002.08.15
Просмтор содержимого БД. TListView


14-48319
Alexandr
2002-07-11 12:43
2002.08.15
Блондинка за рулем


1-48166
Sub
2002-08-02 11:45
2002.08.15
Базы данных. Отчеты.


1-48113
malamba
2002-08-05 09:43
2002.08.15
Как уведомить клиентов об изменении базы





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский