Всплывающие подсказки Проводника
Модератор: motyara
-
- Автор программы
- Сообщения: 3432
- Зарегистрирован: Пт окт 12, 2007 3:26 pm
Всплывающие подсказки Проводника
Разыскивается код на Delphi/C++Builder, позволяющий получить у системы информацию о файле, отображаемую в подсказке Проводника:
Буду очень признателен за конкретную помощь в этом вопросе.
У вас нет необходимых прав для просмотра вложений в этом сообщении.
-
- Охотник за багами
- Сообщения: 21
- Зарегистрирован: Чт фев 26, 2009 11:04 pm
Re: Всплывающие подсказки Проводника
Код: Выделить всё
uses
ActiveX, ShlObj, ShLwApi;
function QueryShlObjInfo(filePath: PWideChar; var tipInfo: PWideChar): Boolean;
const
IID_IQueryInfo: TGUID = (
D1:$00021500;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
QITIPF_DEFAULT = $00000000;
QITIPF_USENAME = $00000001;
QITIPF_LINKNOTARGET = $00000002;
QITIPF_LINKUSETARGET = $00000004;
QITIPF_USESLOWTIP = $00000008;
var
pathBuf: PWideChar;
desktopFolder, folder: IShellFolder;
folderID, fileID: PItemIDList;
queryInfo: IQueryInfo;
begin
Result := False;
if not PathFileExistsW(filePath) then Exit;
GetMem(pathBuf, (lstrlenW(filePath) + 1) shl 1);
try
lstrcpyW(pathBuf, filePath);
StrTrimW(pathBuf, '\');
PathRemoveFileSpecW(pathBuf);
SHGetDesktopFolder(desktopFolder);
if not Assigned(desktopFolder) then Exit;
try
desktopFolder.ParseDisplayName(0, nil,
pathBuf, PULONG(nil)^, folderID, PULONG(nil)^);
if not Assigned(folderID) then Exit;
try
desktopFolder.BindToObject(folderID, nil, IID_IShellFolder, folder);
if not Assigned(folder) then Exit;
try
lstrcpyW(pathBuf, PathFindFileNameW(filePath));
StrTrimW(pathBuf, '\');
folder.ParseDisplayName(0, nil,
pathBuf, PULONG(nil)^, fileID, PULONG(nil)^);
if not Assigned(fileID) then Exit;
try
folder.GetUIObjectOf(0, 1, fileID, IID_IQueryInfo, nil, queryInfo);
if not Assigned(queryInfo) then Exit;
try
queryInfo.GetInfoTip(QITIPF_USESLOWTIP, tipInfo);
finally
queryInfo := nil;
end;
finally
CoTaskMemFree(fileID);
end;
finally
folder := nil;
end;
finally
CoTaskMemFree(folderID);
end;
finally
desktopFolder := nil;
end;
finally
FreeMem(pathBuf);
end;
Result := True;
end;
...
var
fileInfo: PWideChar;
begin
if QueryShlObjInfo('C:\autoexec.bat', fileInfo) then
begin
MessageBoxW(Handle, fileInfo, '', MB_OK);
CoTaskMemFree(fileInfo);
end;
...
-
- Автор программы
- Сообщения: 3432
- Зарегистрирован: Пт окт 12, 2007 3:26 pm
-
- Охотник за багами
- Сообщения: 21
- Зарегистрирован: Чт фев 26, 2009 11:04 pm
Re: Всплывающие подсказки Проводника
Только что напоролся. Тестировал код на Windows 7 и Vista. Всё работало. Скомпилированную программу попытался запустить в Windows XP - функция отработала без ошибок но tipInfo вернул nil. Минут 20 думал в чем дело. Оказывается забыл CoInitializeEx. Вставил код при запуске формы и всё заработало. CoInitializeEx надо вызывать для каждого потока, в контексте которого будет выполняться QueryShlObjInfo. Это на всякий случай информация.
Код: Выделить всё
CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
-
- Автор программы
- Сообщения: 3432
- Зарегистрирован: Пт окт 12, 2007 3:26 pm