Extraction d'informations iptc d'une image

Commenter

Contenu du snippet

Voici un début de classe ASP/VB qui permet d'extraire les informations IPTC d'une image.
Comme je n'ai trouvé aucun script ASP capable d'effectuer une telle opération, j'ai décidé de créer mon propre code :
c'est un peu "cru" et assez basique, toute aide ou commentaire sont les bienvenues.

Source / Exemple : 


<%
'Attention à n'utiliser que dans des pages codées en "Europe Occidental" : iso-8859-1 / CODEPAGE=1252
'
'===========================================
'Class d'extraction de tags IPTC d'une image
'===========================================
'
'Créé par Olivier Briat (olivier@briat.org) septembre 2006
'Basé sur les information collecté sur les pages suivantes :
' - http://www.codeproject.com/bitmap/iptc.asp?df=100&forumid=2301&exp=0&select=600249#xx600249xx
' - http://www.awaresystems.be/imaging/tiff/tifftags/docs/photoshopthumbnail.html

'
' VERSION 0.2:
' 0.2 : (29/09/06) Correction de l'extraction du segment 8BIM, et support TIFF
' 0.1 : (25/09/06) Version de base de la classe
'
' UTILISATION :
'
' 'Instancier l'objet :
' Set IP = New IPTC
' 'Ouvrir un fichier (chemin sur le disque, penser à utiliser Request.ServerVariables("APPL_PHYSICAL_PATH")):
' IP.Open(RepDest_NomFichier)
' ' Gestion des erreurs
'	if (IP.Erreurs<>"") then
'		Resultat=IP.Erreurs
'	else
''		On boucle le contenu du dictionnaire contenant les infos IPTC
'		For Each key in IP.Infos
'		 	Credits= Credits & key & " : " & IP.Infos.item(key) & "<br>"
' 		next
'	end if
' 'Destruction de l'objet
'Set IP=Nothing
'
'
' TODO :
' - gestion des encodages de caractères
' - analyse d'autres types d'entêtes
' - écriture dans un fichier
'
'
'

Class IPTC

	'On Error resume next

	Public Infos

	Private VarArrayBinRequest
	Private StreamRequest
	Private MesEr

'CONSTRUCTOR/DESTRUCTOR
'-------------------------------------------
	Private Sub Class_Initialize()
		Set Infos = Server.CreateObject("Scripting.Dictionary")
		Set StreamRequest = Server.CreateObject("ADODB.Stream")
		StreamRequest.Type = 1 'adTypeBinary
		StreamRequest.Open
		MesEr=""
	End Sub

	Private Sub Class_Terminate()
		If IsObject(Infos) Then
			Infos.RemoveAll()
			Set Infos = Nothing
		End If

		StreamRequest.Close
		Set StreamRequest = Nothing
	End Sub

'PUBLIC FUNCTIONS
'-------------------------------------------

	Public Sub Open(path)
		StreamRequest.LoadFromFile(path)
		VarArrayBinRequest=StreamRequest.Read

		if (Err.number <>0) then
			MesEr="Impossible d'ouvrir le fichier :  " & path
			VarArrayBinRequest=Empty
		else
			Analyse
		end if
	End Sub

' PROPERTIES
'-------------------------------------------

	Public Property Get Erreurs()
			Erreurs = MesEr
	End Property

'PRIVATE FUNCTIONS
'-------------------------------------------

