Wyciąganie ikon z plików w folderze

Witam,
Mam problem a mianowicie chciałym wyciągnąć ikony wszystkich plików znajdujących się w danym folderze (przykładowo folderze pulpitu) i po kolei je wyświetlić. Problem jest w tym, że program pobiera złe ikony tzn. z innych plików niż powinien.
Powiedzmy ze mam 4 pliki o różnych ikonach to program zamiast wyciągnąc ikonę z każdego pliku, wyciąga z jednego a reszta ma taką samą. Nie jest tak zawsze,na przykład gdy plików jest więcej, niektóre ikony są dobre, a niektóre się powtarzają.
Oto kod to przetestowania:

 
const
  SHIL_LARGE     = $00;  //The image size is normally 32x32 pixels. However, if the Use large icons option is selected from the Effects section of the Appearance tab in Display Properties, the image is 48x48 pixels.
  SHIL_SMALL     = $01;  //These images are the Shell standard small icon size of 16x16, but the size can be customized by the user.
  SHIL_EXTRALARGE= $02;  //These images are the Shell standard extra-large icon size. This is typically 48x48, but the size can be customized by the user.
  SHIL_SYSSMALL  = $03;  //These images are the size specified by GetSystemMetrics called with SM_CXSMICON and GetSystemMetrics called with SM_CYSMICON.
  SHIL_JUMBO     = $04;  //Windows Vista and later. The image is normally 256x256 pixels.
  IID_IImageList: TGUID= '{46EB5926-582E-4017-9FDF-E8998DAA0950}';

function GetImageListSH(SHIL_FLAG:Cardinal): HIMAGELIST;
type
  _SHGetImageList = function (iImageList: integer; const riid: TGUID; var ppv: Pointer): hResult; stdcall;
var
  Handle        : THandle;
  SHGetImageList: _SHGetImageList;
begin
  Result:= 0;
  Handle:= LoadLibrary('Shell32.dll');
  if Handle<> S_OK then
  try
    SHGetImageList:= GetProcAddress(Handle, PChar(727));
    if Assigned(SHGetImageList) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
      SHGetImageList(SHIL_FLAG, IID_IImageList, Pointer(Result));
  finally
    FreeLibrary(Handle);
  end;
end;


Procedure GetIconFromFile(aFile:String; var aIcon : TIcon;SHIL_FLAG:Cardinal);
var
  aImgList    : HIMAGELIST;
  SFI         : TSHFileInfo;
Begin
    //Get the index of the imagelist
    SHGetFileInfo(PChar(aFile), FILE_ATTRIBUTE_NORMAL, SFI,
                 SizeOf( TSHFileInfo ), SHGFI_ICON or SHGFI_LARGEICON or SHGFI_SHELLICONSIZE or
                 SHGFI_SYSICONINDEX or SHGFI_TYPENAME or SHGFI_DISPLAYNAME );

    if not Assigned(aIcon) then
    aIcon:= TIcon.Create;
    //get the imagelist
    aImgList:= GetImageListSH(SHIL_FLAG);
    //extract the icon handle
    aIcon.Handle:= ImageList_GetIcon(aImgList, Pred(ImageList_GetImageCount(aImgList)), ILD_NORMAL);
End;


procedure TForm1.Button1Click(Sender: TObject);
var
  x,y: integer;
  s: tsearchrec;
  hicon : array[0..100] of TIcon;
  image: array[0..100] of Timage;
  labels: array[0..100] of Tlabel;
