'--------------------------------------------------------------------------------------------------
' This is 'ICOstrip.inc' v0.1 for PBWin9 it allows to extract and save to the disk executable icons
'--------------------------------------------------------------------------------------------------
DECLARE FUNCTION ICOstrip(BYVAL exePath AS STRING, BYVAL icoIdx AS LONG, outFile AS STRING) AS LONG
'--------------------------------------------------------------------------------------------------
GLOBAL gsIcoCount AS LONG
GLOBAL gsIconIdx  AS LONG
GLOBAL gsIcoRes   AS LONG
GLOBAL gsOutFile  AS STRING
'--------------------------------------------------------------------------------------------------
FUNCTION ICOstrip(BYVAL exePath AS STRING, BYVAL icoIdx AS LONG, outFile AS STRING) AS LONG
  LOCAL zFileName AS ASCIIZ * 400
  LOCAL SourceModule AS ASCIIZ * %MAX_PATH
  LOCAL hSourceModule AS LONG

  ' Attempt to access resources through the LoadLibrary() method
  zFileName     = TRIM$(exePath, $DQ)
  SourceModule  = zFileName
  hSourceModule = LoadLibrary(SourceModule)

  ' Successful > means the exe/dll is a 32-bit program, same like us
  IF hSourceModule THEN
    gsIcoCount = 0
    gsIcoRes   = 0
    gsIconIdx  = icoIdx
    gsOutFile  = outFile
    CALL EnumResourceNames(hSourceModule, BYVAL %RT_GROUP_ICON, CODEPTR(EnumResNameProc), 0)
    FUNCTION = 1

  ' Failed > certainly b/c we're trying to access a 64-bit exe/dll from a 32-bit program
  ELSE
    FUNCTION = 0
  END IF

END FUNCTION
'--------------------------------------------------------------------------------------------------
TYPE GRPICONDIRENTRY
  bWidth        AS BYTE     '  Width, In Pixels, of the Image
  bHeight       AS BYTE     '  Height, In Pixels, of the Image
  bColorCount   AS BYTE     '  Number of colors In Image (0 If >=8bpp)
  bReserved     AS BYTE     '  Reserved
  wPlanes       AS WORD     '  Color Planes
  wBitCount     AS WORD     '  Bits per pixel
  dwBytesInRes  AS DWORD    '  how many bytes In this resource?
  nID           AS WORD     '  the ID
END TYPE
'--------------------------------------------------------------------------------------------------
TYPE GRPICONDIR
  idReserved    AS WORD     '  Reserved (must be 0)
  idType        AS WORD     '  Resource Type (1 For icons)
  idCount       AS WORD     '  How many images?
  idEntries(0)  AS GRPICONDIRENTRY '  The entries For each Image
END TYPE
'--------------------------------------------------------------------------------------------------
TYPE ICONDIR
  idReserved    AS WORD     '  Reserved (must be 0)
  idType        AS WORD     '  Resource Type (1 For icons)
  idCount       AS WORD     '  How many images?
END TYPE
'--------------------------------------------------------------------------------------------------
TYPE ICONDIRENTRY
  bWidth        AS BYTE     '  Width, In Pixels, of the Image
  bHeight       AS BYTE     '  Height, In Pixels, of the Image
  bColorCount   AS BYTE     '  Number of colors In Image (0 If >=8bpp)
  bReserved     AS BYTE     '  Reserved ( must be 0)
  wPlanes       AS WORD     '  Color Planes
  wBitCount     AS WORD     '  Bits per pixel
  dwBytesInRes  AS DWORD    '  How many bytes In this resource?
  dwImageOffset AS DWORD    '  Where In the file is this image?
