Una simple rutina para determinar el tipo verdadero de un archivo de imagen.
Como determinar el tipo verdadero de un archivo de imagen
Artículo original: How to determine the real type of an Image file
http://weblogs.foxite.com/cesarchalom/archive/2007/06/03/3865.aspx
Autor: Cesar Chalom (http://weblogs.foxite.com/cesarchalom)
Traducido por: Ana María Bisbé York (http://www.amby.net) y Luis María Guayán (http://www.luismariaguayan.com.ar)
Para: PortalFox (http://www.portalfox.com)
¿Ha notado que puede cambiar la extensión de un archivo de imagen a otros tipos de archivos de imagen, y Windows aun puede mostrar esas imágenes?
En efecto, cuando renombramos por ejemplo la imagen "YourPicture.Bmp" a "YourPicture.Jpg", todo el archivo permanece intacto, sólo la extensión de archivo es cambiada. Cuando Windows abre esa imagen, encuentra la información en la cabecera de la imagen, al principio del archivo, una firma específica que indica el tipo verdadero de imagen con la que está tratando.
Tore Bleken, de Noruega, ha creado una función muy sencilla y útil que busca cierta información específica en la cabecera del archivo. Él simplemente usó un editor hexadecimal, y examinó varios archivos. ¡Muchas gracias a Tore por el código y permitir publicarlo aquí!
FUNCTION FileType
LPARAMETERS lcData
LOCAL lcReturn,lcContents
IF PCOUNT()=0 OR VARTYPE(lcData)#'C'
lcReturn=''
ELSE
IF ADIR(laDummy,lcData)>0 && Archivo
lcContents=FILETOSTR(lcData)
ELSE && Variable de memoria
lcContents=lcData
ENDIF
DO CASE
CASE LEN(lcContents)<4
lcReturn=''
CASE LEFT(lcContents,3)=CHR(0xFF)+CHR(0xD8)+CHR(0xFF)
lcReturn='JPG'
CASE LEFT(lcContents,3)='GIF'
lcReturn='GIF'
CASE SUBSTR(lcContents,42,3)='EMF'
lcReturn='EMF'
CASE LEFT(lcContents,4)=CHR(0xD7)+CHR(0xCD)+CHR(0xC6)+CHR(0x9A)
lcReturn='WMF'
CASE LEFT(lcContents,4)=CHR(0x4D)+CHR(0x4D)+CHR(0x00)+CHR(0x2A)
lcReturn='TIF'
CASE LEFT(lcContents,4)=CHR(0x89)+'PNG'
lcReturn='PNG'
CASE LEFT(lcContents,2)='BM'
lcReturn='BMP'
CASE LEFT(lcContents,3)='CWS' AND ASC(SUBSTR(lcContents,4,1))<16
lcReturn='SWF'
CASE LEFT(lcContents,3)='FWS' AND ASC(SUBSTR(lcContents,4,1))<16
lcReturn='SWF'
OTHERWISE
lcReturn=''
ENDCASE
ENDIF
RETURN lcReturn
ENDFUNC
|