Server #######################################
This article belongs to [rain Wave] All rights reserved, reprint must declare
#######################################
Recently do the website picture plate, because the virtual host does not support the other side components, helpless.
The layout of the picture is a big problem. After careful analysis. Online Pictures General
is a picture set. In other words, some of the relevant pictures are about the same size.
Okay,!!!!.
The picture's length and width are proportional. If we look up a similar scale from the database
The picture will be very good to solve the problem of typesetting
The long width of the picture can be obtained through the following code when uploading:
Set up class:
Class Imginfo
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
Err.Clear
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
Private 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)
Cas?? Aralia???,? E "ffd8ff":
Todo
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
Public Function IMGW (Pic_path)
Set FSO1 = server. CreateObject ("Scripting.FileSystemObject")
If (FSO1. FileExists (Pic_path)) Then
Set f1 = Fso1. GetFile (Pic_path)
Ext=fso1. Getextensionname (Pic_path)
Select Case Ext
Case "GIF", "BMP", "JPG", "PNG":
Arr=getimagesize (F1.path)
IMGW = arr (1)
End Select
Set f1=nothing
Else
IMGW = 0
End If
Set fso1=nothing
End Function
Public Function IMGH (Pic_path)
Set FSO1 = server. CreateObject ("Scripting.FileSystemObject")
If (FSO1. FileExists (Pic_path)) Then
Set f1 = Fso1. GetFile (Pic_path)
Ext=fso1. Getextensionname (Pic_path)
Select Case Ext
Case "GIF", "BMP", "JPG", "PNG":
Arr=getimagesize (F1.path)
IMGH = arr (2)
End Select
Set f1=nothing
Else
IMGH = 0
End If
Set