'ANALYSE LES HEADERS JPEG
	Private Sub Analyse()
		MJpg = ChrB(&hFF) & ChrB(&hD8)
		MPhoto = ChrB(&hFF) & ChrB(&hED)
		M8bim = ChrB(&h38) & ChrB(&h42) & ChrB(&h49) & ChrB(&h4D)
		Miptc =  ChrB(&h1C) & ChrB(&h02)

		'On démarre au début du fichier Jpeg
		'nCurPos = FindToken(MPhoto,1)
		'If (nCurPos <= 1)  Then
		'		MesEr="Ce n'est pas un fichier Jpeg valide."
		'else
		'On passe au début du segment Photoshop
		'	nCurPos = FindToken(MPhoto,nCurPos)
		'	If (nCurPos <= 1)  Then
		'			MesEr="Ce fichier ne contient pas de section Photoshop."
		'	else
		'		nCurPos = SkipToken(MPhoto,nCurPos)
		'		'On passe au début du segment M8BIM
		'		nCurPos = FindToken(M8bim,nCurPos)
		'	end if
		'end if
		nCurPos = FindToken(M8bim,1)
		If (nCurPos <= 1)  Then
			MesEr="Ce fichier ne contient pas de section 8BIM."
		else
			VarArrayBinRequest=Extract8Bim(nCurPos)
			'On passe au début du premier tag IPTC
			nCurPos = SkipToken(Miptc,1)
			If (nCurPos <= 1)  Then
				MesEr="Ce fichier ne contient aucune information IPTC."
			else
				'On analyse les tag IPTC suivants
				do
					Call NomIPTC(nCurPos)
					nCurPos = SkipToken(Miptc,nCurPos)
				loop while (nCurPos > 1)
			end if
		end if
	End Sub

	'Placer le curseur au début d'un segment
	Private Function FindToken(sToken, nStart)
		FindToken = InstrB(nStart, VarArrayBinRequest, sToken)
	End Function

	'Placer le curseur après le marqueur d'un segment
	Private Function SkipToken(sToken, nStart)
		SkipToken = InstrB(nStart, VarArrayBinRequest, sToken)
		If SkipToken > 0 then
			SkipToken = SkipToken + LenB(sToken)
		end if
	End Function

	'Extrait le contenu d'un segment
	'la taille est détermine par 2 octets situé à nSkip du début du segment
	'Delta : méthode empirique utilisée pour extrait un entête, pourquoi ???
	Private Function Extract(nStart,nSkip,Delta)
		Length = Byte2Int(MidB(VarArrayBinRequest,nStart+nSkip, 2))
		Extract= MidB(VarArrayBinRequest,nStart+nSkip+2-Delta, Length+Delta)
	End Function

	'Extrait le contenu d'un segment 8BIM
	Private Function Extract8Bim(nStart)
		ImgResId = Byte2Int(MidB(VarArrayBinRequest,nStart+4, 2))
		PascalLength = Byte2Int(MidB(VarArrayBinRequest,nStart+6, 1))
		Pascal=Byte2String(MidB(VarArrayBinRequest,nStart+6+1, PascalLength))
		if (PascalLength MOD 1=0) then
			Jump=PascalLength+1
		else
			Jump=PascalLength
		end if
		BimLength=Byte2Int(MidB(VarArrayBinRequest,nStart+6+Jump, 4))
		Extract8Bim = MidB(VarArrayBinRequest,nStart+10+Jump, BimLength)
	End Function

	'Détermine le type d'un marqueur IPTC et son contenu
	Private Function NomIPTC(nStart)
		'Détermine l'octect definissant le type de marqueur IPTC
		NomInt= Byte2Int(MidB(VarArrayBinRequest,nStart,1))
		'Extrait le contenu du marqueur IPTC
		ValIPTC=Extract(nStart,1,0)

		'INFOS : http://peccatte.karefil.com/Software/Metadata.htm#IPTC
		Select Case NomInt
				Case 0
						NomIPTC = "ApplicationRecordVersion"
						ValIPTC = Byte2Int(ValIPTC)
				Case 3
						NomIPTC = "ObjectTypeReference"
						ValIPTC = Byte2String(ValIPTC)
				Case 4
						NomIPTC = "ObjectAttributeReference"
						ValIPTC = Byte2String(ValIPTC)
				Case 5
						NomIPTC = "Nom de l'objet"
						ValIPTC = Byte2String(ValIPTC)
				Case 7
						NomIPTC = "Statut éditorial"
						ValIPTC = Byte2String(ValIPTC)
				Case 8
						NomIPTC = "EditorialUpdate"
						ValIPTC = Byte2String(ValIPTC)
				Case 10
						NomIPTC = "Priorité"
						ValIPTC = Byte2String(ValIPTC)
				Case 12
						NomIPTC = "SubjectReference"
						ValIPTC = Byte2String(ValIPTC)
				Case 15
						NomIPTC = "Catégorie"
						ValIPTC = Byte2String(ValIPTC)
				Case 20
						NomIPTC = "Catégorie supplmentaire"
						ValIPTC = Byte2String(ValIPTC)
				Case 22
						NomIPTC = "Identificateur"
						ValIPTC = Byte2String(ValIPTC)
				Case 25
						NomIPTC = "Mots-clés"
						ValIPTC = Byte2String(ValIPTC)
				Case 26
						NomIPTC = "ContentLocationCode"
						ValIPTC = Byte2String(ValIPTC)
				Case 27
						NomIPTC = "ContentLocationName"
						ValIPTC = Byte2String(ValIPTC)
				Case 30
						NomIPTC = "Date de disponibilité" '8 caractères, forme AAAAMMJJ
						ValIPTC = ExtractDate(ValIPTC,0)
				Case 35
						NomIPTC = "Heure de disponibilité" '11 caractères HHMMSSHHMM
						ValIPTC = ExtractDate(ValIPTC,1)
				Case 37
						NomIPTC = "ExpirationDate"
						ValIPTC = ExtractDate(ValIPTC,0)
				Case 38
						NomIPTC = "ExpirationTime"
						ValIPTC = ExtractDate(ValIPTC,1)
				Case 40
						NomIPTC = "Instructions spéciales"
						ValIPTC = Byte2String(ValIPTC)
				Case 42
						NomIPTC = "ActionAdvised"
						Select Case Byte2Int(ValIPTC)
								Case 1
										ValIPTC = "Object Kill"
								Case 2
										ValIPTC = "Object Replace"
								Case 3
										ValIPTC = "Ojbect Append"
								Case 4
										ValIPTC = "Object Reference"
						End Select
				Case 45
						NomIPTC = "Service de référence"
						ValIPTC = Byte2String(ValIPTC)
				Case 47
						NomIPTC = "Date de référence"
						ValIPTC = ExtractDate(ValIPTC,0)
				Case 50
						NomIPTC = "Numro de référence"
						ValIPTC = Byte2String(ValIPTC)
				Case 55
						NomIPTC = "Date de création de l'objet" '8 caractères, forme AAAAMMJJ
						ValIPTC = ExtractDate(ValIPTC,0)
				Case 60
						NomIPTC = "Heure de création de l'objet" '11 caractères HHMMSSHHMM
						ValIPTC = ExtractDate(ValIPTC,1)
				Case 62
						NomIPTC = "DigitalCreationDate"
						ValIPTC = ExtractDate(ValIPTC,0)
				Case 63
						NomIPTC = "DigitalCreationTime"
						ValIPTC = ExtractDate(ValIPTC,1)
				Case 65
						NomIPTC = "Programme ayant créé l'objet"
						ValIPTC = Byte2String(ValIPTC)
				Case 70
						NomIPTC = "Version du programme ayant créé l'objet"
						ValIPTC = Byte2String(ValIPTC)
				Case 75
						NomIPTC = "Cycle de l'objet"
						Select Case Byte2String(ValIPTC)
								Case "a"
										ValIPTC = "le matin"
								Case "b"
										ValIPTC = "Both Morning and Evening" ', 'b' = l'après-midi, 'c' = matin et après-midi ???
								Case "p"
										ValIPTC = "Evening"
						End Select
				Case 80
						NomIPTC = "Créateur de l'objet"
						ValIPTC = Byte2String(ValIPTC)
				Case 85
						NomIPTC = "Titre du créateur"
						ValIPTC = Byte2String(ValIPTC)
				Case 90
						NomIPTC = "Ville"
						ValIPTC = Byte2String(ValIPTC)
				Case 92
						NomIPTC = "Sub-location"
						ValIPTC = Byte2String(ValIPTC)
				Case 95
						NomIPTC = "Province/état"
						ValIPTC = Byte2String(ValIPTC)
				Case 100
						NomIPTC = "Code du pays" 'ISO3166 (codes pays sur 3 caractères)
						ValIPTC = Byte2String(ValIPTC)
				Case 101
						NomIPTC = "Libellé du pays"
						ValIPTC = Byte2String(ValIPTC)
				Case 103
						NomIPTC = "référence de la transmission (code)"
						ValIPTC = Byte2String(ValIPTC)
				Case 105
						NomIPTC = "Titre"
						ValIPTC = Byte2String(ValIPTC)
				Case 110
						NomIPTC = "Crédit"
						ValIPTC = Byte2String(ValIPTC)
				Case 115
						NomIPTC = "Source"
						ValIPTC = Byte2String(ValIPTC)
				Case 116
						NomIPTC = "Copyright"
						ValIPTC = Byte2String(ValIPTC)
				Case 118
						NomIPTC = "Contact"
						ValIPTC = Byte2String(ValIPTC)
				Case 120
						NomIPTC = "Description"
						ValIPTC = Byte2String(ValIPTC)
				Case 121
						NomIPTC = "LocalCaption"
						ValIPTC = Byte2String(ValIPTC)
				Case 122
						NomIPTC = "Auteur de la Description"
						ValIPTC = Byte2String(ValIPTC)
				Case 125
						NomIPTC = "RasterizedCaption"
						ValIPTC = Byte2String(ValIPTC)
				Case 130
						NomIPTC = "Type de l'image" 'cf. le document IPTC-NAA IIMV4
						ValIPTC = Byte2String(ValIPTC)
				Case 131
						NomIPTC = "Orientation de l'image"
						Select Case Byte2String(ValIPTC)
								Case "L"
										ValIPTC = "Paysage"
								Case "P"
										ValIPTC = "Portrait"
								Case "S"
										ValIPTC = "Carr"
						End Select
				Case 135
						NomIPTC = "LanguageIdentifier"
						ValIPTC = Byte2String(ValIPTC)
				Case 150
						NomIPTC = "AudioType"
						Select Case Byte2String(ValIPTC)
								Case "0T"
										ValIPTC = "Text Only"
								Case "1A"
										ValIPTC = "Mono Actuality"
								Case "1C"
										ValIPTC = "Mono Question and Answer Session"
								Case "1M"
										ValIPTC = "Mono Music"
								Case "1Q"
										ValIPTC = "Mono Response to a Question"
								Case "1R"
										ValIPTC = "Mono Raw Sound"
								Case "1S"
										ValIPTC = "Mono Scener"
								Case "1V"
										ValIPTC = "Mono Voicer"
								Case "1W"
										ValIPTC = "Mono Wrap"
								Case "2A"
										ValIPTC = "Stereo Actuality"
								Case "2C"
										ValIPTC = "Stereo Question and Answer Session"
								Case "2M"
										ValIPTC = "Stereo Music"
								Case "2Q"
										ValIPTC = "Stereo Response to a Question"
								Case "2R"
										ValIPTC = "Stereo Raw Sound"
								Case "2S"
										ValIPTC = "Stereo Scener"
								Case "2V"
										ValIPTC = "Stereo Voicer"
								Case "2W"
										ValIPTC = "Stereo Wrap"
						End Select
				Case 151
						NomIPTC = "AudioSamplingRate"
						ValIPTC = Byte2String(ValIPTC)
				Case 152
						NomIPTC = "AudioSamplingResolution"
						ValIPTC = Byte2String(ValIPTC)
				Case 153
						NomIPTC = "AudioDuration"
						ValIPTC = Byte2String(ValIPTC)
				Case 154
						NomIPTC = "AudioOutcue"
						ValIPTC = Byte2String(ValIPTC)
				Case 184
						NomIPTC = "JobID"
						ValIPTC = Byte2String(ValIPTC)
				Case 185
						NomIPTC = "MasterDocumentID"
						ValIPTC = Byte2String(ValIPTC)
				Case 186
						NomIPTC = "ShortDocumentID"
						ValIPTC = Byte2String(ValIPTC)
				Case 187
						NomIPTC = "UniqueDocumentID"
						ValIPTC = Byte2String(ValIPTC)
				Case 188
						NomIPTC = "OwnerID"
						ValIPTC = Byte2String(ValIPTC)
				Case 200
						NomIPTC = "ObjectPreviewFileFormat"
						Select Case Byte2Int(ValIPTC)
								Case 0
										ValIPTC = "No ObjectData"
								Case 1
										ValIPTC = "IPTC-NAA Digital Newsphoto Parameter Record"
								Case 2
										ValIPTC = "IPTC7901 Recommended Message Format"
								Case 3
										ValIPTC = "Tagged Image File Format (Adobe/Aldus Image data)"
								Case 4
										ValIPTC = "Illustrator (Adobe Graphics data)"
								Case 5
										ValIPTC = "AppleSingle (Apple Computer Inc)"
								Case 6
										ValIPTC = "NAA 89-3 (ANPA 1312)"
								Case 7
										ValIPTC = "MacBinary II"
								Case 8
										ValIPTC = "IPTC Unstructured Character Oriented File Format (UCOFF)"
								Case 9
										ValIPTC = "United Press International ANPA 1312 variant"
								Case 10
										ValIPTC = "United Press International Down-Load Message"
								Case 11
										ValIPTC = "JPEG File Interchange (JFIF)"
								Case 12
										ValIPTC = "Photo-CD Image-Pac (Eastman Kodak)"
								Case 13
										ValIPTC = "Bit Mapped Graphics File [.BMP] (Microsoft)"
								Case 14
										ValIPTC = "Digital Audio File [.WAV] (Microsoft amp; Creative Labs)"
								Case 15
										ValIPTC = "Audio plus Moving Video [.AVI] (Microsoft)"
								Case 16
										ValIPTC = "PC DOS/Windows Executable Files [.COM][.EXE]"
								Case 17
										ValIPTC = "Compressed Binary File [.ZIP] (PKWare Inc)"
								Case 18
										ValIPTC = "Audio Interchange File Format AIFF (Apple Computer Inc)"
								Case 19
										ValIPTC = "RIFF Wave (Microsoft Corporation)"
								Case 20
										ValIPTC = "Freehand (Macromedia/Aldus)"
								Case 21
										ValIPTC = "Hypertext Markup Language [.HTML] (The Internet Society)"
								Case 22
										ValIPTC = "MPEG 2 Audio Layer 2 (Musicom), ISO/IEC"
								Case 23
										ValIPTC = "MPEG 2 Audio Layer 3, ISO/IEC"
								Case 24
										ValIPTC = "Portable Document File [.PDF] Adobe"
								Case 25
										ValIPTC = "News Industry Text Format (NITF)"
								Case 26
										ValIPTC = "Tape Archive [.TAR]"
								Case 27
										ValIPTC = "Tidningarnas Telegrambyra NITF version (TTNITF DTD)"
								Case 28
										ValIPTC = "Ritzaus Bureau NITF version (RBNITF DTD)"
								Case 29
										ValIPTC = "Corel Draw [.CDR]"
						End Select
				Case 201
						NomIPTC = "ObjectPreviewFileVersion"
						ValIPTC = Byte2String(ValIPTC)
				Case 202
						NomIPTC = "ObjectPreviewData"
						ValIPTC = Byte2String(ValIPTC)
				Case 225
						NomIPTC = "ClassifyState"
						ValIPTC = Byte2String(ValIPTC)
				Case 228
						NomIPTC = "SimilarityIndex"
						ValIPTC = Byte2String(ValIPTC)
				Case 230
						NomIPTC = "DocumentNotes"
						ValIPTC = Byte2String(ValIPTC)
				Case 231
						NomIPTC = "DocumentHistory"
						ValIPTC = Byte2String(ValIPTC)
				Case 232
						NomIPTC = "ExifCameraInfo"
						ValIPTC = Byte2String(ValIPTC)
				Case else
						NomIPTC = "Inconnu"
						ValIPTC = Byte2String(ValIPTC)
		End Select
		Infos.Add NomIPTC, ValIPTC
	End Function

	'Extrait la date ou l'heure du format IPTC  format franais : JJ/MM/AAAA, HHhMM SSs  HHhMM
	Private Function ExtractDate(ByData, BoType)
		if (Botype=0) then
				'8 caractères, forme AAAAMMJJ
        ExtractDate=Mid(Byte2String(ByData),7,2) & "/" & Mid(Byte2String(ByData),5,2) & "/" & Mid(Byte2String(ByData),1,4)
		else
				'11 caractères HHMMSSHHMM
	       ExtractDate=Mid(Byte2String(ByData),1,2) & "h" & Mid(Byte2String(ByData),3,2) & " " & Mid(Byte2String(ByData),1,2)  & "s" &_
				 " " & Mid(Byte2String(ByData),7,1) & " " & Mid(Byte2String(ByData),8,2) & "h" & Mid(Byte2String(ByData),10,2)

	       'ExtractDate=Mid(Byte2String(ByData),5,2) & "/" & Mid(Byte2String(ByData),3,2) & "/" & Mid(Byte2String(ByData),1,2) &_
				 '" " & Mid(Byte2String(ByData),7,3) & "h" & Mid(Byte2String(ByData),10,2)
		end if
	End Function

	'Convertit un octet en entier
	Private Function Byte2Int(bsString)
		Dim i
		Byte2Int =0
		i=1
		while (i <= LenB(bsString))
				n=LenB(bsString)-i
				Byte2Int=Byte2Int+(AscB(MidB(bsString,i,1))*(2^(8*n)))
			i= i +1
		wend
	End Function

	'Convertit un octet en chaine de charactre (encodage ASCII)
	Private Function Byte2String(bsString)
		Dim i
		Byte2String =""
		For i = 1 to LenB(bsString)
     Byte2String = Byte2String & Chr(AscB(MidB(bsString,i,1)))
    Next
