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/vfpimaging/archive/2007/06/03/3865.aspx
Autor: Cesar Ch.
Traducido por: Ana María Bisbé York

---

¿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