delphi 使用SHGetFileInfo函数获取任何文件大图标(修复长时间运行报错问题)

uses
    ShellAPI, CommCtrl;


function GetFileICO(AFile: string; AWidth, AHeight: Integer): TBitmap;
   function GetFileIconEX(AFile: string; ASHIL_FLAG: Cardinal): HICON;
      function _X: Boolean; {判断是否符合系统版本}
      begin
         Result := False;
         if Win32MajorVersion < 5 then
            Exit;
         if (Win32MajorVersion = 5) and (Win32MinorVersion < 1) then
            Exit;
         Result := True;
      end;
   type
      _SHGetImageList = function(iImageList: Integer; const riid: TGUID; var ppvObj: Pointer): HResult; stdcall;
   var
      nHandle: THandle;
      nImageList: HIMAGELIST;
      nSHGetImageList: _SHGetImageList;
      nFileInfo: TSHFileInfo;
   const
      IID_IImageList: TGUID = '{46EB5926-582E-4017-9FDF-E8998DAA0950}';
   begin
      Result := 0;
      nHandle := LoadLibrary('Shell32.dll');
      nImageList := 0;
      if nHandle <> S_OK then
      try
         nSHGetImageList := GetProcAddress(nHandle, PChar(727));
         if Assigned(nSHGetImageList) and _X then
            nSHGetImageList(ASHIL_FLAG, IID_IImageList, Pointer(nImageList));

         if nImageList > 0 then
         begin
            SHGetFileInfo(PChar(AFile), FILE_ATTRIBUTE_NORMAL, nFileInfo, SizeOf(TSHFileInfo), SHGFI_SYSICONINDEX);
            Result := ImageList_GetIcon(nImageList, nFileInfo.iIcon, ILD_NORMAL); //?????
         end;
      finally
         FreeLibrary(nHandle);
      end;
   end;
   function IcoToBmp(Icon: TIcon; ASHIL_FLAG: Cardinal): TBitmap;
   begin
      Result := TBitmap.Create;
      with Result do
      begin
         case ASHIL_FLAG of
            0:
               Width := 32;
            1:
               Width := 16;
            2:
               Width := 48;
            3:
               Width := 16;
            4:
               Width := 256;
         end;
         case ASHIL_FLAG of
            0:
               Height := 32;
            1:
               Height := 16;
            2:
               Height := 48;
            3:
               Height := 16;
            4:
               Height := 256;
         end;
         Canvas.Lock;
         Canvas.StretchDraw(Rect(0, 0, Width, Height), Icon);
         Canvas.Unlock;
      end;
   end;
   function BMPCenter(bmpSrc: TBitmap): TBitmap;
   begin
      Result := TBitMap.Create;
      Result.Width := AWidth;
      Result.Height := AHeight;
      Result.Canvas.Lock;
      Result.Canvas.Draw((AWidth - bmpSrc.Width) div 2, (AHeight - bmpSrc.Height) div 2, bmpSrc);
      Result.Canvas.Unlock;      
   end;

const
   SHIL_LARGE = 0; {32x32}
   SHIL_SMALL = 1; {16x16} //小图标
   SHIL_EXTRALARGE = 2; {48x48} //中图标
   SHIL_SYSSMALL = 3; {16x16}
   SHIL_JUMBO = 4; {256x256}
var
   ico: HIcon;
   ico2: TIcon;
   IconInfo: _ICONINFO;
   b: Boolean;
   i: Integer;
   bmp: TBitmap;
begin
   Result := nil;

   if (AWidth <= 16) or (AHeight <= 16) then
      i := SHIL_SMALL
   else if (AWidth <= 32) or (AHeight <= 32) then
      i := SHIL_LARGE
   else if (AWidth <= 48) or (AHeight <= 48) then
      i := SHIL_EXTRALARGE
   else if (AWidth < 256) or (AHeight < 256) then
      i := SHIL_EXTRALARGE
   else
      i := SHIL_EXTRALARGE; //SHIL_JUMBO; 256大图有些图标获取不到,暂时使用SHIL_EXTRALARGE吧
   try
      ico := GetFileIconEX(AFile, i);
      if ico = 0 then
         Exit;
      try
         b := GetIconInfo(ico, IconInfo);
         if b then
         begin
            ico2 := TIcon.Create;
            try
               ico2.Handle := CreateIconIndirect(IconInfo);
               bmp := IcoToBmp(ico2, i); 
               try
                  Result := BMPCenter(bmp);
               finally
                  FreeAndNil(bmp);
               end;
            finally
               FreeAndNil(ico2);
            end;
         end;
         DeleteObject(IconInfo.hbmMask); //网上的其它文章这里没有释放
         DeleteObject(IconInfo.hbmColor); //网上的其它文章这里没有释放
      finally
         DestroyIcon(ico); //网上的其它文章这里没有释放
      end;
   except
      on e: Exception do
      begin
      end;
   end;
end;