Удаление содержимого каталога

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: demon-777

WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Удаление содержимого каталога

Зависимости: Windows, SysUtils, Classes, Masks

Автор: demon-777, demon-777@yandex.ru, Питер

Copyright: Dimka Maslov

Дата: 26 мая 2002 г.

***************************************************** }

procedure DeleteFiles(Path: string);

var

Mask: string;

SearchRec: TSearchRec;

FindResult: Integer;

List: TStringList;

i: Integer;

begin

Mask := ExtractFileName(Path);

if Mask = » then

Mask := ‘*.*’;

Path := ExtractFilePath(Path);

if Path = » then

Path := IncludeTrailingBackslash(GetCurrentDir);

List := TStringList.Create;

try

FindResult := FindFirst(Path ‘*.*’, faAnyFile, SearchRec);

try

while FindResult = 0 do

with SearchRec do

begin

if ((Attr and faDirectory) = 0) and MatchesMask(Name, Mask) then

List.Add(Name);

FindResult := FindNext(SearchRec);

end;

for i := 0 to List.Count — 1 do

DeleteFile(Path List[i]);

finally

FindClose(SearchRec);

end;

finally

List.Free;

end;

end;

{/codecitation}

Удаление непустого каталога вместе с подкаталогами

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Lipskiy

WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Удаление непустого каталога вместе с подкаталогами

Удаление подкаталогов рекурсивное — функция вызывает саму себя.

Описание назначения агрументов:

-DeleteAllFilesAndFolder — если TRUE то функцией будут предприняты

попытки для установки атрибута faArchive любому файлу или папке

перед его(её) удалением;

-StopIfNotAllDeleted — если TRUE то работа функции моментально

прекращается если возникла ошибка удаления хотя бы одного файла или папки;

-RemoveRoot — если TRUE, указывает на необходимость удаления корня.

Зависимости: FileCtrl, SysUtils

Автор: lipskiy, lipskiy@mail.ru, ICQ:51219290, Санкт-Петербург

Copyright: Собственное написание (lipskiy)

Дата: 26 апреля 2002 г.

***************************************************** }

function FullRemoveDir(Dir: string; DeleteAllFilesAndFolders,

StopIfNotAllDeleted, RemoveRoot: boolean): Boolean;

var

i: Integer;

SRec: TSearchRec;

FN: string;

begin

Result := False;

if not DirectoryExists(Dir) then

exit;

Result := True;

// Добавляем слэш в конце и задаем маску — «все файлы и директории»

Dir := IncludeTrailingBackslash(Dir);

i := FindFirst(Dir ‘*’, faAnyFile, SRec);

try

while i = 0 do

begin

// Получаем полный путь к файлу или директорию

FN := Dir SRec.Name;

// Если это директория

if SRec.Attr = faDirectory then

begin

// Рекурсивный вызов этой же функции с ключом удаления корня

if (SRec.Name ») and (SRec.Name ‘.’) and (SRec.Name ‘..’) then

begin

if DeleteAllFilesAndFolders then

FileSetAttr(FN, faArchive);

Result := FullRemoveDir(FN, DeleteAllFilesAndFolders,

StopIfNotAllDeleted, True);

if not Result and StopIfNotAllDeleted then

exit;

end;

end

else // Иначе удаляем файл

begin

if DeleteAllFilesAndFolders then

FileSetAttr(FN, faArchive);

Result := SysUtils.DeleteFile(FN);

if not Result and StopIfNotAllDeleted then

exit;

end;

// Берем следующий файл или директорию

i := FindNext(SRec);

end;

finally

SysUtils.FindClose(SRec);

end;

if not Result then

exit;

if RemoveRoot then // Если необходимо удалить корень — удаляем

if not RemoveDir(Dir) then

Result := false;

end;

Пример использования:

FullRemoveDir(‘C:\a’, true, true, true);

// Полное удаление папки C:\a со всем её содержимым,