'		UTF8 ENCODING
'		Response.Write	 Byte2String
'		Byte2String =""
'		i=1
'		while (i <= LenB(bsString))
'				if (AscB(MidB(bsString,i,1)) =< 127)  then
'					Byte2String = Byte2String & Chr(AscB(MidB(bsString,i,1)))
'					i= i +1
'				elseif (AscB(MidB(bsString,i,1)) >= 192 AND AscB(MidB(bsString,i,1)) =<223)  then
'					Byte2String = Byte2String & ChrW( ((AscB(MidB(bsString,i,1))-192)*64) + (AscB(MidB(bsString,i+1,1))-128) )
'					i= i +2
'				elseif (AscB(MidB(bsString,i,1)) >=224 AND AscB(MidB(bsString,i,1)) <=239) then
'					Byte2String = Byte2String & ChrW( ((AscB(MidB(bsString,i,1))-224)*4096) + ((AscB(MidB(bsString,i+1,1))-128)*64) + (AscB(MidB(bsString,i+2,1))-128) )
'					i= i +3
'				elseif (AscB(MidB(bsString,i,1)) >=240 AND AscB(MidB(bsString,i,1)) <=247) then
'					Byte2String = Byte2String & ChrW( ((AscB(MidB(bsString,i,1))-240)*262144) +  ((AscB(MidB(bsString,i+1,1))-128)*4096) + ((AscB(MidB(bsString,i+2,1))-128)*64) + (AscB(MidB(bsString,i+3,1))-128) )
'					i= i +4
'				elseif (AscB(MidB(bsString,i,1)) >=248 AND AscB(MidB(bsString,i,1)) <=251) then
'					Byte2String = Byte2String & ChrW( ((AscB(MidB(bsString,i,1))-248)*16777216) +  ((AscB(MidB(bsString,i+1,1))-128)*262144) +  ((AscB(MidB(bsString,i+2,1))-128)*4096) + ((AscB(MidB(bsString,i+3,1))-128)*64) + (AscB(MidB(bsString,i+4,1))-128) )
'					i= i +5
'				elseif (AscB(MidB(bsString,i,1)) >=252 AND AscB(MidB(bsString,i,1)) <=253) then
'					Byte2String = Byte2String & ChrW	( ((AscB(MidB(bsString,i,1))-252)*1073741824) +  ((AscB(MidB(bsString,i+1,1))-128)*16777216) +  ((AscB(MidB(bsString,i+2,1))-128)*262144) +  ((AscB(MidB(bsString,i+3,1))-128)*4096) + ((AscB(MidB(bsString,i+4,1))-128)*64) + (AscB(MidB(bsString,i+5,1))-128) )
'					i= i +6
'				else
'					i= i +1
'				end if
'		wend
	End Function

end class
%>

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.