Как windows получает миниатюры .mp4, jpeg, .png etc

Перед тем как запостить тему на форуме, естественно задал свой вопрос чату gpt.

В моей задаче имеется в виду это:



Искусственный разум предлагает совсем колоритные решения, например запускать для этого ffmpeg.exe:

Код (Text):

1. uses
2.   Windows, SysUtils, ShellAPI;
3.  
4. procedure GenerateThumbnail(const VideoFile: string; const OutputImage: string);
5. begin
6.   // Запуск FFmpeg для генерации миниатюры
7.   ShellExecute(0, 'open', 'ffmpeg.exe', PChar(Format('-i "%s" -ss 00:00:01.000 -vframes 1 "%s"', [VideoFile, OutputImage])), nil, SW_HIDE);
8. end;
9.  
10. procedure TForm1.Button1Click(Sender: TObject);
11. var
12.   VideoFile: string;
13.   ThumbnailFile: string;
14. begin
15.   VideoFile := 'C:\path\to\your\video.mp4'; // Путь к вашему видеофайлу
16.   ThumbnailFile := 'C:\path\to\your\thumbnail.png'; // Путь для сохранения миниатюры
17.   GenerateThumbnail(VideoFile, ThumbnailFile);
18.  
19.   // Теперь вы можете загрузить изображение в TImage
20.   Image1.Picture.LoadFromFile(ThumbnailFile);
21. end;

Или вот:

Код (Text):

1. procedure GetVideoThumbnail(const VideoFile: string; const OutputImage: string);
2. var
3.   WMP: OleVariant;
4. begin
5.   // Создаем экземпляр Windows Media Player
6.   WMP := CreateOleObject('WMPlayer.OCX.7');
7.  
8.   // Загружаем видеофайл
9.   WMP.URL := VideoFile;
10.   Sleep(1000); // Даем время для загрузки файла
11.  
12.   // Получаем миниатюру
13.   try
14.     WMP.Controls.currentPosition := 1; // Позиция в 1 секунду
15.     WMP.Controls.pause; // Пауза для получения миниатюры
16.  
17.     // Сохраняем миниатюру
18.     WMP.currentMedia.GetPicture(OutputImage);
19.   finally
20.     WMP.close; // Закрываем WMP
21.   end;
22. end;
23.  
24. procedure TForm1.Button1Click(Sender: TObject);
25. var
26.   VideoFile: string;
27.   ThumbnailFile: string;
28. begin
29.   VideoFile := 'C:\path\to\your\video.mp4'; // Путь к вашему видеофайлу
30.   ThumbnailFile := 'C:\path\to\your\thumbnail.jpg'; // Путь для сохранения миниатюры
31.   GetVideoThumbnail(VideoFile, ThumbnailFile);
32.  
33.   // Загружаем миниатюру в TImage
34.   Image1.Picture.LoadFromFile(ThumbnailFile);
35. end;

 

А пара минут в отладчике и в регедите привели сюда. Чатгпт как гугл, только еще хуже.

 

Делаю проект в delphi 7.

