::::::: 此程序属扬子原创 ::::::::::::::::::
:::::: 在sql2000,2000s中测试通过::::::::
:::::::联系我:qq:21112856,email:yangzinet@hotmail.com:::::::::
::::::: http://www.tingfo.net ::::::
up.htm
.tx1 { height: 20px; width: 30px; font-size: 9pt; border: 1px solid; border-color: black black
#000000; color: #0000ff}
–>
var bgc_on=new array("#74d738","#ff9c17","#3278ab","#486177","#078c00","#007eca")
var bgc_off=new array("#4cad12","ffb859","5f9fd0","577590","08a700","009fff")
function turnon(obj1,id){
obj1.style.background=bgc_on[id];
}
function turnoff(obj1,id){
obj1.style.background=bgc_off[id];
}
//–>
function check_input()
{
if (frm.pic.value=="")
{ alert("请选择要上传的图片");
return false;
}
if (frm.type.value=="")
{ alert("请选择图片类型");
return false;
}
if (frm.thetext.value=="")
{ alert("请输入照片说明");
return false;
}
return true;
}
![]() |
| set rs=server.createobject("adodb.recordset") sql="select * from photo where author="&username&"" rs.open sql,conn,1,1 %>
|
fupload.inc
限制上传图片大小
dim uploadsizelimit
********************************** 得到上传数据 **********************************
function getupload()
dim result
set result = nothing
if request.servervariables("request_method") = "post" then request method must be "post"
dim ct, posb, boundary, length, pose
ct = request.servervariables("http_content_type") reads content-type header
if lcase(left(ct, 19)) = "multipart/form-data" then content-type header must be "multipart/form-data"
this is upload request.
get the boundary and length from content-type header
posb = instr(lcase(ct), "boundary=") finds boundary
if posb > 0 then boundary = mid(ct, posb + 9) separetes boundary
length = clng(request.servervariables("http_content_length")) get content-length header
if "" & uploadsizelimit<>"" then
uploadsizelimit = clng(uploadsizelimit)
if length > uploadsizelimit then
on error resume next clears the input buffer
response.addheader "connection", "close"
on error goto 0
request.binaryread(length)
err.raise 2, "getupload", "upload size " & formatnumber(length,0) & "b exceeds limit of " & formatnumber(uploadsizelimit,0) & "b"
exit function
end if
end if
if length > 0 and boundary <> "" then are there required informations about upload ?
boundary = "–" & boundary
dim head, binary
binary = request.binaryread(length) reads binary data from client
retrieves the upload fields from binary data
set result = separatefields(binary, boundary)
binary = empty clear variables
else
err.raise 10, "getupload", "zero length request ."
end if
else
err.raise 11, "getupload", "no file sent."
end if
else
err.raise 1, "getupload", "bad request method."
end if
set getupload = result
end function
function separatefields(binary, boundary)
dim posopenboundary, poscloseboundary, posendofheader, islastboundary
dim fields
boundary = stringtobinary(boundary)
posopenboundary = instrb(binary, boundary)
poscloseboundary = instrb(posopenboundary + lenb(boundary), binary, boundary, 0)
set fields = createobject("scripting.dictionary")
do while (posopenboundary > 0 and poscloseboundary > 0 and not islastboundary)
header and file/source field data
dim headercontent, fieldcontent
header fields
dim content_disposition, formfieldname, sourcefilename, content_type
helping variables
dim field, twocharsafterendboundary
get end of header
posendofheader = instrb(posopenboundary + len(boundary), binary, stringtobinary(vbcrlf + vbcrlf))
separates field header
headercontent = midb(binary, posopenboundary + lenb(boundary) + 2, posendofheader – posopenboundary – lenb(boundary) – 2)
separates field content
fieldcontent = midb(binary, (posendofheader + 4), poscloseboundary – (posendofheader + 4) – 2)
separates header fields from header
getheadfields binarytostring(headercontent), content_disposition, formfieldname, sourcefilename, content_type
create one field and assign parameters
set field = createuploadfield()
field.name = formfieldname
field.contentdisposition = content_disposition
field.filepath = sourcefilename
field.filename = getfilename(sourcefilename)
field.contenttype = content_type
field.value = fieldcontent
field.length = lenb(fieldcontent)
fields.add formfieldname, field
is this ending boundary ?
twocharsafterendboundary = binarytostring(midb(binary, poscloseboundary + lenb(boundary), 2))
binary.mid(poscloseboundary + len(boundary), 2).string
islastboundary = twocharsafterendboundary = "–"
if not islastboundary then this is not ending boundary – go to next form field.
posopenboundary = poscloseboundary
poscloseboundary = instrb(posopenboundary + lenb(boundary), binary, boundary )
end if
loop
set separatefields = fields
end function
********************************** utilities **********************************
function binarytostring(str)
strto = ""
for i=1 to lenb(str)
if ascb(midb(str, i, 1)) > 127 then
strto = strto & chr(ascb(midb(str, i, 1))*256+ascb(midb(str, i+1, 1)))
i = i + 1
else
strto = strto & chr(ascb(midb(str, i, 1)))
end if
next
binarytostring=strto
end function
function stringtobinary(string)
dim i, b
for i=1 to len(string)
b = b & chrb(asc(mid(string,i,1)))
next
stringtobinary = b
end function
separates header fields from upload header
function getheadfields(byval head, content_disposition, name, filename, content_type)
content_disposition = ltrim(separatefield(head, "content-disposition:", ";"))
name = (separatefield(head, "name=", ";")) ltrim
if left(name, 1) = """" then name = mid(name, 2, len(name) – 2)
filename = (separatefield(head, "filename=", ";")) ltrim
if left(filename, 1) = """" then filename = mid(filename, 2, len(filename) – 2)
content_type = ltrim(separatefield(head, "content-type:", ";"))
end function
separets one filed between sstart and send
function separatefield(from, byval sstart, byval send)
dim posb, pose, sfrom
sfrom = lcase(from)
posb = instr(sfrom, sstart)
if posb > 0 then
posb = posb + len(sstart)
pose = instr(posb, sfrom, send)
if pose = 0 then pose = instr(posb, sfrom, vbcrlf)
if pose = 0 then pose = len(sfrom) + 1
separatefield = mid(from, posb, pose – posb)
else
separatefield = empty
end if
end function
separetes file name from the full path of file
function getfilename(fullpath)
dim pos, posf
posf = 0
for pos = len(fullpath) to 1 step -1
select case mid(fullpath, pos, 1)
case "/", "\": posf = pos + 1: pos = 0
end select
next
if posf = 0 then posf = 1
getfilename = mid(fullpath, posf)
end function
//the function creates field object.
function createuploadfield(){ return new uf_init() }
function uf_init(){
this.name = null
this.contentdisposition = null
this.filename = null
this.filepath = null
this.contenttype = null
this.value = null
this.length = null
}
addphoto.asp
if request.servervariables("request_method") = "post" then
dim fields
uploadsizelimit=100000
set fields = getupload()
dim field
for each field in fields.items
select case field.name
case "thetext" sss=binarytostring(field.value)
case "type" fff=binarytostring(field.value)
case "submit" submit=binarytostring(field.value)
case "pic"
filename=field.filename
filecontenttype=field.contenttype
filevalue=field.value
end select
next
—————
if filename<>"" and filecontenttype<>"image/gif" and
filecontenttype<>"image/pjpeg" then
%>
上传的照片应该为gif或jpg文件!
else
————
开始输入
———–
response.write sss
response.write"
"
response.write fff
set rs=server.createobject("adodb.recordset")
sql = "select * from tb where theid is null"
rs.open sql,conn,3,3
rs.addnew
rs("author")=username
rs("thetext")=sss
rs("types")=fff
rs("hits")=1
rs("posttime")=now()
rs("photo").appendchunk filevalue
rs.update
rs.close
%>
size=3>成功输入个人基本档案!
action="personinf.asp">
end if
end if
%>
showpic.asp
id=request("id")
set rs=server.createobject("adodb.recordset")
sql="select * from tb where theid="&id
rs.open sql,conn,1,3
response.contenttype="image/gif"
response.binarywrite rs("photo")
%>