Всплывающие подсказки Проводника

Если вы разбираетесь в программировании (C++ Builder, Delphi), возможно вы сможете помочь в устранении проблемных мест в программе

Модератор: motyara

Закрыто
Аватара пользователя
Max Diesel
Автор программы
Сообщения: 3431
Зарегистрирован: Пт окт 12, 2007 3:26 pm
Контактная информация:

Всплывающие подсказки Проводника

Сообщение Max Diesel »

Разыскивается код на Delphi/C++Builder, позволяющий получить у системы информацию о файле, отображаемую в подсказке Проводника:
tooltip.gif
tooltip.gif (6.51 КБ) 3850 просмотров
Буду очень признателен за конкретную помощь в этом вопросе.
admini
Охотник за багами
Сообщения: 21
Зарегистрирован: Чт фев 26, 2009 11:04 pm

Re: Всплывающие подсказки Проводника

Сообщение admini »

Код: Выделить всё

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;
...
Аватара пользователя
Max Diesel
Автор программы
Сообщения: 3431
Зарегистрирован: Пт окт 12, 2007 3:26 pm
Контактная информация:

Сообщение Max Diesel »

Я просто поражен, это действительно именно то что я так долго пытался найти/сделать. Огромное спасибо. Наконец программа обретет системные подсказки.
admini
Охотник за багами
Сообщения: 21
Зарегистрирован: Чт фев 26, 2009 11:04 pm

Re: Всплывающие подсказки Проводника

Сообщение admini »

Только что напоролся. Тестировал код на Windows 7 и Vista. Всё работало. Скомпилированную программу попытался запустить в Windows XP - функция отработала без ошибок но tipInfo вернул nil. Минут 20 думал в чем дело. Оказывается забыл CoInitializeEx. Вставил код

Код: Выделить всё

CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
при запуске формы и всё заработало. CoInitializeEx надо вызывать для каждого потока, в контексте которого будет выполняться QueryShlObjInfo. Это на всякий случай информация.
Аватара пользователя
Max Diesel
Автор программы
Сообщения: 3431
Зарегистрирован: Пт окт 12, 2007 3:26 pm
Контактная информация:

Сообщение Max Diesel »

Спасибо, учту.
Закрыто