// и с последующим удалением самой c:\a

{/codecitation}

Сокращенное имя каталога

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Есть имя каталога:

c:\windows\media\temp\abc\sound\chime.wav

Мне необходима сокращенная запись, такая как

c:\windows\..\sound\chime.wav

а не полный путь к файлу.

Есть ли простой способ для этого?

Я разработал процедуру, которая делает нечто похожее. Она сокращает имя каталога, когда он и текущий путь имеют в корне тот же диск и/или часть пути, совпадающие вначале. Полученный результат (сокращенная запись) действительно легче для восприятия. Я производил кодирование в шестнадцатиричном редакторе в Borland Pascal и некоторое время не использовал. Я не думаю, что данный код может быть несовместим с последними версиями Delphi.

function shortenfilename(s: string): string;

var

drive, curdrive: string[2];

dir, curdir: string[80];

name: string[20];

ext: string[5];

i: byte;

begin

for i := 1 to length(s) do

s[i] := upcase(s[i]);

s := fexpand(s);

fsplit(s, dir, name, ext);

drive := copy(dir, 1, 2);

dir := copy(dir, 4, length(dir) — 3);

getdir(0, curdir);

curdrive := copy(curdir, 1, 2);

curdir := copy(curdir, 4, length(curdir) — 3) ‘\’;

if drive = curdrive then

begin

if copy(dir, 1, length(curdir)) = curdir then

begin

i := length(curdir);

if length(dir) i then

dir := dir ‘\’;

shortenfilename := copy(dir, i 1, length(dir) — i — 1) name ext;

end

else

shortenfilename := copy(s, 3, length(s) — 2);

end

else

shortenfilename := s;

end;

{/codecitation}

Создание указанного пути

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: VID

WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****

>> Создание указанного пути

Функция CreateDirEx создаёт указанный путь DIR. В отличии от функции CreateDir,

для CreateDirEx нет необходимости существования каталога, в которому будет

размещаться создаваемый новый каталог.

Т.е., пусть существует путь

C:\Folder

Нам надо создать путь C:\Folder\Level1\Level2

При использовании CreateDir пришлось бы дважды вызывать эту функцию, сначала

для создания C:\Folder\Level1\ а затем для C:\Folder\Level1\Level2.

В случае работы с функцией CreateDirEx ей достаточно лишь передать параметр:

CreateDirEx(‘C:\Folder\Level1\Level2’) и необходимый путь будет создан,

в независимости от того существовала вообще ли до этого папка C:\Folder

Зависимости: FileCtrl, SysUtils

Автор: VID, snap@iwt.ru, ICQ:132234868, Махачкала

Copyright: VID

Дата: 28 января 2003 г.

***************************************************** }

function CreateDirEx(Dir: string): Boolean;

var

I, L: Integer;

CurDir: string;

begin

if ExcludeTrailingBackslash(Dir) = » then

exit;

Dir := IncludeTrailingBackslash(Dir);

L := Length(Dir);

for I := 1 to L do

begin

CurDir := CurDir Dir[I];

if Dir[I] = ‘\’ then

begin

if not DirectoryExists(CurDir) then

if not CreateDir(CurDir) then

Exit;

end;

end;

Result := True;

end;

Пример использования:

CreateDirEx(AnyFolderName),

// где AnyFolderName — любой допустимый в файловой системе путь.

{/codecitation}

Создание каталога

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Оформил: DeeCo

Автор: http://www.swissdelphicenter.ch

uses

Dialogs;

begin

{$I-}

MkDir(‘c:\windows’);

{$I }

if IOResult 0 then

MessageDlg(‘Cannot Create Directory/Verzeichnis kann nicht angelegt werden!’,

mtWarning, [mbOK], 0)

else

MessageDlg(‘Directory Created/Neues Verzeichnis angelegt.’, mtInformation, [mbOK], 0);

end;

{/codecitation}

Следить за изменениями в каталоге

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: FliNT

