Taille en pixels des gif et jpg placés sur le serveur

Soyez le premier à donner votre avis sur cette source.

Snippet vu 12 312 fois - Téléchargée 36 fois

Contenu du snippet

Ce module permet de connaitre la taille des images GIF et JPEG placés sur le serveur grâce à FSO.
Notez que parfois, la taille des JPG est mauvaise, due à la non-conformité de l'image.
Ce source va chercher dans les Header de ces fichiers pour en retrouver les valeurs des tailles

Source / Exemple :


Function GetPicSize (fn)
	Set fso = CreateObject("Scripting.FileSystemObject")
	if fso.FileExists(Server.MapPath(fn)) = false then exit function
	pn = Server.MapPath(fn)
	tstr = ""
	Set f = fso.OpenTextFile(pn)

	Select Case UCase(Right(fn,4))
	Case ".GIF",".JPG"
		If NOT f.AtEndOfStream Then
			If UCase(Right(fn,4))=".GIF" Then
				chars		= f.read(10)
				width		= asc(mid(chars,8,1))*256 + asc(mid(chars,7,1))
				height	= asc(mid(chars,10,1))*256 + asc(mid(chars,9,1))
				hw = " WIDTH=" & width & " HEIGHT=" & height
			Else
				chars		= f.read(200)
				height	= asc(mid(chars,164,1))*256 + asc(mid(chars,165,1))
				width		= asc(mid(chars,166,1))*256 + asc(mid(chars,167,1))
				If (height>600) OR (height<3) OR (WIDTH<3) OR (WIDTH>600) Then
				Else
					hw = " WIDTH=" & width & " HEIGHT=" & height
				End If
			End If
		End If
		GetPicSize = "W : " & width & " H :" & height
	End Select
	f.Close
	Set f = Nothing
	Set fso = Nothing
End Function

Conclusion :


Utilisation :
response.write GetPicSize ("images\monimage.gif")

A voir également

Ajouter un commentaire

Commentaires

Messages postés
394
Date d'inscription
mercredi 30 janvier 2002
Statut
Membre
Dernière intervention
4 novembre 2009
1
Ca marchait avec des petits JPG .. Est toujours pas trouvé un truc qui marche pour tout !! :(
Messages postés
394
Date d'inscription
mercredi 30 janvier 2002
Statut
Membre
Dernière intervention
4 novembre 2009
1
Si adTypeBinary n'est pas reconnu par votre serveru mettez 1
A+
Messages postés
394
Date d'inscription
mercredi 30 janvier 2002
Statut
Membre
Dernière intervention
4 novembre 2009
1
Est trouvé sur planete code source pour les JPG mal reconnu :
-----------------------------------------------------------------------
Sub GetJpegDims(ByVal strFileName, ByRef lngHeight, ByRef lngWidth)
on error resume next
Dim stmFile
set stmFile = server.createobject("ADODB.Stream")
Dim bytArr(256)
dim byt
Dim intPos
With stmFile
.Type = adTypeBinary
.Open
.LoadFromFile strFileName
.Position = 0

for intPos = 0 to 255
.position = intpos
bytArr(intPos) = ascb(.Read(1))
next
.Close
End With
Set stmFile = Nothing

For intPos = 0 To 255
If bytArr(intPos) = &HFF And bytArr(intPos + 1) >= &HC0 _
And bytArr(intPos + 1) <= &HCF Then
lngHeight = bytArr(intPos + 5) * 256 + bytArr(intPos + 6)
lngWidth = bytArr(intPos + 7) * 256 + bytArr(intPos + 8)
Exit For
End If
Next
End Sub
Messages postés
26
Date d'inscription
vendredi 1 février 2002
Statut
Membre
Dernière intervention
16 août 2002

bien joué

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.