无组件上传图片至SQLSERVER数据库(示例)

原创 2003年08月12日 10:26:00

在无组件上传我刚试成功,所以提供代码给大家一起共享。

/*  addemployee.asp   */
<html>
<head>
<title>职工之家</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="../css/site_css.css" type="text/css">
</head>

<script language="javascript">
<!--
 //选择分类
 ///////////////////////////////////////////////////////////////////////
 function selectsort(txtSubject){
   var returnValue
   returnValue=window.showModalDialog("selMode.htm",null,"center:1;status:0;help:0;resized:0;dialogheight:300px;dialogwidth:206px");
   if (returnValue!="" && returnValue!=null){
      txtSubject.value=returnValue
   }
 }
 ///////////////////////////////////////////////////////////////////////
 //合法性检查
 function isOK(thisForm){
   var strTemp,strValue,strLen,strExName
  if(thisForm.txtTitle.value==""){
      alert("提示:标题不能为空,请正确输入")
   thisForm.txtTitle.focus()
   return false
   }
   if(thisForm.txtSort.value==""){
      alert("提示:请正确选择分类")
   thisForm.txtSort.focus()
   return false
   }
   /*检查图片类型*/
   if(thisForm.file.value!=""){
      strTemp=thisForm.file.value
   strValue=strTemp.toLowerCase()
   strLen=strTemp.length
   strExName=strValue.substring(strLen-4,strLen)
   if (strExName!=".jpg" && strExName!=".gif"){
       alert("请选择jpg或者gif文件!")
    return false
   }
   return true
   }
 }
//-->
</script>

<body bgcolor="#FFFFFF" text="#000000" leftmargin="1" topmargin="1">
<form name="form1" method="post" action="transact1.asp" enctype="multipart/form-data">
  <table border="0" cellspacing="0" cellpadding="0">
    <tr>
      <td colspan="2" bgcolor="#006699" height="15">&nbsp;</td>
    </tr>
    <tr>
      <td class="textBlack">
        <div align="right">标题:</div>
      </td>
      <td>
        <input type="text" name="txtTitle" size="52" class="textarea">
      </td>
    </tr>
    <tr>
      <td class="textBlack">
        <div align="right">分类:</div>
      </td>
      <td>
        <input type="text" name="txtSort" size="35" class="textarea">
        <input type="button" name="Submit2" class="buttonSkid" onclick="selectsort(txtSort);">
      </td>
    </tr>
    <tr>
      <td class="textBlack" valign="top">
        <div align="right">正文:</div>
      </td>
      <td>
        <textarea name="txtContent" rows="15" cols="50" class="textarea"></textarea>
      </td>
    </tr>
    <tr>
      <td height="14" class="textBlack" valign="top">
        <div align="right">图片:</div>
      </td>
      <td height="14" class="textBlack">
        <div align="left">
          <input type="file" name="file" size="35" class="textarea">
        </div>
      </td>
    </tr>
    <tr>
      <td height="42" class="textBlack" valign="top">&nbsp;</td>
      <td height="42" class="textBlack" valign="middle">
        <p>1、您上传的图片大小请控制在<font color="#FF0000"><b>500K</b></font>以内,否则不允许上传<br>
          2、你上传的图片必须为<font color="#FF0000"><b>150*130象素</b></font><br>
          3、上传上传图片的格式为JPG或者GIF</p>
      </td>
    </tr>
    <tr>
      <td height="39" class="textBlack">&nbsp;</td>
      <td height="39" valign="middle">
        <div align="center"><img src="../images/save.gif" width="85" height="19" onClick="if(isOK(form1)){form1.submit()}">  
          <img src="../images/close.gif" width="85" height="19" onClick="self.close();" ></div>
      </td>
    </tr>
  </table>
</form>
</body>
</html>
*************************************************************************

