1. Accueil
  2. Tous les snippets
  3. Snippets ASP / ASP.NET
  4. Taille en pixels des gif et jpg placés sur le serveur

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

0/5 (4 avis)

Snippet vu 12 446 fois - Téléchargée 38 fois

Commenter

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
cs_cbu
Messages postés
394
Date d'inscription
mercredi 30 janvier 2002
Statut
Membre
Dernière intervention
4 novembre 2009
 1
8 août 2003 à 16:31
Ca marchait avec des petits JPG .. Est toujours pas trouvé un truc qui marche pour tout !! :(
cs_cbu
Messages postés
394
Date d'inscription
mercredi 30 janvier 2002
Statut
Membre
Dernière intervention
4 novembre 2009
 1
8 août 2003 à 11:32
Si adTypeBinary n'est pas reconnu par votre serveru mettez 1
A+
cs_cbu
Messages postés
394
Date d'inscription
mercredi 30 janvier 2002
Statut
Membre
Dernière intervention
4 novembre 2009
 1
8 août 2003 à 11:31
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
cyril722
Messages postés
26
Date d'inscription
vendredi 1 février 2002
Statut
Membre
Dernière intervention
16 août 2002
1 févr. 2002 à 15:42
bien joué
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.

Du même auteur (BinOff)