欢迎光临
我们一直在努力

无组件上传图片至sqlserver数据库_asp实例

2007-08-23 分类：未分类 阅读(634) 评论(0)
建站超值云服务器，限时71元/月

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


/*  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=”http://www.knowsky.com/../images/save.gif” width=”85″ height=”19″ onClick=”if(isOK(form1)){form1.submit()}”>　　
          <img src=”http://www.knowsky.com/../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>


 

赞(0)
版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com 特别注意：本站所有转载文章言论不代表本站观点！ 本站所提供的图片等素材，版权归原作者所有，如需使用，请与原作者联系。未经允许不得转载：IDC资讯中心 » 无组件上传图片至sqlserver数据库_asp实例
分享到： 更多 (0)

相关推荐

  • 暂无文章

热门标签

ldquo (1370)win (1324)活动 (1166)ios (1162)rdquo (818)微信 (747)iphone (728)小米 (722)windows (706)手机 (698)酷跑 (686)飞车 (540)天天 (492)qq (491)网站 (457)全民 (442)discuz (408)充值 (389)安装 (368)更新 (321)华为 (300)浏览器 (292)支付宝 (289)三星 (266)note (264)教程 (262)预览版 (261)小编 (258)越狱 (254)linux (248)

热门文章

    分类目录

    • 没有分类目录