无组件上传图片到数据库中,最完整解决方案_组件开发_黑客防线网安服务器维护基地--Powered by WWW.RONGSEN.COM.CN

无组件上传图片到数据库中,最完整解决方案

作者:黑客防线网安网站维护基地 来源:黑客防线网安网站维护基地 浏览次数:0

本篇关键词:组件图片数据库

up.htm

<!--#include file="inc/domin.asp"-->
<!--#include file="conn.asp"-->
<html>
<head>
<title><% =webname %></title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="main.css" type="text/css">
<style type="text/css">
<!--
.tx1 { height: 20px; width: 30px; font-size: 9pt; border: 1px solid; border-color: black black

#000000; color: #0000FF}
-->
</style>

<script language="javascript">
<!--
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];
}

//-->
</script>
<SCRIPT language=javascript>
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;
}
</SCRIPT>
</head>

<body bgcolor="#555555" text="#000000" leftmargin="0" topmargin="0">
<table width=755 cellpadding=0 cellspacing=0 border=0 bgcolor=#ffffff align="center">
<tr>
<td height=100><img src="img/top.gif" align="top">
</table>

<!--#include file="inc/mulu.asp"-->


<table width=755 cellpadding=0 cellspacing=0 border=0 bgcolor=#ffffff align="center" bordercolor=#000000>
<tr>
<td height=400 width=180 bgcolor=#D1E9D5 style="border-right: 1px #0E801E solid">
<table width=100% height=100% cellpadding=0 cellspacing=0 border=0 align="center" bordercolor=#000000>
<tr><td height=30 align="center" class=L15><font color=#E96D08>欢迎你:<% =username %>  管理中心</font>
<tr><td height=23 align="center" class=L15 bgcolor=#4CAD12 style="border-top:0px #0E801E solid; border-bottom:1px #0E801E solid;"><font color=#C2F009 class=yinying>管 理 中 心</font>
<tr><td height=20 class=L13>
<!--#include file="inc/centermulu.asp"-->
<tr><td height=5>
<tr><td>
</table>
<td>
<%
set rs=server.createobject("adodb.recordset")
sql="select * from photo where author='"&username&"'"
rs.open sql,conn,1,1
%>
<table cellpadding=0 cellspacing=0 border=0  width=100% height=100%>
<tr><td height=3>
<tr><td height=3 bgcolor=#ffffff background=img/bj3.gif>
<tr><td height=20 valign="bottom" bgcolor=#eeeeee>  现在位置: 98243班 - 管理中心 - 添加新闻
<tr><td height=3 bgcolor=#eeeeee style="border-bottom: 1px #cccccc solid"><p style="font-size:1pt">
<tr><td height=20 valign="bottom">  <font color=green><% =username %>:你一共上传了 <font color=red><% =rs.recordcount %></font> 张照片</font>        <a href="adminphoto.asp"><font color=red><u>管理以前上传的照片</u></font></a>
<tr><td bgcolor=#ffffff valign=top>
<table cellpadding=0 cellspacing=0 border=0  width=95% height=100% align="center">
<form action=addphoto.asp method=post name=Frm onSubmit="return check_input()" enctype="multipart/form-data">
<tr><td height=20 colspan=2>
<tr><td height=25 width=15% align="right" class=L13>选择照片: <td> <input NAME="pic" TYPE="FILE" class="tx1" style="width:300">  <font color=red>拒绝色情、写真图等</font>

<tr><td height=25 width=20% align="right" class=L13>照片分类: <td> <select name="type">
            <option selected value="">选择类型</option>
            <option value="班级合影">班级合影</option>
            <option value="个人照片">个人照片</option>
            <option value="恩师照片">恩师照片</option>
            <option value="情人照片">情人照片</option>
            <option value="友人照片">友人照片</option>
            <option value="其他照片">其他照片</option>
</select>

<tr><td height=25 width=20% align="right" class=L13>照片说明: <td> <textarea name="thetext" cols="46" rows="7" style="border:1px double rgb(88,88,88);font:9pt">
</textarea>  <font color=red>最多20个字符</font>
<tr><td height=5 colspan=2>
<tr><td height=25 colspan=2 align="center">
<input type="submit" name="Submit" value=" 提 交 " style="border:1px double rgb(88,88,88);font:9pt">
             <input type="reset" name="Reset" value=" 重 写 " style="border:1px double rgb(88,88,88);font:9pt">         
<tr><td colspan=2>
</tr></form>
</table>
</table>

</table>
<!--#include file="inc/footer.asp"-->
</body>
</html>

 

fupload.inc

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'限制上传图片大小
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
</SCRIPT>
<SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT>
//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
}
</SCRIPT>

addphoto.asp
<!--#include file="conn.asp"-->
<!--#include file="inc/domin.asp"-->
<!--#include file="fupload.inc"-->
<%
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
%>
<center>
<br><br>
<font color=red size=3>上传的照片应该为GIF或JPG文件!</font><br><br>
<input type="button" value="重填" onclick="history.go( -1 );return

true;">
</center>
<%
else
'------------
'开始输入
'-----------
response.write sss
response.write"<br>"
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
%>
<br><br>
<center><font color=red

size=3>成功输入个人基本档案!</font><br><br><form method="post"

action="personinf.asp"><input type="submit" value="返回"></form>
</center>
<%
end if
end if
%>


showpic.asp
<!--#include file="conn.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")
%>

    黑客防线网安服务器维护方案本篇连接:http://www.rongsen.com.cn/show.php?contentid-71.html
网站维护教程更新时间:2008-07-03 06:48:08  【打印此页】  【关闭
我要申请本站N点 | 黑客防线官网 |  
专业服务器维护及网站维护手工安全搭建环境,网站安全加固服务。黑客防线网安服务器维护基地招商进行中!QQ:29769479

footer  footer  footer  footer