一种图片的上传（保存图片的尺寸，图片以OLE对象存在）（同时上传五张）

<html>

<!--

function xxg()

{

if (frmadd.file1.value=="" && frmadd.file2.value=="" && frmadd.file3.value=="" && frmadd.file4.value=="" && frmadd.file5.value=="")

{

alert("图片路径？");

return false;

}

return true;

}

//-->

</script>

</head>

<body>

<tr>

</tr>

<tr>

</tr>

<tr>

</tr>

<tr>

</tr>

<tr>

</tr>

<tr>

</div></td>

</tr></form>

</table>

</center>

</div>

</body></html>

----------------------------add.asp------------------------------------

<body>

'图片管理程序---上传代码开始

function lngConvert2(strTemp)

str1=leftb(strTemp,1)

str2=rightb(strTemp,1)

lngConvert2 = clng(ascb(str2) + ((ascb(str1) * 256)))

end function

function lngConvert(strTemp)

str1=leftb(strTemp,1)

str2=rightb(strTemp,1)

len1=ascb(str1)

len2=ascb(str2)

lngConvert = clng(ascb(str1) + ascb(str2) * 256)

end function

Dim FormData,FormSize

FormSize=Request.TotalBytes

FormData=Request.BinaryRead(FormSize)

Set Fields = GetUpload(FormData)

for i=1 to 5 '获得图片的宽度和高度

If Fields("file"&i).FileName<>"" and Fields("file"&i).value<>"" Then

tempstr=Leftb(Fields("file"&i).Value,10)

tstr=chrb(255)&chrb(216)&chrb(255)&chrb(224)&chrb(0)&chrb(16)&chrb(74)&chrb(70)&chrb(73)&chrb(70)

flag=1

if strcomp(tempstr,tstr,0)=0 then

lngSize = len(fields("file"&i).value)

flgFound = 0

strTarget = chrb(255) & chrb(216) & chrb(255) 'JPG

flgFound = instrb(fields("file"&i).value, strTarget)

if flgFound = 0 then

response.write "<br><br><br><br><p align=center>图片上传有可能错误!是否继续上传?<br><Br>(图像也许没有经过处理)<br><br><br>"

response.write "<a href='add.asp' title='继续上传'><font color='#000000'>是</font></a><font color='#FFFFFF'>图片上传</font><a href='manage.asp' title='返回图片管理'><font color='#000000'>否</font></a>"

response.end

end if

strImageType = "JPG"

lngPos = flgFound + 2

ExitLoop = false

do while ExitLoop = False and lngPos < lngSize

do while ascb(midb(fields("file"&i).value, lngPos, 1)) = 255 and lngPos < lngSize

lngPos = lngPos + 1

loop

if ascb(midb(fields("file"&i).value, lngPos, 1)) < 192 or ascb(midb(fields("file"&i).value, lngPos, 1)) > 195 then

lngMarkerSize = lngConvert2(midb(fields("file"&i).value, lngPos + 1, 2))

lngPos = lngPos + lngMarkerSize + 1

else

ExitLoop = True

end if

loop

height = lngConvert2(midb(fields("file"&i).value, lngPos +4, 2))

width = lngConvert2(midb(fields("file"&i).value, lngPos +6, 2))

flag=2

else

flag=0

end if

if flag<>2 then

tempstr=Leftb(Fields("file"&i).Value,6)

tstr=chrb(71)&chrb(73)&chrb(70)&chrb(56)&chrb(57)&chrb(97)

tstr2=chrb(71)&chrb(73)&chrb(70)&chrb(56)&chrb(55)&chrb(97)

if strcomp(tempstr,tstr,0)=0 or strcomp(tempstr,tstr2)=0 then

width=lngConvert(midb(fields("file"&i).value,7,2))

height=lngConvert(midb(fields("file"&i).value,9,2))

flag=2

else

flag=0

end if

if flag<>2 then

tempstr=Leftb(Fields("file"&i).Value,2)

tstr=chrb(66)&chrb(77) 'BMP

if strcomp(tempstr,tstr,0)=0 then

width=lngConvert(midb(fields("file"&i).value,19,2))

height=lngConvert(midb(fields("file"&i).value,23,2))

flag=2

else

flag=0

end if

if flag<>2 then

tempstr=Leftb(Fields("file"&i).Value,4)

tstr=chrb(137)&chrb(80)&chrb(78)&chrb(71) 'PNG

if strcomp(tempstr,tstr,0)=0 then

width = lngConvert2(midb(fields("file"&i).value, 19, 2))

height = lngConvert2(midb(fields("file"&i).value, 23, 2))

flag=2

else

flag=0

end if

if flag>0 then

Set rs = Server.CreateObject("ADODB.Recordset")

sql="select * from pho where id is null"

rs.open sql,conn,1,3

fieldsdata=Array("dandt","width","height","photo")

valuesdata=Array(now,width,height,"")

rs.addnew fieldsdata,valuesdata

set field=rs.fields("photo")

field.appendchunk Fields("file"&i).Value

ttt=replace(Fields("file"&i).Value,"'","''")

Rs.Update

rs.close

set rs=nothing

else

response.write "<script>alert('图像格式不对,不能保存图像.请经过处理后再上传!');this.location.href='add.asp';</script>"

response.End()

end if

else

end if

sql3="select * from pho where photo=''"

set rs3=server.CreateObject("adodb.recordset")

rs3.open sql3,conn,1,3

if (not rs3.eof) or (not rs3.bof) then

conn.execute("delete * from pho where photo=''")

end if

rs3.close

set rs3=nothing

response.write "<br><br><br><br><p align=center>图片上传成功!是否继续上传?<br><br><br><br>"

