File "icostrip.inc"
Path: /exe2unix/inc/icostrip.inc
File size: 6.63 KB
MIME-type:
Charset: utf-8
'--------------------------------------------------------------------------------------------------
' 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
'--------------------------------------------------------------------------------------------------