1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
| <%
Class ClassImgDimensions
Public fullPath
Public filesize
Private hauteur
Private largeur
Public GetErrors
Public Property Let RealPath(VRealPath)
fullPath = VRealPath
End Property
Public Property Let VirtualPath(VVirtualPath)
fullPath = server.mappath(VVirtualPath)
End Property
Public Property Get Name()
Name = right(fullpath, len(fullpath)-instrrev(fullpath, "\"))
End Property
'**************** JPEG *************************
Private Sub ExtractJPEG()
Const ForReading = 1
Const SOF = "FFC0"
dim fso, f, fs, hexchar, hexcharbkp, compteur, i, TextHex, pos_SOF
hexcharbkp = "" : compteur = 0 : TextHex = ""
Set fso = server.CreateObject("Scripting.FileSystemObject")
set fs = fso.GetFile(fullpath)
filesize = fs.size
set f = fs.openastextstream(1)
do while not f.atendofstream
hexchar = hex(asc(f.read(1)))
if (hexcharbkp & hexchar) = SOF then
TextHex = TextHex & SOF
for i = 1 to 7
hexchar = hex(asc(f.read(1)))
if len(cstr(hexchar)) = 1 then hexchar = "0" & hexchar
TextHex = TextHex & hexchar
next
if compteur = 1 then
exit do
else
compteur = 1
end if
end if
hexcharbkp = cstr(hexchar)
loop
f.Close
set fso = nothing
TextHex = cstr(TextHex)
pos_SOF = instrrev(TextHex, SOF)
' hauteur
dim pos_height
pos_height = pos_SOF+10
hauteur = HexToInt(mid(TextHex, pos_height, 4))
' largeur
dim pos_width
pos_width= pos_SOF+14
largeur = HexToInt(mid(texthex, pos_width, 4))
End Sub
'***************************************
'************** GIF ********************
Private Sub ExtractGif()
Const ForReading = 1
dim fso, f, fs, w, h
Set fso = server.CreateObject("Scripting.FileSystemObject")
set fs = fso.GetFile(fullpath)
filesize = fs.size
set f = fs.openastextstream(1)
f.skip(6)
w = f.read(2)
h = f.read(2)
f.Close
set fso = nothing
largeur = StrtoShort(w)
hauteur = StrtoShort(h)
End Sub
Private function StrtoShort(string)
dim i, artemp(1)
for i=1 to 2
artemp(i-1) = asc(mid(string, i, 1))
next
artemp(1) = artemp(1) * 2^8
StrtoShort = artemp(0) + artemp(1)
End function
'*************************************
'************** PNG ********************
Private Sub ExtractPNG()
Const ForReading = 1
dim fso, f, fs, w, h, hexchar
Set fso = server.CreateObject("Scripting.FileSystemObject")
set fs = fso.GetFile(fullpath)
filesize = fs.size
set f = fs.openastextstream(1)
f.skip(16)
for i=1 to 4
hexchar = hex(asc(f.read(1)))
if len(cstr(hexchar)) = 1 then hexchar = "0" & hexchar
w = w & hexchar
next
for i=1 to 4
hexchar = hex(asc(f.read(1)))
if len(cstr(hexchar)) = 1 then hexchar = "0" & hexchar
h = h & hexchar
next
f.Close
set fso = nothing
hauteur = HEXtoINT(w)
largeur = HEXtoINT(h)
End Sub
'*************************************
Private function HEXtoINT(HexnumberStr)
dim i, Intnumber, lenHexnumberStr, charhex
Intnumber = 0 : lenHexnumberStr = len(HexnumberStr)
for i = 1 to lenHexnumberStr
charhex = mid(hexnumberStr, i, 1)
charhex = ConvertCharHEX(charhex)
Intnumber = Intnumber + cint(charhex)*16^(lenHexnumberStr-i)
next
HEXtoINT = Intnumber
End function
Private function ConvertCharHEX(charHEX)
if asc(charHEX)>57 then
if asc(charHEX)<71 then
ConvertCharHEX = 10 + asc(charHEX) - 65
else
ConvertCharHEX = 10 + asc(charHEX) - 97
end if
else
ConvertCharHEX = charHEX
end if
End function
Public function GetSize()
on error resume next
dim sizes(1)
select case(Extract_ext())
case "gif"
ExtractGif()
case "jpg"
ExtractJPEG()
case "png"
ExtractPNG()
case else
err.raise
end select
sizes(0) = hauteur
sizes(1) = largeur
if err.number>0 then
if err.number = 53 then
GetErrors = "Impossible de récupérer les dimensions de l'image.<br>Vérifiez le chemin du fichier <font color=""#990000""><b>" & name & "</b></font>."
else
GetErrors = "Le fichier <font color=""#990000""><b>" & name & "</b></font> n'est pas un fichier image valide.<br>Vous devez donner un fichier image avec l'une des extensions suivantes : *.<b>png</b>, *.<b>gif</b>, *.<b>jpg</b>."
end if
exit function
end if
GetSize = sizes
End function
Private function Extract_ext()
dim ext
ext = right(fullpath, 3)
Extract_ext = ext
End function
End Class
%> |
