The basic principle is to use ADODB. Stream to read and parse binary files, and then return an array
The first element is of type (bmp jpg png gif swf)
The second element is width {width}
The third element is the height {height}
The fourth element is a string with width = {width} and Height = {height }.
- <%
- '''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''
- 'When uploading an image or displaying SWF, you want to get its height and width.
- '----------------------------------------------
- 'Basic principle: Read the binary file using ADODB. Stream and parse it. Then an array is returned.
- 'The first element is of type (bmp jpg png gif swf)
- 'The second element is the width {width}
- 'The third element is the height {height}
- 'The fourth element is a string with width = {width} and Height = {height }.
- '''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''
- Class qswhimg
- Dim Aso
- Private sub class_initialize
- Set Aso = Createobject ("ADODB. Stream ")
- Aso. mode = 3
- Aso. type = 1
- Aso. Open
- End sub
- Private sub class_terminate
- Set Aso = nothing
- End sub
- Private function bin2str (BIN)
- Dim I, STR
- For I = 1 to lenb (BIN)
- Clow = midb (bin, I, 1)
- If ASCB (Clow) <128 then
- STR = STR & CHR (ASCB (Clow ))
- Else
- I = I + 1
- If I <= lenb (BIN) then STR = STR & CHR (ASCW (midb (bin, I, 1) & Clow ))
- End if
- Next
- Bin2str = Str
- End Function
- Private function num2str (Num, base, lens)
- Dim RET
- Ret = ""
- While (Num> = Base)
- Ret = (Num mod base) & RET
- Num = (num-num mod base)/base
- Wend
- Num2str = right (string (lens, "0") & num & ret, lens)
- End Function
- Private function str2num (STR, Base)
- Dim RET
- Ret = 0
- For I = 1 to Len (STR)
- Ret = RET * base + CINT (mid (STR, I, 1 ))
- Next
- Str2num = RET
- End Function
- Private function binval (BIN)
- Dim RET
- Ret = 0
- For I = lenb (BIN) to 1 step-1
- Ret = RET * 256 + ASCB (midb (bin, I, 1 ))
- Next
- Binval = RET
- End Function
- Private function binval2 (BIN)
- Dim RET
- Ret = 0
- For I = 1 to lenb (BIN)
- Ret = RET * 256 + ASCB (midb (bin, I, 1 ))
- Next
- Binval2 = RET
- End Function
- Function getimagesize (filespec)
- Dim RET (3)
- Aso. loadfromfile (filespec)
- Bflag = ASO. Read (3)
- Select case hex (binval (bflag ))
- Case "4e5089 ":
- Aso. Read (15)
- RET (0) = "PNG"
- RET (1) = binval2 (ASO. Read (2 ))
- Aso. Read (2)
- RET (2) = binval2 (ASO. Read (2 ))
- Case "464947 ":
- Aso. Read (3)
- RET (0) = "GIF"
- RET (1) = binval (ASO. Read (2 ))
- RET (2) = binval (ASO. Read (2 ))
- Case "535746 ":
- Aso. Read (5)
- Bindata = ASO. Read (1)
- Sconv = num2str (ASCB (bindata), 2, 8)
- Nbits = str2num (left (sconv, 5), 2)
- Sconv = mid (sconv, 6)
- While (LEN (sconv) <nbits * 4)
- Bindata = ASO. Read (1)
- Sconv = sconv & num2str (ASCB (bindata), 2, 8)
- Wend
- RET (0) = "SWF"
- RET (1) = int (ABS (str2num (mid (sconv, 1 * nbits + 1, nbits), 2)-str2num (mid (sconv, 0 * nbits + 1, nbits), 2)/20)
- RET (2) = int (ABS (str2num (mid (sconv, 3 * nbits + 1, nbits), 2)-str2num (mid (sconv, 2 * nbits + 1, nbits), 2)/20)
- Case "ffd8ff ":
- Do
- Do: p1 = binval (ASO. Read (1): loop while p1 = 255 and not ASO. Eos
- If P1> 191 and P1 <196 then exit do else ASO. Read (binval2 (ASO. Read (2)-2)
- Do: p1 = binval (ASO. Read (1): loop while P1 <255 and not ASO. Eos
- Loop while true
- Aso. Read (3)
- RET (0) = "jpg"
- RET (2) = binval2 (ASO. Read (2 ))
- RET (1) = binval2 (ASO. Read (2 ))
- Case else:
- If left (bin2str (bflag), 2) = "BM" then
- Aso. Read (15)
- RET (0) = "BMP"
- RET (1) = binval (ASO. Read (4 ))
- RET (2) = binval (ASO. Read (4 ))
- Else
- RET (0) = ""
- End if
- End select
- RET (3) = "width =" & RET (1) "" Height = "& RET (2 )""""
- Getimagesize = RET
- End Function
- End Class
- 'Example (read the width of all images in a directory ):
- Set qswh = new qswhimg
- Set FSO = Createobject ("scripting. FileSystemObject ")
- 'Set F = FSO. getfolder (server. mappath ("/update/pic_tem /"))
- 'Set fc = f. Files
- 'For each F1 in FC
- 'Ext = FSO. getextensionname (f1.path)
- 'Select case ext
- 'Case "GIF", "BMP", "jpg", "PNG ":
- 'Arr = qswh. getimagesize (f1.path)
- 'Response. write "<br>" & Arr (0) & "" & Arr (3) & ":" & f1.name & "width:" & Arr (1) & "height: "& Arr (2)
- 'Case "SWF"
- 'Arr = qswh. getimagesize (f1.path)
- 'Response. write "<br>" & Arr (0) & "" & Arr (3) & ":" & f1.name & "width:" & Arr (1) & "height: "& Arr (2)
- 'End select
- 'Next
- Response. Write ("<HR> ")
- Show_picwh = qswh. getimagesize (server. mappath ("/update/pic_tem/200852414295626.jpg "))
- Response. write ("image path:" & server. mappath ("/update/pic_tem/200852414295626.jpg")" <br> image format: "& show_picwh (0) &" <br> Image Width: "& show_picwh (1) & "<br> Image Height:" & show_picwh (2 ))
- Set fc = nothing
- Set F = nothing
- Set FSO = nothing
- Set qswh = nothing
- %>
- ========================================================== ==========================================
- '''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''
- 'Function name: return_qswhimg_str
- 'Function functions:
- 'Use the class qswhimg to scale down an image to one value in proportion.
- 'If the image size is smaller than the set value, the image will be taken as the original size, not processed
- 'Note:
- 'Url image address
- 'Wh image size range
- 'Return the image width =__ or height =__ string
- 'Call instance: border = "0">
- 'Date: 2008-06
- '''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''
- Function return_qswhimg_str (URL, Wh)
- On Error resume next
- If url = "" Or isnull (URL) or wh = "" Then exit function
- Set qswh = new qswhimg
- Set FSO = Createobject ("scripting. FileSystemObject ")
- Show_picwh = qswh. getimagesize (server. mappath ("/" & URL ))
- If CINT (show_picwh (1)> = CINT (show_picwh (2) and CINT (show_picwh (1)> wh then
- If show_picwh (1)> wh then show_picwh_str = "width ="
- Elseif CINT (show_picwh (1) <CINT (show_picwh (2) and CINT (show_picwh (2)> wh then
- If show_picwh (2)> wh then show_picwh_str = "Height ="
- Else
- Show_picwh_str = ""
- End if
- Set FSO = nothing
- Set qswh = nothing
- Return_qswhimg_str = show_picwh_str
- End Function
