无组件上传图片至SQLSERVER数据库

  /* 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"> </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"> </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"> </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*/ 
   
   
   
  
  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 "" 
   response.write "" 
   Response.end 
   end if 
   
   if Fields("file").Length>500000 then 
   response.write "" 
   response.write "" 
   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 "" 
   end if 
  end if 
  %> 
   
  ********************************************************************** 
  /*fupload.inc*/ 
   
  
  Dim UploadSizeLimit 
   
  '********************************** GetUpload ********************************** 
  '.Name name of the form field () 
  '.ContentDisposition = Content-Disposition of the form field 
  '.FileName = Source file name for  
  '.ContentType = Content-Type for  
  '.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 
   
  
  //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 
  } 

♡ 点赞 0

☆ 收藏 0

留言区（共0条）