END TYPE
'--------------------------------------------------------------------------------------------------
%IDR_WICONS = 9001               ' Required
'--------------------------------------------------------------------------------------------------
FUNCTION EnumResNameProc(BYVAL hModule AS LONG, BYVAL lpszType AS ASCIIZ PTR, _
    BYVAL lpszName AS ASCIIZ PTR, BYVAL lParam AS LONG) AS LONG
    LOCAL i, j, k, hFile AS LONG
    LOCAL hResGrIcon, hResGrIconLoad AS LONG
    LOCAL hResIcon, hResIconLoad AS LONG
    LOCAL lpResIconLock AS LONG
    LOCAL sResName, sIcoData AS STRING
    LOCAL lpResGrIconLock AS GRPICONDIR PTR

    INCR gsIcoCount
    IF (lpszName AND &HFFFF0000) THEN sResName = @lpszName ELSE sResName = "#" + FORMAT$(lpszName)

    DO
       hResGrIcon = FindResource(hModule, @lpszName, @lpszType)
       IF hResGrIcon = 0 THEN EXIT DO
       hResGrIconLoad = LoadResource(hModule, hResGrIcon)
       IF hResGrIconLoad = 0 THEN EXIT DO
       lpResGrIconLock = LockResource(hResGrIconLoad)
       IF lpResGrIconLock = 0 THEN EXIT DO
       k = 0
       FOR i = 0 TO @lpResGrIconLock.idCount - 1
          j = @lpResGrIconLock.idEntries(i).nId
          DO
             hResIcon = FindResource(hModule, BYVAL j, BYVAL %RT_ICON)
             IF hResIcon = 0 THEN EXIT DO
             hResIconLoad = LoadResource(hModule, hResIcon)
             IF hResIconLoad = 0 THEN EXIT DO
             lpResIconLock = LockResource(hResIconLoad)
             IF lpResIconLock = 0 THEN EXIT DO
             IF i = 0 THEN
                DIM IconD AS ICONDIR
                IconD.idReserved = 0
                IconD.idType = 1
                IconD.idCount = @lpResGrIconLock.idCount
                REDIM IconDE (IconD.idCount-1) AS ICONDIRENTRY  ' Zero Based
                REDIM IconImg(IconD.idCount-1) AS STRING        ' Zero Based
             END IF
             IconDE(i).bWidth        = @lpResGrIconLock.idEntries(i).bWidth
             IF gsIcoCount = gsIconIdx AND IconDE(i).bWidth > gsIcoRes THEN gsIcoRes = IconDE(i).bWidth
             IconDE(i).bHeight       = @lpResGrIconLock.idEntries(i).bHeight
             IconDE(i).bColorCount   = @lpResGrIconLock.idEntries(i).bColorCount
             IconDE(i).bReserved     = 0
             IconDE(i).wPlanes       = @lpResGrIconLock.idEntries(i).wPlanes
             IconDE(i).wBitCount     = @lpResGrIconLock.idEntries(i).wBitCount
             IconDE(i).dwBytesInRes  = @lpResGrIconLock.idEntries(i).dwBytesInRes
             IF i = 0 THEN
                IconDE(i).dwImageOffset = LEN(IconD) + IconD.idCount * LEN(ICONDIRENTRY)
             ELSE
                IconDE(i).dwImageOffset = IconDE(i - 1).dwImageOffset + k
             END IF
             k = SizeofResource(hModule, hResIcon)
             IconImg(i) = PEEK$(lpResIconLock, k)
             EXIT DO
          LOOP
       NEXT

       IF k THEN
         sIcoData = PEEK$(VARPTR(IconD), LEN(ICONDIR))
         FOR i = 0 TO IconD.idCount - 1
            sIcoData += PEEK$(VARPTR(IconDE(i)), LEN(ICONDIRENTRY))
         NEXT

         FOR i = 0 TO IconD.idCount - 1
            sIcoData += IconImg(i)
         NEXT

         IF gsIcoCount = gsIconIdx THEN
            hFile = FREEFILE
            OPEN gsOutFile FOR OUTPUT AS #hFile
            PRINT #hFile, sIcoData
            CLOSE #hFile
         END IF

       END IF
       EXIT DO

    LOOP

  FUNCTION = 1
END FUNCTION
'--------------------------------------------------------------------------------------------------