Получить картинку (аватар) учетной записи

[garuna]

Подскажите как это сделать? Чтобы работало от XP до 10.
Откопал на просторах функцию SHGetUserPicturePath (http://undoc.airesoft.co.uk/shell32....icturePath.php), но как ей пользоваться не понял. Помогите разобраться, пожалуйста.

[Filka]

У меня получилось так:

type
  TSHGetUserPicturePath = function(pwszPicOrUserName: PWideChar; sguppFlags: DWORD;
    pwszPicPath: PWideChar; picPathLen: UINT): HRESULT; stdcall;

function GetUserPicturePath(PicOrUserName: WideString): string;
var
  SHGetUserPicturePath: TSHGetUserPicturePath;
  DllHandle: THandle;
  Buffer: array[0..MAX_PATH - 1] of WideChar;
  P: PWideChar;
begin
  Result := '';
  DllHandle := LoadLibrary('shell32.dll');
  if DllHandle <> 0 then
  begin
    @SHGetUserPicturePath := GetProcAddress(DllHandle, PChar(261)); // WinXP = 233
    if Assigned(SHGetUserPicturePath) then
    begin
      if (PicOrUserName <> '') and (PicOrUserName <> #0) then
        P := PWideChar(PicOrUserName)
      else
        P := nil;
      if Succeeded(SHGetUserPicturePath(P, 0, Buffer, Length(Buffer))) then
        Result := Buffer;
    end;
    FreeLibrary(DllHandle);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //ShowMessage(GetUserPicturePath('User'));
  ShowMessage(GetUserPicturePath(''));
end;

[garuna]

Сообщение от Filka

У меня получилось так:

type
  TSHGetUserPicturePath = function(pwszPicOrUserName: PWideChar; sguppFlags: DWORD;
    pwszPicPath: PWideChar; picPathLen: UINT): HRESULT; stdcall;

function GetUserPicturePath(PicOrUserName: WideString): string;
var
  SHGetUserPicturePath: TSHGetUserPicturePath;
  DllHandle: THandle;
  Buffer: array[0..MAX_PATH - 1] of WideChar;
begin
  Result := '';
  DllHandle := LoadLibrary('shell32.dll');
  if DllHandle <> 0 then
  begin
    @SHGetUserPicturePath := GetProcAddress(DllHandle, PChar(261)); // WinXP = 233
    if Assigned(SHGetUserPicturePath) then
      if Succeeded(SHGetUserPicturePath(PWideChar(PicOrUserName), 0, Buffer,
        Length(Buffer))) then
        Result := Buffer;
    FreeLibrary(DllHandle);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //ShowMessage(GetUserPicturePath('User'));
  ShowMessage(GetUserPicturePath(''));
end;

СПАСИБО! На 7 работает отлично)

Что касается XP - не работает, но это не важно, ведь аватары в XP всегда хранятся тут: C:\Documents and Settings\All Users\Application Data\Microsoft\User Account Pictures\<username>.bmp

На 8-ке и 10-ке пока не пробовал, проверю как будет под рукой.

[Filka]

Пожалуйста.

Что касается XP - не работает

261 заменить на 233 (?)

[garuna]

Сообщение от Filka

Пожалуйста.

261 заменить на 233 (?)

Да, заменял. Программа просто закрывается, без каких-либо ошибок и сообщений, как через ExitProcess(0) ))

[garuna]

На 8.1 тоже не сработало

[Filka]

User Profile Tiles in Windows 7 and Later --> https://msdn.microsoft.com/ru-ru/lib...(v=vs.85).aspx