Форум: "WinAPI";
Текущий архив: 2007.11.18;
Скачать: [xml.tar.bz2];
Вниз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 вся ветка
Форум: "WinAPI";
Текущий архив: 2007.11.18;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.046 c