按比例缩小图片(无组件)

无组件

<%
Class possible
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

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)
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

Function readX(pic_path)
Set fso1 = server.CreateObject("Scripting.FileSystemObject")
Set f1 = fso1.GetFile(pic_path)
ext=fso1.GetExtensionName(pic_path)
select case ext
case "gif","bmp","jpg","png":
arr=getImageSize(f1.path)
Response.Write arr(1)
case "swf"
arr=pp.getimagesize(f1.path)
Response.Write arr(1)
end select
Set f1=nothing
Set fso1=nothing
End Function

Function readY(pic_path)
Set fso1 = server.CreateObject("Scripting.FileSystemObject")
Set f1 = fso1.GetFile(pic_path)
ext=fso1.GetExtensionName(pic_path)
select case ext
case "gif","bmp","jpg","png":
arr=getImageSize(f1.path)
Response.Write arr(2)
case "swf"
arr=pp.getimagesize(f1.path)
Response.Write arr(2)
end select
Set f1=nothing
Set fso1=nothing
End Function
End Class
%>

例子:

<!--#includ

时间: 2024-08-02 00:34:24

按比例缩小图片(无组件)的相关文章

无组件上传图片到数据库中,最完整解决方案,(可限制图片格式以及大小) 建议入精华

解决|精华|上传|上传图片|数据|数据库|无组件 '::::::: 此程序属扬子原创 ::::::::::::::::::':::::: 在sql2000,2000s中测试通过::::::::':::::::联系我:QQ:21112856,Email:yangzinet@hotmail.com:::::::::'::::::: http://www.tingfo.net :::::: up.htm <!--#include file="inc/domin.asp"-->&l

无组件上传文字与图片至数据库之gztiger解决方案

解决|上传|数据|数据库|无组件 曾一度为图片与文字上传至数据库困扰,<化境无组件上传图片2.0>写得很好,但不是完全适合自己.经过认真阅读源代码.修改与测试,将其改为无组件上传多条文字信息与多张图片至数据库.并在iis5+access2000+asp测试通过.现把源代码公布,希望能对那些曾经也被这问题困扰的朋友有所帮助.同时希望各位同道斧正. 声明:<化境无组件上传图片2.0>并非我写的,在此对<化境无组件上传图片2.0>的作者真诚说声:谢谢!代码如下: upfile

无组件图片与文本同步存入数据库的最简单的办法

数据|数据库|无组件 无组件图片与文本同步存入数据库的最简单的办法 动感教育网 发布日期:2001-7-17 字数:4798 一:前言 首先,没有料到图片与文本的上传会引起这么大的注意.上一篇贴子(Id=435906)贴出后,有不少人来信说看不懂.或是仍然不能实现.我就以一种完全简单的手法.完成无组件的文本与图片上传数据库所有过程.希望能帮助所有对此有疑问的网友. 二:准备工作 按照惯例,我先将我的测试环境告诉大家.系统:Win98se + pws + asp 编程环境:Visual Inter

ASP中取得图片宽度和高度的类(无组件)_应用技巧

ASP中取得图片宽度和高度的类(无组件) <% Class ImgWHInfo '获取图片宽度和高度的类,支持JPG,GIF,PNG,BMP     Dim ASO     Private Sub Class_Initialize         Set ASO=Server.CreateObject("ADODB.Stream")         ASO.Mode=3         ASO.Type=1         ASO.Open     End Sub     Pri

无组件不能上传rar,zip其它非图片文件

昨天在使用无组件上传文件的时候,遇到了这个问题:  上传图片文件没有问题,上传rar,zip,wmv等其它非图片文件就出错.  服务器是window2003.  开始我以为是无组件问题,于是我换了几个无组件者出现了同样的错误(IIS提示错误:无法操作),然后我又换了一台window2003机器,试了一下,也出现了错误.我想这不应该是无组件问题了.  于是,我打开google,终于找到原因了.  原因是:window2003限制了上传文件的大小,最大只能是200K.  找到原因后,我再试着上传一张

ASP中取得图片宽度和高度的类(无组件)

无组件|无组件 <%Class ImgWHInfo '获取图片宽度和高度的类,支持JPG,GIF,PNG,BMP Dim ASO Private Sub Class_Initialize Set ASO=Server.CreateObject("ADODB.Stream") ASO.Mode=3 ASO.Type=1 ASO.Open End Sub Private Sub Class_Terminate Err.Clear Set ASO=Nothing End Sub Pri

无组件上传实例

上传|无组件 这是我从我以前写过的程序中分离出来的,由于这段代码是针对整体成体程序写的,因此功能非常简单,而且对于上传的数据也没有严格的限制,所以难免会出现这样或那样的错误. 我贴着篇文章主要是让大家了解一下无组件上传的思路,而不是让大家使用的. <% 'Yanhang.00上传程序V1.0'1.0版本的程序是从以前的程序修改过来的,但是可能还是仍有不足,如果你发现任何错误,请写信通知我,谢谢!'请在使用前先修改下面的信息'目前本程序我认为最大的不足就是只能用系统时间定义文件名,不能使用源文件名

用Canvas做的ASP无组件生成图片验证码

无组件|验证码 点击这里下载源码 相关图片如下:Dim objCanvasDim PointX,PointY,PointColorDim iTempDim SafeCodeDim R,G,B,cc,kk     Const cAmount = 36 ' 文字数量    Const cCode = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"cc=80kk=30SafeCode = ""Session("SafeCode&qu

Asp无组件文件上传的实例

上传|无组件 1.库文件(upload.inc.asp)<%Dim oUpFileStream Class UpFile_Class Dim Form,File,Version,Err Private Sub Class_InitializeVersion = "无组件上传类 Version V1.0"Err = -1End Sub Private Sub Class_Terminate '清除变量及对像If Err < 0 ThenForm.RemoveAllSet Fo