begin
  x := 0;
  y:= 0;

  if FindFirst('C:\Documents and Settings\user\Pulpit\*.*', faAnyFile, s) = 0 then
    repeat
      hicon[x]:= TIcon.Create;
      memo1.lines.add('C:\Documents and Settings\user\Pulpit\' + s.name);
      GetIconFromFile('C:\Documents and Settings\user\Pulpit\' + s.name,hicon[x],SHIL_EXTRALARGE);
      image[x] := timage.create(self);
      with image[x] do
        begin
          parent := form1;
          canvas.Create;
          width:=100;
          height:=100;
          left:=120 * x;
          top:=100 * y;
          visible := true;
          Picture.Icon.Assign(hIcon[x]); //assign to timage
        end;

      labels[x] := Tlabel.Create(self);
      with labels[x] do
        begin
          parent := form1;
          left := (120 * x);
          top := 100 * y;
          visible := true;
          caption := s.name;
        end;

      hIcon[x].Free;
      inc(x);
      if x = 8 then
      begin
        inc(y);
        x := 0;
      end;
    until FindNext(s) <> 0;

  memo1.lines.add(inttostr(x));
end;
 

Program tworzy komponenty TImage oraz Tlabel w odpowiednim miejscu z nazwą pliku.

Funkcje pobierania ikon wziąłem stąd:
http://stackoverflow.com/questions/1703186/can-48x48-or-64x64-icons-be-obtained-from-the-vista-shell

Co ciekawe, gdy pobieram którąś z ikon osobno to wszystko jest w porządku.

if FindFirst('C:\Documents and Settings\user\Pulpit*.*', faAnyFile, s) = 0 then

Co to za ścieżka do pliku ?

http://4programmers.net/Forum/Delphi_Pascal/153021-Poważne_błędy_w_FindFirst_w_Delphi

Problem chyba nie jest w tym, ponieważ wszystkie nazwy wyszukanych ikon dodaje do Memo i wszystko się zgadzą.

zamiast ladowac do tablicy hicon[] (a potem przez assign do image[x].picture.icon) dawaj od razu

  GetIconFromFile( {...},  image[x].picure.icon,  SHIL_EXTRALARGE);

dwa: zamiast wklejac takie dlugie sciezki uzyj const.
trzy: pierwsze widze zeby przy tworzeniu TImage dawac canvas.create;
cztery: tablice statyczne? uzyj dynamicznych.

GetIconFromFile( {...}, image[x].picure.icon, SHIL_EXTRALARGE);

ten kod nie działa, nie można w ten sposób przypisać ikony
2. zdecydowanie nie to jest przyczyną problemu
3. to też nie
4. ani to

Gaski napisał(a)

GetIconFromFile( {...}, image[x].picure.icon, SHIL_EXTRALARGE);

ten kod nie działa, nie można w ten sposób przypisać ikony

2. zdecydowanie nie to jest przyczyną problemu
3. to też nie
4. ani to

punkty 2,3,4 to tylko wskazowki dotyczace Twojego kodu a nie samego problemu.
a punkt jeden: jak sie przerobi to mozna:

function GetIconFromFile(aFile:String;SHIL_FLAG:Cardinal):HICON;
var
  aImgList    : HIMAGELIST;
  SFI         : TSHFileInfo;
begin
    SHGetFileInfo(PChar(aFile), FILE_ATTRIBUTE_NORMAL, SFI,
                 SizeOf( TSHFileInfo ), SHGFI_ICON or SHGFI_LARGEICON or SHGFI_SHELLICONSIZE or
                 SHGFI_SYSICONINDEX or SHGFI_TYPENAME or SHGFI_DISPLAYNAME );
    aImgList:= GetImageListSH(SHIL_FLAG);
    result:= ImageList_GetIcon(aImgList, Pred(ImageList_GetImageCount(aImgList)), ILD_NORMAL);
end;

image1.picture.icon.handle:=GetIconFromFile(application.ExeName, SHIL_EXTRALARGE);

niestety jesli plik nie istnieje lub nie da sie z niego odczytac ikony to funkcja zwraca ostatnia poprawnie odczytana ikone a to dlatego ze ktos nie dopisal jedengo waznego warunku: zekrnij na msdn na funkcje SHGetFileInfo() i zobacz jaka wartosc zwraca przy bledzie. daj if'a ze jesli wystapil blad (czyli np niewlasciwe odczytanie ikon) to cos tam.

Spróbowałem jak najbardziej uprościć kod i doprowadziłem go do takiej postaci:
Button1:

 if FindFirst('C:\Documents and Settings\Gsk\Pulpit\*.*', faAnyFile, s) = 0 then
    repeat
      memFiles.lines.add('C:\Documents and Settings\Gsk\Pulpit\' + s.name);
 until FindNext(s) <> 0;
 

Tu wszystko działa dobrze, do memo memFiles dodaje sie lista plików na pulpicie.

Button2:

 
var
i: integer;
begin
  for i := 0 to memFiles.Lines.Count -1 do
    begin
      with Timage.Create(self) do
        begin
          parent := form1;
          width:=100;
          height:=100;
          left:=120 * i;
          top:=100;
          visible := true;
          picture.icon.handle:=GetIconFromFile(memFiles.Lines[i], SHIL_EXTRALARGE);
        end;
    end;
end;

W efekcie na formie pojawia się rząd Timage ale niestety problem jest nadal aktualny i niektóre ikony się powtarzają.
Np. na pulpicie mam jedno archiwum *.rar a na formie pojawia się 5 takich ikon w misjcu gdzie powinny być inne

Pobieranie ikon:

const
  SHIL_LARGE     = $00;  //The image size is normally 32x32 pixels. However, if the Use large icons option is selected from the Effects section of the Appearance tab in Display Properties, the image is 48x48 pixels.
  SHIL_SMALL     = $01;  //These images are the Shell standard small icon size of 16x16, but the size can be customized by the user.
  SHIL_EXTRALARGE= $02;  //These images are the Shell standard extra-large icon size. This is typically 48x48, but the size can be customized by the user.
  SHIL_SYSSMALL  = $03;  //These images are the size specified by GetSystemMetrics called with SM_CXSMICON and GetSystemMetrics called with SM_CYSMICON.
  SHIL_JUMBO     = $04;  //Windows Vista and later. The image is normally 256x256 pixels.
  IID_IImageList: TGUID= '{46EB5926-582E-4017-9FDF-E8998DAA0950}';

function GetImageListSH(SHIL_FLAG:Cardinal): HIMAGELIST;
type
  _SHGetImageList = function (iImageList: integer; const riid: TGUID; var ppv: Pointer): hResult; stdcall;
var
  Handle        : THandle;
  SHGetImageList: _SHGetImageList;
begin
  Result:= 0;
  Handle:= LoadLibrary('Shell32.dll');
  if Handle<> S_OK then
  try
    SHGetImageList:= GetProcAddress(Handle, PChar(727));
    if Assigned(SHGetImageList) and (Win32Platform = VER_PLATFORM_WIN32_NT) then
      SHGetImageList(SHIL_FLAG, IID_IImageList, Pointer(Result));
  finally
    FreeLibrary(Handle);
  end;
end;


function GetIconFromFile(aFile:String;SHIL_FLAG:Cardinal):hwnd;
var
  aImgList    : HIMAGELIST;
  SFI         : TSHFileInfo;
begin
    SHGetFileInfo(PChar(aFile), FILE_ATTRIBUTE_NORMAL, SFI,
                 SizeOf( TSHFileInfo ), SHGFI_ICON or SHGFI_LARGEICON or SHGFI_SHELLICONSIZE or
                 SHGFI_SYSICONINDEX or SHGFI_TYPENAME or SHGFI_DISPLAYNAME );
    aImgList:= GetImageListSH(SHIL_FLAG);
    result:= ImageList_GetIcon(aImgList, Pred(ImageList_GetImageCount(aImgList)), ILD_NORMAL);
end;
 

moze napisz z jakich doklanie plikow nie moze wyciagnac ikony? to skroty, pliki, czy co?
a wyzej napisalem Ci gdzie lezy blad zwracajacy ta sama ikone.

Różnie, niektóre ikony raz odczytuje a raz nie. Dzieje się tak praktycznie z każdym typem pliku.
Dziwne jest to, że powiedzmy z pliku o nazwie plik.rar odczytało złą ikonę podczas wczytywania i rysowania wszystkich ikon po kolei.
Natomiast jeżeli zrobię to tak:

image1.picture.icon.handle:=GetIconFromFile('C:\Documents and Settings\Gsk\Pulpit\plik.rar', SHIL_EXTRALARGE); 

to wszystko jest w porządku i wyświetla się właściwa ikona.

no widzisz. bo w tym pierwszym kodzie ktory podales to sprawa wygladala tak ze zamiast przypisac ikone bezposrednio do image'a to po drodze przepisywana byla jeszcze dwa razy. ani to bezpieczne ani optymalne.

Problem jest w tym, że błąd dalej występuje gdy tworze Image'y w pętli. Natomiast jeśli robię to pojedynczo to wszystko jest dobrze.

Mam ten sam problem oto rozwiazanie:

var
AIndex: Integer;

AIndex := Info.iIcon;
//AIndex := Pred(ImageList_GetImageCount(AImgList))

Result.Handle := ImageList_GetIcon(AImgList, AIndex, ILD_NORMAL);

<flame>SHGetImageList:= GetProcAddress(Handle, PChar(727)); <-- 727 to jakiś wskaźnik globalny w systemie? o_O</flame>