Текущий архив: 2007.11.18;
Скачать: CL | DM;

Вниз

IShellFolder незакрытые хендлеры   Найти похожие ветки 

← →
P   (2007-05-11 18:07) [0]

При выполнении вот этого кода остаются незакрытые хендлеры (по TaskManager) , до полного завершения программы. Где здесь что-то не очищается? Бред какой-то.

// Delphi
// Delphi

program ShellA;

// Это консольное приложение печатает на стандартный вывод дерево папок
// основного пространства имён оболочки Windows.

uses
 Windows, ActiveX, ShlObj;

{$APPTYPE CONSOLE}

// Эта процедура производит вывод строки, попутно
// конвертируя её из кодировки ANSI в кодировку OEM.
procedure WriteStr(s: string);
begin
 UniqueString( s );
 CharToOemBuff( PChar(s), PChar(s), Length(s) );
 Write(s);
end;

// Эта процедура производит вывод указанного
// количества символов, попутно конвертируя их из кодировки ANSI
// в кодировку OEM.
procedure WriteChars(Ch: char; Count: Integer);
var
 s: string;
begin
 CharToOemBuff( @Ch, @Ch, 1 );
 s := StringOfChar(Ch, Count);
 Write( s );
end;

// Эта процедура производит вывод строки, попутно
// конвертируя её из кодировки ANSI в кодировку OEM.
// Эта процедура также добавляет перевод каретки по окончании вывода.
procedure WritelnStr(const s: string);
begin
 WriteStr( s + #13#10 );
end;

var
 pMalloc: IMalloc;
 hr: HRESULT;

// Эта процедура интерпретирует содержание структуры STRRET.
// Также она освобождает временные буфера при необходимости, так что
// для её корректной работы требуется наличие объекта pMalloc.
function GetDisplayName( pidl: PItemIDList; const Value: STRRET ): string;
begin
 with Value do
 case uType of
   STRRET_CSTR: Result := PChar(@cStr[0]);
   STRRET_WSTR:
   begin
     Result := pOleStr;
     pMalloc.Free( pOleStr );
   end;
   STRRET_OFFSET: Result := PChar( LongWord(pidl) + uOffset );
 end;
end;

var
 Level: Integer;

// Основная процедура выполняет рекурсивный просмотр структуры папок, начиная с данной.
// Она выводит имена элементов, попутно отслеживая отступы.
procedure ShowFolder(folder: IShellFolder);
var
 pidlChild: PItemIDList;
 Value: STRRET;
 Iterator: IEnumIDList;
 celtFetched: ULONG;
 child: IShellFolder;
begin
 hr := folder.EnumObjects( 0 (* no owner window *), SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN, Iterator );
 if Succeeded( hr ) then
 try
   Inc(Level);
   while true do
   begin
     hr := Iterator.Next( 1, pidlChild, celtFetched );
     if hr <> NOERROR then Break;
     try
       hr := folder.GetDisplayNameOf( pidlChild, SHGDN_INFOLDER or SHGDN_INCLUDE_NONFILESYS, Value );
       if Succeeded( hr ) then
       begin
         WriteChars( " ", Level );
         WritelnStr( GetDisplayName( pidlChild, Value ) );
       end;
       hr := folder.BindToObject( pidlChild, nil, IID_IShellFolder, Pointer(child) );
       if Succeeded( hr ) then
       try
         //ShowFolder( child );
       finally
         child := nil;
       end;
     finally
       pMalloc.Free( pidlChild );
     end;
   end;
   Dec(Level);
 finally
   Iterator := nil;
 end;
end;

var
 desktop: IShellFolder;
 mkid: SHITEMID;
 pidlItself: PItemIDList;
 Value: STRRET;

// Основное тело программы выполняет необходимую инициализацию, затем
// восстанавливает имя корневой папки, выводит его, и обращается к ShowFolder для выполнения рекурсии.
begin
 readln;

 Level := 0;
 mkid.cb := 0;
 pidlItself := @mkid; // This pidl now points to an empty Identifier List. It is points to owner folder itself.
                      // NB: It works only for a root folder!
 hr := CoInitializeEx( nil, COINIT_APARTMENTTHREADED );
 if Succeeded( hr ) then
 try
   hr := SHGetMalloc( pMalloc );
   if Succeeded( hr ) then
   try
     hr := SHGetDesktopFolder( desktop );
     if Succeeded( hr ) then
     try
       hr := desktop.GetDisplayNameOf( pidlItself, SHGDN_NORMAL or SHGDN_INCLUDE_NONFILESYS, Value );
       if Succeeded( hr ) then
       begin
         WritelnStr( GetDisplayName( pidlItself, Value ) );
       end;
       ShowFolder( desktop );
     finally
       desktop := nil;
     end;
   finally
     pMalloc := nil;
   end;
 finally
   CoUninitialize;
 end;
 //вот здесь остаются незакрытые хендлеры
 readln;
end.


---

← →
P   (2007-05-13 17:51) [1]

Переделал на вот такое. Утечка происходит только если инициализировать COINIT_APARTMENTTHREADED

При других
COINIT_MULTITHREADED = 0x0,
COINIT_DISABLE_OLE1DDE = 0x4,
COINIT_SPEED_OVER_MEMORY = 0x8,
Утечки нет.

Но интерфейс виртуальных папок нормально поддерживает только COINIT_APARTMENTTHREADED в других случаях рекурсивный обход виснет.

program testShell;

{$APPTYPE CONSOLE}

uses Windows, ActiveX, ShlObj;

procedure TestShellProc;
begin
 CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
 try

 finally
   CoUninitialize;
 end;
end;

begin
 writeln("Press start...");
 readln;

 TestShellProc;

 writeln("Press to end");
 readln;
end.

Так что это очередная багофича винды :(

---

← →
umbra ©   (2007-05-14 11:02) [2]

> При выполнении вот этого кода остаются незакрытые хендлеры

кто такие эти "хендлеры"? Если это дескрипторы окон (хэндлы :)), то так и должно быть, поскольку при использовании  однопоточного апартамента (COINIT_APARTMENTTHREADED) СОМ создает служебные окна для передачи данных с помощью оконных сообщений. Эти окна уничтожаются после вызова  CoUninitialize.

---

← →
P   (2007-05-14 14:19) [3]

> umbra ©   (14.05.07 11:02) [2]
>
>
> > При выполнении вот этого кода остаются незакрытые хендлеры
>
> кто такие эти "хендлеры"? Если это дескрипторы окон (хэндлы
> :)), то так и должно быть, поскольку при использовании  
> однопоточного апартамента (COINIT_APARTMENTTHREADED) СОМ
> создает служебные окна для передачи данных с помощью оконных
> сообщений. Эти окна уничтожаются после вызова  CoUninitialize.
>


В том то и дело, что не уничтожаются.

---

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

Текущий архив: 2007.11.18;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.019 c