Использование ReadDirectoryChangesW

Очень хорошая функция, только » Windows 95/98/Me: Unsupported» . Т.е. в Win9x этой функции нет. Но мы же пишем для NT, а там с этой функцией все в порядке (если 3-ий сервис пак для NT3.1 поставили :)))

Кратко пройдемся по описанию функции (взято из windows

function ReadDirectoryChangesW(

hDirectory: THandle; // описатель каталога, за которым надо следить

lpBuffer: Pointer; // Указатель на буфер, в который будет записана информация

nBufferLength: DWORD; // Размер буфера

bWatchSubtree: Bool; // Следить ли за подкаталогами

dwNotifyFilter: DWORD; // Фильтр действий

lpBytesReturned: LPDWORD; // Сколько было записано в буфер

lpOverlapped: POverlapped; // Для асинхронной работы

lpCompletionRoutine: FARPROC // Функция, которая будет вызвана при окончании операции

): BOOL; stdcall;

Ну а теперь пример работы этой функции (исходник этого примера (пока без комментариев!! и на Delphi6) можно скачать здесь)

Чтобы программа могла нормально работать во время ожидания очередного изменения, мы функции мониторинга выделим отдельный поток. Поток » сделан» на WinAPI (функция WorkThread). При нажатии на одну кнопку он будет создаваться, а на другую — жестоко уничтожаться. Вся полезная информация будет выводиться в TListView.

Функция потока будет описана так:

procedure WorkThread(LV: TListView); stdcall;

LV — это то, во что мы будем выводить инфу. И не забывайте stdcall;

А вот ее текст:

procedure WorkThread(LV : TListView);stdcall;

var

hDir : THandle;

lpBuf : Pointer;

Ptr : Pointer;

cbReturn : Cardinal;

FileName : PWideChar;

Item : TListItem;

sTime : _SYSTEMTIME;

begin

// Сначала нам надо получить описатель каталога, за которым мы будем следить

// В данном примере это будет весь диск C:

hDir := CreateFile (‘C:\’,GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE

or FILE_SHARE_DELETE,nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0);

// Если ошиблись…

if hDir = INVALID_HANDLE_VALUE

then begin ShowMessage(SysErrorMessage(GetLastError)); exit; end;

// Выделяем память под буфер

// const BUF_SIZE = 2048 — думаю вполне достаточно

GetMem(lpBuf,BUF_SIZE);

repeat

// очищаем память перед записью в нее (на всякий случай)

ZeroMemory(lpBuf,BUF_SIZE);

// Теперь мы будем ждать пока чего-нибудь в интересующем нас каталоге

// изменится или произойдет ошибка (и мы выйдем из цикла)

// FILE_NOTIFY_CHANGE — это список флагов — о них ниже.

if not ReadDirectoryChangesW(hDir,lpBuf,BUF_SIZE,true,

FILE_NOTIFY_CHANGE,@cbReturn,nil,nil)

then Break;

// Сюда мы попадаем, если функция выполнилась успешно

// и lpBuf указывает на одну или несколько структур FILE_NOTIFY_INFORMATION

Ptr:=lpBuf;

Отойдем пока от исходного кода и рассмотрим, что у нас появится в буфере. В данный момент lpBuf и Ptr указывают на первую структуру FILE_NOTIFY_INFORMATION. Вторым полем этой структуры является — Action -тип действия, которое было совершено. Четвертым — FileName — первый символ имени файла. Имя файла не заканчивается нулем #0 и для определения его длины используется 3 параметр — FileNameLength. При этом надо учесть, что имя файла в формате Unicode т.е. каждый символ занимает 2 байта, а FileNameLength дается в байтах. Придется эту длину делить на 2, чтобы узнать кол-во символов.

Но возникает вопрос — как узнать, сколько таких структур было записано в буфер. Для этого используется 1 параметр структуры — NextEntryOffset. Если он не равен нулю, то в нем будет кол-во байт, через которые находится следующая запись и нам надо сдвинуть указатель на это кол-во байт, чтобы » получить» следующую структуру. И так далее, пока NextEntryOffset не будет равен 0 (т.е. эта запись была последней).

repeat

// Добавляем новый элемент в TListView (ViewStyle = vsReport )

Item := LV.Items.Add;

// Выделяем память под имя файла

GetMem(FileName,PFileNotifyInformation(Ptr).FileNameLength 2);

// Очищаем память — чтобы последним символом после копирования

// был бы #0 нуль

ZeroMemory(FileName,PFileNotifyInformation(Ptr).FileNameLength 2);

// WinAPI функция для копирования Unicode строки

lstrcpynW(FileName,PFileNotifyInformation(Ptr).FileName,

PFileNotifyInformation(Ptr).FileNameLength div 2 1);

// Имя файла у нас дается относительно папки

// т.е.если изменится файл C:\File\test.dat, то FileName

// будет равно File\test.dat

Item.Caption:=’C:\’ FileName;

// Имя файла нам больше не нужно — очищаем память

FreeMem(FileName);

// Определяем тип произошедшего действия

case PFileNotifyInformation(Ptr).Action of

FILE_ACTION_ADDED : Item.SubItems.Add(‘Файл был создан’);

FILE_ACTION_REMOVED : Item.SubItems.Add(‘Файл был удален’);

FILE_ACTION_MODIFIED : Item.SubItems.Add(‘Файл был изменен’);

FILE_ACTION_RENAMED_OLD_NAME :

Item.SubItems.Add(‘Файл был переименован и в имени файла — предыдущее имя’);

FILE_ACTION_RENAMED_NEW_NAME :

Item.SubItems.Add(‘новое имя после переименования’);

else Item.SubItems.Add(‘Произошло что-то странное’);

end;

// Время, когда произошло событие

GetLocalTime(sTime);

with sTime do

Item.SubItems.Add(Format(‘%.2d:%.2d:%.2d’,[wHour,wMinute,wSecond])); // 13:54:20

// Если эта запись не последняя (NextEntryOffset 0), то…

if PFileNotifyInformation(Ptr).NextEntryOffset=0

then Break

else begin

// … добавляем строку в примечания (если интересно посмотреть смещение)

Item.SubItems.Add(‘Offset : ‘

IntToStr(PFileNotifyInformation(Ptr).NextEntryOffset));

//Передвигаем указатель на NextEntryOffset байт вперед

Inc(Cardinal(Ptr),PFileNotifyInformation(Ptr).NextEntryOffset);

// Теперь Ptr указывает на следующую запись

end;

// Передвигать надо именно Ptr, а не lpBuf

until false;

until false;

// Очищаем память

FreeMem(lpBuf);

end;

Параметр функции dwNotifyFilter — действия, информацию о которых мы хотим получать.

FILE_NOTIFY_CHANGE_FILE_NAME — создание, удаление, переименование файла.

FILE_NOTIFY_CHANGE_DIR_NAME — созданием и удаление каталога.

FILE_NOTIFY_CHANGE_ATTRIBUTES — изменение атрибутов файла.

FILE_NOTIFY_CHANGE_SIZE — изменение размера файла.

FILE_NOTIFY_CHANGE_LAST_WRITE — изменение файла (это и предыдущее уведомление будет получено только в момент реальной записи файла на диск).

FILE_NOTIFY_CHANGE_LAST_ACCESS — изменение времени последнего доступа.

FILE_NOTIFY_CHANGE_CREATION — изменение времени создания файла.

FILE_NOTIFY_CHANGE_SECURITY — изменение параметров безопасности (прав доступа и т.д.)

У меня в примере используются FILE_NOTIFY_CHANGE_FILE_NAME, FILE_NOTIFY_CHANGE_DIR_NAME и FILE_NOTIFY_CHANGE_LAST_WRITE.

А теперь надо только запустить поток.

procedure TForm1.Button1Click(Sender: TObject);

var

ThID : Cardinal;

begin

// hThread — THandle — глобальная переменная

// Создаем поток

// LV — TListView, WorkThread — функция выше

hThread:=CreateThread(nil,0,@WorkThread,LV,0,ThID);

// В случае неудачи выводим сообщение

if hThread=0 then ShowMessage(SysErrorMessage(GetLastError));

end;

У меня в исходниках поток останавливается функцией TerminateThread(hThread,Cardinal(-1)). Но при таком завершении не будут освобождены все ресурсы, занятые потоком (а это как минимум BUF_SIZE байт памяти. Вместо этой функции было бы лучше использовать SuspendThread(hThread), а при запуске проверять на существование потока WaitForSingleObject(hThread,0)= WAIT_TIMEOUT и если он существует — делать ResumeThread(hThread)… но в исходниках этого пока нет 🙂

{/codecitation}

Скопировать, удалить, переместить всю директорию

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

uses

ShellApi;

function CopyDir(const fromDir, toDir: string): Boolean;

var

fos: TSHFileOpStruct;

begin

ZeroMemory(@fos, SizeOf(fos));

with fos do

begin

wFunc := FO_COPY;

fFlags := FOF_FILESONLY;

pFrom := PChar(fromDir #0);

pTo := PChar(toDir)

end;

Result := (0 = ShFileOperation(fos));

end;

function MoveDir(const fromDir, toDir: string): Boolean;

var

fos: TSHFileOpStruct;

begin

ZeroMemory(@fos, SizeOf(fos));

with fos do

begin

wFunc := FO_MOVE;

fFlags := FOF_FILESONLY;

pFrom := PChar(fromDir #0);

pTo := PChar(toDir)

end;

Result := (0 = ShFileOperation(fos));

end;

function DelDir(dir: string): Boolean;

var

fos: TSHFileOpStruct;

begin

ZeroMemory(@fos, SizeOf(fos));

with fos do

begin

wFunc := FO_DELETE;

fFlags := FOF_SILENT or FOF_NOCONFIRMATION;

pFrom := PChar(dir #0);

end;

Result := (0 = ShFileOperation(fos));

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if cCopyDir(‘d:\download’, ‘e:\’) = True then

ShowMessage(‘Directory copied.’);

end;

{/codecitation}

Рекурсивный проход дерева каталогов

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Vit

WEB-сайт: http://forum.vingrad.ru

procedure ScanDir(Dir: string);

var

SearchRec: TSearchRec;

begin

if Dir » then

if Dir[length(Dir)] ‘\’ then

Dir := Dir ‘\’;

if FindFirst(Dir ‘*.*’, faAnyFile, SearchRec) = 0 then

repeat

if (SearchRec.name = ‘.’) or (SearchRec.name = ‘..’) then

continue;

if (SearchRec.Attr and faDirectory) 0 then

ScanDir(Dir SearchRec.name)

//we found Directory: «Dir SearchRec.name»

else

Showmessage(Dir SearchRec.name);

//we found File: «Dir SearchRec.name»

until

FindNext(SearchRec) 0;

FindClose(SearchRec);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ScanDir(‘c:’);

end;

{/codecitation}

Работа с директориями в Delphi

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Михаил Христосенко

WEB сайт: http://mihandelphi.narod.ru

После сытного завтрака муж уселся перед компьютером и окунулся в интернетовские порносайты.

— Ты что?! — удивилась жена. — Не идёшь сегодня на работу?

— Ой, господи! А я решил, что уже давно там…

В этой статье я постараюсь познакомить Вас с некоторыми стандартными функциями для работы с директориями. И еще приведу несколько пользовательских функций и примеры их использования. Также рассмотрен вопрос вызова диалога выбора директории.

Для начала начнем с простой функции для создания новой папки. Общий вид функции такой:

function CreateDir(const Dir: string): Boolean;

То есть если папка успешно создана функция возвращает true. Сразу же простой пример ее использования:

procedure TForm1.Button1Click(Sender: TObject);

begin

if createdir(‘c:\TestDir’) = true then

showmessage(‘Директория успешно создана’)

else

showmessage(‘При создании директории произошла ошибка’);

end;

При нажатии на кнопку программа пытается создать папку с именем TestDir на диске C: и если попытка увенчалась успехом, то выводится соответствующее сообщение. Следует отметить, что если вы не указываете имя диска, на котором хотите создавать папку, то функция будет создавать папку в той же директории, где находится сама программа.

Объявления:

createdir(edit1.text);

и

createdir(extractfilepath(paramstr(0)) edit1.text);

приведут к одному и тому же результату.

Теперь рассмотрим функцию для удаления папок. Ее объявление выглядит так:

function RemoveDir(const Dir: string): Boolean;

Сразу же хочу предупредить, что данная функция способна удалять только пустые папки, и если там что-нибудь будет, то произойдет ошибка! Но выход есть!!! Здесь нам на помощь придет пользовательская функция с простым названием MyRemoveDir. Вот описание функции:

function MyRemoveDir(sDir: string): Boolean;

var

iIndex: Integer;

SearchRec: TSearchRec;

sFileName: string;

begin

Result := False;

sDir := sDir ‘\*.*’;

iIndex := FindFirst(sDir, faAnyFile, SearchRec);

while iIndex = 0 do

begin

sFileName := ExtractFileDir(sDir) ‘\’ SearchRec.name;

if SearchRec.Attr = faDirectory then

begin

if (SearchRec.name » ) and

(SearchRec.name ‘.’) and

(SearchRec.name ‘..’) then

MyRemoveDir(sFileName);

end

else

begin

if SearchRec.Attr faArchive then

FileSetAttr(sFileName, faArchive);

if not DeleteFile(sFileName) then

ShowMessage(‘Could NOT delete ‘ sFileName);

end;

iIndex := FindNext(SearchRec);

end;

FindClose(SearchRec);

RemoveDir(ExtractFileDir(sDir));

Result := True;

end;

Копируете это все в Вашу программу, а затем эту функцию можно вызвать например так:

if not MyRemoveDir(‘C:\TestDir’) then

ShowMessage(‘Не могу удалить эту директорию’);

Теперь маленько отстранимся от непосредственной работы с папками и рассмотрим волнующий многих вопрос. Как вызвать диалог выбора папки (как при установке программ)?? ПРОСТО!!!

Подключаем в uses модуль Filectrl.pas (то есть uses FileCtrl;). Теперь ставим на форму еще кнопочку (чтобы не путаться 🙂 и пишем такой код:

procedure TForm1.Button3Click(Sender: TObject);

const

SELDIRHELP = 1000;

var

Dir: string;

begin

Dir := ‘C:\windows’;

if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then

Caption := Dir;

end;

При выборе директории в заголовке формы отобразиться ее название!

Теперь рассмотрим следующую процедуру. К примеру Вам надо создать папку Dir1 по адресу: C:\MyDir\Test\Dir1, но при этом папок MyDir и Test на Вашем компьютере не существует. Функция CreateDir здесь не сработает, поэтому воспользуемся процедурой ForceDirectories. Ее общий вид таков:

procedure ForceDirectories(Dir: string);

Пример ее использования (как всегда я поставил на форму новую кнопку, а там написал)

procedure TForm1.Button4Click(Sender: TObject);

var

Dir: string;

begin

Dir := ‘C:\MyDir\Test\Dir1’;

ForceDirectories(Dir);

end;

Ну и напоследок приведу функцию для проверки: существует ли директория или нет. Ее общий вид такой:

function DirectoryExists(name: string): Boolean;

Если директория указанная в параметре Name существует — то функция возвратит true.

Надеюсь, что помог Вам описанием данных функций и процедур. Сразу хочется дать совет: почаще заглядывайте в HELP, там много интересной и полезной информации!

{/codecitation}

Путь и Имя папки My Computer

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Раздолбил как-то компьютерный вирус очередной винчестер и на обломках написал: знание — страшная сила.

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

Операционная система windows 32 основывается на оболочке, которая использует виртуальные папки, такие, как ‘my computer’ (Мой компьютер), ‘desktop’ (Рабочий Стол) и ‘recycle bin’ (Корзина). Некоторые из них являются частью физической файловой системы. Другими словами, они имеют соответствующий реальный каталог в файловой системе. Это относится, например, к системным папкам ‘desktop’ и ‘recycle bin’. Данные каталоги могут быть использованы как InitialDir в TOpenDialog, но сначала вы должны получить их физическое месторасположение, которое может различаться на других компьютерах. Чтобы узнать их реальное месторасположение на локальном диске, вы должны воспользоваться некоторыми специальными вызовами API (смотри пример ниже). Другие папки, типа ‘my computer’ и ‘printers’ не являются частью файловой системы, они чисто виртуальные. Обращаю ваше внимание на то, что такие папки можно использовать в TOpenDialog, но никак не в InitialDir.

Виртуальные папки (я немного упрощаю) имеют тип SHITEMID (идентификатор элемента). Получить к ним доступ можно используя pointers to item identifiers list (PIDL, указатель на элемент списка идентификаторов). Для того, чтобы получить PIDL специальной папки, вы должны использовать функцию SHGetSpecialFolder. Физическое месторасположение соответствующей директории можно получить, передавая PIDL в качестве входного параметра функции GetPathFromIDList. Если папка является частью файловой системы, функция возвращает путь к ней в виде строки (которая впоследствии может использоваться как InitialDir). Но если вы хотите использовать OpenDialog только с виртуальными папками (например, с ‘my computer’), то в принципе вы должны использовать PIDL как InitialDir, но это работать не будет. Я думаю дело в том, что TOpenDialog использует PIDLs только для просмотра, а для InitialDir требуются только реальные (физические) каталоги.

Вот пример, показывающий как получить путь к ‘recent documents’ (последние документы) и использовать его в качестве InitialDir:

procedure TForm1.Button1Click(Sender: TObject);

var

PIDL: Pointer;

Path: LPSTR;

const

CSIDL_RECENT = $0008;

begin

Path := StrAlloc(MAX_PATH);

SHGetSpecialFolderLocation(Handle, CSIDL_RECENT, @PIDL);

// возвращает False если папка не является частью файловой системы

if SHGetPathFromIDList(PIDL, Path) then

begin

OpenDialog1.InitialDir := Path;

OpenDialog1.Execute;

end;

StrDispose(Path);

end;

Я думаю вам необходимо создать класс-оболочку для этих вызовов API. Они располагаются в shell32.dll. Наилучший совет, который я могу дать при изучении этого вопроса — копнуть поглубже файл ShlObj.h. Я также не программирую в C, но почерпнул оттуда немало ценной информации.

Вот некоторые константы, которые вам могут понадобиться:

CSIDL_DESKTOP = $0000;

CSIDL_PROGRAMS = $0002;

CSIDL_CONTROLS = $0003;

CSIDL_PRINTERS = $0004;

CSIDL_PERSONAL = $0005;

CSIDL_STARTUP = $0007;

CSIDL_RECENT = $0008;

CSIDL_SENDTO = $0009;

CSIDL_BITBUCKET = $000a;

CSIDL_STARTMENU = $000b;

CSIDL_DESKTOPDIRECTORY = $0010;

CSIDL_DRIVES = $0011; // Мой компьютер

CSIDL_NETWORK = $0012;

CSIDL_NETHOOD = $0013;

CSIDL_FONTS = $0014;

CSIDL_TEMPLATES = $0015;

{/codecitation}