/* transact1.asp*/
<!--#include file="../func/conn.inc"-->
<!--#include file="../func/fupload.inc"-->
<!--#include file ="../func/myfunctions.inc"-->
<%
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
 Dim Fields
 Dim strTitle,strSort,strContent
 Dim rs,sSql
 Dim iMaxid
 Dim strMaxid
 Dim strlen    
 
 Set Fields = GetUpload()
 strTitle=BinaryToString(Fields("txtTitle").value)
 strSort=BinaryToString(Fields("txtSort").value)
 strContent=BinaryToString(Fields("txtContent").value)
 strSort=split(trim(strSort),"-")
 
 if instr(1,lcase(Fields("file").FileName),".jpg")=0 and instr(1,lcase(Fields("file").FileName),".gif")=0 then
    response.write "<script language='javascript'>alert('上传的图片必须是gif或者jpg格式的图片')</script>"
 response.write "<script language='javascript'>window.location='addemployee.asp';</script>"
    Response.end
 end if

 if Fields("file").Length>500000 then
    response.write "<script language='javascript'>alert('只允许不大于500k的图片上传');</script>"
    response.write "<script language='javascript'>window.location='addemployee.asp';</script>"
 response.end
 end if

 '/*存至数据库*/
     if Fields("file").FileName<>"" then
     Set rs=Server.CreateObject("ADODB.Recordset")
  sSql="select * from employee order by id desc"
  rs.open sSql,conn,2,2
  if not rs.eof  then
           iMaxid=Clng(rs("id"))+1                    
           strlen=4-len(cstr(iMaxid))
           strMaxid=string(strlen,"0") & cstr(iMaxid)  
        else
           strMaxid="0001"                             
        end if
  rs.addnew
        rs("id")=strMaxid
        rs("title")=strTitle
  rs("sort")=strSort(0)
  rs("img").AppendChunk Fields("file").Value
  rs("content")=quoteChg(strContent)
  rs("todate")=date()
        rs.update
        rs.close
        response.write "<script language='javascript'>alert('添加记录成功')</script>"
  end if
end if
%>

**********************************************************************
/*fupload.inc*/

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
Dim UploadSizeLimit

'********************************** GetUpload **********************************
'.Name name of the form field (<Input Name="..." Type="File,...">)
'.ContentDisposition = Content-Disposition of the form field
'.FileName = Source file name for <input type=file>
'.ContentType = Content-Type for <input type=file>
'.Value = Binary value of the source field.
'.Length = Len of the binary data field
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
'response.write CT
'application/x-www-form-urlencoded
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

'********************************** SeparateFields **********************************
'This function retrieves the upload fields from binary data and retuns the fields as array
'Binary is safearray of all raw binary data from input.
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>

asp无组件上传图片文件

最近要写一个asp 无组件上传图片文件的代码,感觉asp中真是麻烦,不像asp.net与jsp中有那么强大的文件读写和图片处理的类做支持!从网上找了一个代码,但目前只能上传和按原样输出,内部处理有待研...
  • trueman2008
  • trueman2008
  • 2007年12月14日 09:59
  • 1500

asp无组件上传图片并生成缩略图

 先创建一文件夹,并创建虚拟目录或站长点。1.增加上传页xAdd.html无组件上传"POST" name="myform" action="xSave.asp" target="_self">"Pi...
  • yegengxing
  • yegengxing
  • 2008年11月07日 10:39
  • 8871

无组件上传图片到数据库中

up.htm.tx1 { height: 20px; width: 30px; font-size: 9pt; border: 1px solid; border-color: black black...
  • yangzixp
  • yangzixp
  • 2004年07月26日 09:56
  • 667

无组件上传图片到数据库源码

******************** One.asp页面表单的Enctype设置.       ******************** Tow.asp页面获取二进制图象信息并上传到数据库.  ...
  • kanjing
  • kanjing
  • 2004年06月24日 02:00
  • 1878

ASP.NET 上传图片至数据库并读取图片显示

1:上传图片的相对路径到数据库中相应字段里,读取显示时,将控件(假设用的是Image控件)的ImageUrl属性指向该相对路径即可。2:将图片以二进制流的方式整体上传到数据库里,读取显示时,以二进制流...
  • w809026418
  • w809026418
  • 2010年05月21日 15:22
  • 1953

无组件上传图片

Set conn=Server.CreateObject("Adodb.Connection")connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Sourc...
  • myxworld
  • myxworld
  • 2005年10月26日 16:18
  • 445

上传图片至数据库

using System;using System.Data;using System.Configuration;using System.Collections;using System.Web;...
  • treeyh
  • treeyh
  • 2006年12月01日 10:52
  • 511

锋利的SQL2014:SQL Server 2014示例数据库的安装步骤

1.登录http://msftdbprodsamples.codeplex.com/releases/view/125550网站,单击Adventure Works 2014 FullDatabase...
  • zhanghongju
  • zhanghongju
  • 2015年01月04日 20:47
  • 7964

上传本地图片到数据库

上传图片
  • qq_21703215
  • qq_21703215
  • 2016年11月30日 22:02
  • 1022

jquery uploadify for asp 批量文件上传程序 整合风声asp无组件上传

jquery 上传插件 uploadify (官网:http://www.uploadify.com/) uploadify功能强大,支持多文件、批量上传、状态进度条等,提供前端文件限制相关...
  • engling
  • engling
  • 2011年10月27日 23:57
  • 1865
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:无组件上传图片至SQLSERVER数据库(示例)
举报原因:
原因补充:

(最多只允许输入30个字)