response.end

connclose%>

</body></html>

--------------------------------------upload.inc------------

Function GetUpload(FormData)

Dim DataStart,DivStr,DivLen,DataSize,FormFieldData

''分隔标志串(+CRLF)

DivStr = LeftB(FormData,InStrB(FormData,str2bin(VbCrLf)) + 1)

''分隔标志串长度

DivLen = LenB(DivStr)

PosOpenBoundary = InStrB(FormData,DivStr)

PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)

Set Fields = CreateObject("Scripting.Dictionary")

While PosOpenBoundary > 0 And PosCloseBoundary > 0

''name起始位置(name="xxxxx")，加6是因为[name="]长度为6

FieldNameStart = InStrB(PosOpenBoundary,FormData,str2bin("name=")) + 6

FieldNameSize = InStrB(FieldNameStart,FormData,ChrB(34)) - FieldNameStart ''(")的ASC值=34

FormFieldName = bin2str(MidB(FormData,FieldNameStart,FieldNameSize))

''filename起始位置(filename="xxxxx")

FieldFileNameStart = InStrB(PosOpenBoundary,FormData,str2bin("filename=")) + 10

If FieldFileNameStart < PosCloseBoundary And FieldFileNameStart > PosopenBoundary Then

FieldFileNameSize = InStrB(FieldFileNameStart,FormData,ChrB(34)) - FieldFileNameStart ''(")的ASC值=34

FormFileName = bin2str(MidB(FormData,FieldFileNameStart,FieldFileNameSize))

Else

FormFileName = ""

End If

''Content-Type起始位置(Content-Type: xxxxx)

FieldFileCTStart = InStrB(PosOpenBoundary,FormData,str2bin("Content-Type:")) + 14

If FieldFileCTStart < PosCloseBoundary And FieldFileCTStart > PosOpenBoundary Then

FieldFileCTSize = InStrB(FieldFileCTStart,FormData,str2bin(VbCrLf & VbCrLf)) - FieldFileCTStart

FormFileCT = bin2str(MidB(FormData,FieldFileCTStart,FieldFileCTSize))

Else

FormFileCT = ""

End If

''数据起始位置：2个CRLF开始

DataStart = InStrB(PosOpenBoundary,FormData,str2bin(VbCrLf & VbCrLf)) + 4

If FormFileName <> "" Then

''数据长度，减1是因为数据文件的存取字节数问题(可能是AppendChunk方法的问题)：

''由于字节数为奇数的图象存到数据库时会去掉最后一个字符导致图象不能正确显示,

''字节数为偶数的数据文件就不会出现这个问题，因此必须保持字节数为偶数。

DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 1

FormFieldData = MidB(FormData,DataStart,DataSize)

Else

''数据长度，减2是因为分隔标志串前有一个CRLF

DataSize = InStrB(DataStart,FormData,DivStr) - DataStart - 2

FormFieldData = bin2str(MidB(FormData,DataStart,DataSize))

End If

''建立一个Dictionary集存储Form中各个Field的相关数据

Set Field = CreateUploadField()

Field.Name = FormFieldName

Field.FilePath = FormFileName

Field.FileName = GetFileName(FormFileName)

Field.ContentType = FormFileCT

Field.Length = LenB(FormFieldData)

Field.Value = FormFieldData

Fields.Add FormFieldName, Field

PosOpenBoundary = PosCloseBoundary

PosCloseBoundary = InStrB(PosOpenBoundary + 1,FormData,DivStr)

Wend

Set GetUpload = Fields

End Function

''把二进制字符串转换成普通字符串函数

Function bin2str(binstr)

Dim varlen,clow,ccc,skipflag

''中文字符Skip标志

skipflag=0

ccc = ""

If Not IsNull(binstr) Then

varlen=LenB(binstr)

For i=1 To varlen

If skipflag=0 Then

clow = MidB(binstr,i,1)

''判断是否中文的字符

If AscB(clow) > 127 Then

''AscW会把二进制的中文双字节字符高位和低位反转，所以要先把中文的高低位反转

ccc =ccc & Chr(AscW(MidB(binstr,i+1,1) & clow))

skipflag=1

Else

ccc = ccc & Chr(AscB(clow))

End If

Else

skipflag=0

End If

bin2str = ccc

End Function

''把普通字符串转成二进制字符串函数

Function str2bin(varstr)

str2bin=""

For i=1 To Len(varstr)

varchar=mid(varstr,i,1)

varasc = Asc(varchar)

'' asc对中文字符求出来的值可能为负数，

'' 加上65536就可求出它的无符号数值

'' -1在机器内是用补码表示的0xffff,

'' 其无符号值为65535,65535=-1+65536

'' 其他负数依次类推。

If varasc<0 Then

varasc = varasc + 65535

End If

''对中文的处理：把双字节低位和高位分开

If varasc>255 Then

varlow = Left(Hex(Asc(varchar)),2)

varhigh = right(Hex(Asc(varchar)),2)

str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh)

Else

str2bin = str2bin & chrB(AscB(varchar))

End If

End Function

''取得文件名(去掉Path)

Function GetFileName(FullPath)

If FullPath <> "" Then

FullPath = StrReverse(FullPath)

FullPath = Left(FullPath, InStr(1, FullPath, "\") - 1)

GetFileName = StrReverse(FullPath)

Else

GetFileName = ""

End If

End Function

</SCRIPT>

function CreateUploadField(){ return new uf_Init() }

function uf_Init(){

this.Name = null

this.FileName = null

this.FilePath = null

this.ContentType = null

this.Value = null

this.Length = null

}

</SCRIPT>