<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>
本文地址：http://com.8s8s.com/it/it7865.htm