ASP без компонента, генерируя диаграмму усадки

<%

'/////////// GPS: get imprure size ///////////////////////////////// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////gons

'///////////// Use adodb.stream to get the picture size //////////////

'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

Класс GPS

DIM ASO

Private sub class_initialize

SET ASO = createObject (adodb.stream)

aso.mode = 3

aso.type = 1

aso.open

Конец суб

Приватный sub class_terminate

установить aso = ничего

Конец суб

Частная функция bin2str (bin)

Dim I, Str

Для i = 1 до lenb (bin)

Clow = MidB (Bin, I, 1)

Если ASCB (Clow) <128, тогда

Str = str & chr (ascb (clow))

Еще

I = 1 1

Если i <= lenb (bin), то str = str & chr (ascw (midb (bin, i, 1) и clow)))

конец, если

Следующий

Bin2str = str

Конечная функция

Частная функция num2str (num, base, объектив)

'GPS (2005-8-11)

Dim ret

Ret =

While (num> = base)

Ret = (база Num Mod) и RET

num = (num -num mod base)/base

Венд

Num2str = right (строка (объектив, 0) и num & ret, объектив)

Конечная функция

Частная функция str2num (str, base)

'GPS (2005-8-11)

Dim ret

Ret = 0

для i = 1 до Лена (Str)

Ret = ret *base cint (mid (str, i, 1))

следующий

Str2num = ret

Конечная функция

Частная функция Binval (Bin)

'GPS (2002-8-11)

Dim ret

Ret = 0

для i = lenb (bin) до 1 шага -1

Ret = ret *256 ASCB (MidB (Bin, I, 1))

следующий

Binval = ret

Конечная функция

Частная функция binval2 (bin)

'GPS (2002-8-11)

Dim ret

Ret = 0

для i = 1 до lenb (bin)

Ret = ret *256 ASCB (MidB (Bin, I, 1))

следующий

Binval2 = ret

Конечная функция

'/// следующее приведено код вызова ///

Функция getImagesize (filepec)

'GPS (2002-8-11)

Dim ret (3)

Aso.loadfromfile (filepec)

bflag = aso.read (3)

Выберите Case Hex (Binval (BFLAG))

Случай 4E5089:

aso.read (15)

Ret (0) = png

Ret (1) = binval2 (aso.read (2))

aso.read (2)

Ret (2) = binval2 (aso.read (2))

Случай 464947:

aso.read (3)

Ret (0) = GIF

Ret (1) = binval (aso.read (2))

Ret (2) = binval (aso.read (2))

Случай 535746:

aso.read (5)

bindata = aso.read (1)

Sconv = num2str (ascb (bindata), 2, 8)

nbits = str2num (слева (sconv, 5), 2)

Sconv = mid (sconv, 6)

While (len (sconv) <nbits*4)

bindata = aso.read (1)

Sconv = sconv & num2str (ascb (bindata), 2, 8)

Венд

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: p1 = binval (aso.read (1)): цикл, пока p1 = 255, а не aso.eos

Если P1> 191 и P1 <196 Exit Do Else.read (binval2 (aso.read (2))-2)

do: p1 = binval (aso.read (1)): цикл, пока P1 <255, а не Aso.eos

Петля в то время как правда

aso.read (3)

Ret (0) = jpg

Ret (2) = binval2 (aso.read (2))

Ret (1) = binval2 (aso.read (2))

Случай еще:

Если осталось (bin2str (bflag), 2) = bm тогда

aso.read (15)

Ret (0) = bmp

Ret (1) = binval (aso.read (4))

Ret (2) = binval (aso.read (4))

еще

Ret (0) =

конец, если

конец выбора

RET (3) = ширина = & ret (1) и высота =

& Ret (2) и

GetImagesize = ret

Конечная функция

Конечный класс

%>