<html> <head><meta http-equiv="Content-Language" content="zh-cn"> <meta name="GENERATOR" content="Microsoft FrontPage 6.0"> <meta name="ProgId" content="FrontPage.Editor.Document"> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <title>图片上传</title> <link href="bbs.css" rel="stylesheet" type="text/css"> <script language="JavaScript"> <!-- 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> <div align="center"> <center> <table border="0" cellspacing="3" width="100%" id="AutoNumber1" height="176"> <form method="post" name="frmadd" enctype="multipart/form-data" onsubmit="return xxg();" action="addok.asp"> <tr> <td height="22"><input style="WIDTH: 430px" type="file" name="file1"></td> </tr> <tr> <td height="22"><input name="file2" type="file" id="file22" style="WIDTH: 430px"></td> </tr> <tr> <td height="22"><input name="file3" type="file" id="file32" style="WIDTH: 430px"></td> </tr> <tr> <td height="22"><input name="file4" type="file" id="file42" style="WIDTH: 430px"></td> </tr> <tr> <td height="22"><input name="file5" type="file" id="file52" style="WIDTH: 430px"> </td> </tr> <tr> <td style="border-style: dotted; border-width: 1"><div align="center"> <input type="submit" name="Submit" value=" 上 传 "> <input type="reset" name="Submit2" value=" 取 消 "> </div></td> </tr></form> </table> </center> </div> </body></html> ----------------------------add.asp------------------------------------ <!--#include file="conn.asp"--> <!--#INCLUDE FILE="upload.inc"--> <html><head> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <title>图片上传</title> <link href="images/bbs.css" rel="stylesheet" type="text/css"></head>
<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 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 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 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 next
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.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 connclose%> </body></html> --------------------------------------upload.inc------------ <SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT> 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 Next 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 Next 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> <SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT> 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>

|