Получается чтобы получить то же самое надо экспортировать interface/методы из IThumbnailProvider interface? (

Код (Text):

1.  
2. const
3.   CLSID_ThumbnailProvider: TGUID = '{F2F0B0F3-FA54-45C8-BD0E-33D41E6F6B0D}';
4.   IID_IThumbnailProvider: TGUID = '{F1F5D0B1-6DF4-4C87-B20D-7FB3B665C86F}';
5.  
6. type
7.   IThumbnailProvider = interface(IUnknown)
8.     ['{F1F5D0B1-6DF4-4C87-B20D-7FB3B665C86F}']
9.     function GetThumbnail(size: Integer; flags: Cardinal; out hBitmap: HBITMAP): HResult; stdcall;
10.   end;
11. type
12.   IShellItem = interface(IUnknown)
13.     ['{00000000-0000-0000-0000-000000000000}']
14.     function GetDisplayName(pszNameBuf: PWideChar; cchNameBuf: Cardinal; sig: Cardinal): HResult; stdcall;
15.     function GetAttributes(dwMask: Cardinal; out dwAttrib: Cardinal): HResult; stdcall;
16.     function Compare(refiid: TGUID; pithes6: IShellItem; out result: Cardinal): HResult; stdcall;
17.     // Добавьте здесь другие необходимые методы
18.   end;
19.  
20. // Ваша процедура получения миниатюры
21. procedure GetThumbnail(const FilePath: string; Image: TImage);
22. var
23.   ShellItem: IShellItem;
24.   ThumbnailProvider: IThumbnailProvider;
25.   hBitmap: HBITMAP;
26.   Size: SIZE;
27. begin
28.   // Инициализация COM
29.   CoInitialize(nil);
30.   try
31.     // Создание IShellItem из пути файла
32.     if Succeeded(SHCreateItemFromParsingName(PChar(FilePath), nil, IShellItem, ShellItem)) then
33.     begin
34.       // Получение интерфейса IThumbnailProvider
35.       if Succeeded(ShellItem.BindToHandler(nil, BHID_ThumbnailProvider, IThumbnailProvider, ThumbnailProvider)) then
36.       begin
37.         // Установка размера миниатюры
38.         Size.cx := 128; // Ширина
39.         Size.cy := 128; // Высота
40.  
41.         // Получение миниатюры
42.         if Succeeded(ThumbnailProvider.GetThumbnail(Size.cy, 0, hBitmap)) then
43.         begin
44.           // Установка миниатюры в компонент TImage
45.           Image.Picture.Bitmap.Handle := hBitmap;
46.           Image.Refresh;
47.  
48.           // Освобождение ресурса битmaps (необходимо, чтобы избежать утечек памяти)
49.           DeleteObject(hBitmap);
50.         end;
51.       end;
52.     end;
53.   finally
54.     CoUninitialize;
55.   end;
56. end;

 

Видимо надо, я этого не делал.

 

Значит я не на правильном пути, если учитывать сложность. Спасибо за ответ.

 

Получаешь IShellItemImageFactory через вызов SHCreateItemFromParsingName. Далее вызываешь метод GetImage в котором получаешь HBITMAP превью.

Код (C++):

1. #include <windows.h>
2. #include <Shobjidl.h>
3.  
4. int main() {
5.     HRESULT hr;
6.     IShellItemImageFactory *pImgFactory = NULL;
7.     SIZE sz;
8.     HBITMAP hBmp = NULL;
9.     HWND hWnd = NULL;
10.     HDC hDC = NULL, hDCBuf = NULL;
11.  
12.     if (FAILED(hr = CoInitialize(NULL))) {
13.         goto CleanUp;
14.     }
15.  
16.     if (FAILED(hr = SHCreateItemFromParsingName(L"Stay.2005.BDRip-AVC.mkv", NULL, IID_IShellItemImageFactory, (void**)&pImgFactory))) {
17.         goto CleanUp;
18.     }
19.  
20.     sz.cx = 256;
21.     sz.cy = 256;
22.  
23.     if (FAILED(hr = pImgFactory->GetImage(sz, SIIGBF_THUMBNAILONLY | SIIGBF_RESIZETOFIT, &hBmp))) {
24.         goto CleanUp;
25.     }
26.  
27.     if (NULL == (hWnd = CreateWindow(L"#32770", NULL, WS_POPUP | WS_VISIBLE, 200, 200, 200, 200, NULL, NULL, NULL, NULL)) ||
28.         NULL == (hDC = GetDC(hWnd)) ||
29.         NULL == (hDCBuf = CreateCompatibleDC(hDC))) {
30.         goto CleanUp;
31.     }
32.  
33.     SaveDC(hDCBuf);
34.     SelectObject(hDCBuf, hBmp);
35.     BitBlt(hDC, 0, 0, 256, 256, hDCBuf, 0, 0, SRCCOPY);
36.     RestoreDC(hDCBuf, -1);
37.  
38. CleanUp:
39.  
40.     if (hDC)
41.         ReleaseDC(hWnd, hDC);
42.     if (hDCBuf)
43.         DeleteDC(hDCBuf);
44.  
45.     if (hBmp)
46.         DeleteObject(hBmp);
47.  
48.     if (hWnd)
49.         DestroyWindow(hWnd);
50.  
51.     if (pImgFactory)
52.         pImgFactory->Release();
53.  
54.     return hr;
55. }

 

Оказывается в delphi 7 в ShlObj.pas мало что есть от shobjidl. Нет IShellItemImageFactory, SHCreateItemFromParsingName.
Коварные предатели из borland'a не смогли преусмотреть, что через 20 лет я буду решать эту задачу на delphi 7.

Спасибо за код. Попробую перевести его через llm'ки.