45fan.com - 路饭网

搜索: 您的位置主页 > 网络频道 > 阅读资讯:怎么样在ASP+ACCESS中存入图片格式文件?

怎么样在ASP+ACCESS中存入图片格式文件?

2016-08-29 13:12:14 来源:www.45fan.com 【

怎么样在ASP+ACCESS中存入图片格式文件?

设计了一个产品网页,后台为ACCESS

,字段名为ID, MODEL,PHOTO, PRICE

想请问高手,如何在ACCESS中存入图片格式文件,字段类型是什么

另外如何在网页中显示数据库中的图片文件

<!--#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.45fan.com/a/question/69320.html
Tags: 图片 ASP+ACCESS 存入
编辑:路饭网
关于我们 | 联系我们 | 友情链接 | 网站地图 | Sitemap | App | 返回顶部