html asp 常用 上传文件

来源:互联网 发布:eve数据地点扫不到 编辑:程序博客网 时间:2024/06/06 16:07
文件上传页面部分

<html>
<!--#include file="Sun_up.asp"-->
<head>
<meta http-equiv="Content-Language" content="zh-cn">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>Sun Up V1.0 文件上传</title>
<style>
<!--

table,form,body,input        { font-family: 宋体; font-size: 9pt; color: #000000; text-decoration: none }
body         { margin: 0px; background-color: #FFFFFF }
-->
</style>
</head>

<body topmargin="0" leftmargin="0" rightmargin="0" bottommargin="0">
<table border="0" cellpadding="0" cellspacing="0" width="100%" id="table1" height="100%">
     <tr>
           <td>
<%
Session.Timeout=30
if Session("admin")="" then
Response.Write("请先登陆!")
Response.End
End if

if Request("post")="form" then
'文件处理
Dim upload,file,formName,formPath,iCount
Set upload=new Sun_up

'上传地址的文件夹
formPath="upfile/"

filenowname=now()
filenowname=Replace(filenowname," ","")
filenowname=Replace(filenowname,"-","")
filenowname=Replace(filenowname,":","")
For each formName in upload.objFile
Set file=upload.file(formName)  ''生成一个文件对象
if file.FileSize>0 and file.FileSize<200000 then         ''如果 FileSize > 0 说明有文件数据
'取文件名
fileType=file.FileName
i=instr(fileType,".")
l=Len(fileType)
if i>0 then fileType=Right(fileType,l-i+1)

if UCase(fileType)=".JPG" or UCase(fileType)=".GIF" or UCase(fileType)=".BMP" then
file.SaveAs Server.mappath(formPath&filenowname&fileType)   ''保存文件

Response.Write formPath&filenowname&fileType&"("&file.FileSize&")成功![<a href=""?"">返回</a>]<script>parent.document.myform.img.value='"&formPath&filenowname&fileType&"'</script>"

set qswh=new qswhImg
arr=qswh.getImageSize(Server.MapPath(formPath&filenowname&fileType))

dim img_height,img_width
img_height=arr(2)
img_width=arr(1)


if img_height>img_width then
     if img_height<100 then
           img_height=img_height
     Else
           c_img_height=img_height/100
           img_height=100
           img_width=Cint(img_width/c_img_height)
     End if
Else
     if img_width<100 then
           img_width=img_width
     Else
           c_img_width=img_width/100
           img_width=100
           img_height=Cint(img_height/c_img_width)
     End if
End if


Response.Write "<script>parent.document.myform.img_height.value='"&img_height&"',parent.document.myform.img_width.value='"&img_width&"'</script>"

Else
Response.Write(UCase(fileType)&"为非允许上传的类型文件!")
End if

Else
Response.Write("文件字节为0或文件太大,限制上传为200KB,上传失败!")
Exit for
End if
Next
set file=nothing
set upload=nothing
Else
%>
<table border="0" cellpadding="0" cellspacing="0" width="100%">
     <form method="POST" enctype="multipart/form-data" action="?post=form" name="upform"><tr>
           <td>
<input type="file" name="file" size="30" style="border: 1px solid #808080"> 
<input type="submit" value="提交" name="B1" style="height: 18; border: 1px solid #808080; ; padding-top:1px"></p>
</td>
     </tr></form>
</table>
<%
End if
%>

           </td>
     </tr>
</table>
</body>

</html>
 


上传类文件Sun_up.asp


<%
dim Data_Sun

Class Sun_up
  
dim objForm,objFile,Version

Public function Form(strForm)
   strForm=lcase(strForm)
   if not objForm.exists(strForm) then
     Form=""
   else
     Form=objForm(strForm)
   end if
 end function

Public function File(strFile)
   strFile=lcase(strFile)
   if not objFile.exists(strFile) then
     set File=new FileInfo
   else
     set File=objFile(strFile)
   end if
 end function


Private Sub Class_Initialize 
  dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
  dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
  dim iFindStart,iFindEnd
  dim iFormStart,iFormEnd,sFormName
  Version="Sun V1.0"
  set objForm=Server.CreateObject("Scripting.Dictionary")
  set objFile=Server.CreateObject("Scripting.Dictionary")
  if Request.TotalBytes<1 then Exit Sub
  set tStream = Server.CreateObject("adodb.stream")
  set Data_Sun = Server.CreateObject("adodb.stream")
  Data_Sun.Type = 1
  Data_Sun.Mode =3
  Data_Sun.Open
  Data_Sun.Write  Request.BinaryRead(Request.TotalBytes)
  Data_Sun.Position=0
  RequestData =Data_Sun.Read 

  iFormStart = 1
  iFormEnd = LenB(RequestData)
  vbCrlf = chrB(13) & chrB(10)
  sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
  iStart = LenB (sStart)
  iFormStart=iFormStart+iStart+1
  while (iFormStart + 10) < iFormEnd 
     iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
     tStream.Type = 1
     tStream.Mode =3
     tStream.Open
     Data_Sun.Position = iFormStart
     Data_Sun.CopyTo tStream,iInfoEnd-iFormStart
     tStream.Position = 0
     tStream.Type = 2
     tStream.Charset ="gb2312"
     sInfo = tStream.ReadText
     tStream.Close
     '取得表单项目名称
     iFormStart = InStrB(iInfoEnd,RequestData,sStart)
     iFindStart = InStr(22,sInfo,"name=""",1)+6
     iFindEnd = InStr(iFindStart,sInfo,"""",1)
     sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
     '如果是文件
     if InStr (45,sInfo,"filename=""",1) > 0 then
           set theFile=new FileInfo
           '取得文件名
           iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
           iFindEnd = InStr(iFindStart,sInfo,"""",1)
           sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
           theFile.FileName=getFileName(sFileName)
           theFile.FilePath=getFilePath(sFileName)
           '取得文件类型
           iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
           iFindEnd = InStr(iFindStart,sInfo,vbCr)
           theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
           theFile.FileStart =iInfoEnd
           theFile.FileSize = iFormStart -iInfoEnd -3
           theFile.FormName=sFormName
           if not objFile.Exists(sFormName) then
             objFile.add sFormName,theFile
           end if
     else
     '如果是表单项目
           tStream.Type =1
           tStream.Mode =3
           tStream.Open
           Data_Sun.Position = iInfoEnd 
           Data_Sun.CopyTo tStream,iFormStart-iInfoEnd-3
           tStream.Position = 0
           tStream.Type = 2
           tStream.Charset ="gb2312"
             sFormValue = tStream.ReadText 
             tStream.Close
           if objForm.Exists(sFormName) then
             objForm(sFormName)=objForm(sFormName)&", "&sFormValue              
           else
             objForm.Add sFormName,sFormValue
           end if
     end if
     iFormStart=iFormStart+iStart+1
     wend
  RequestData=""
  set tStream =nothing
End Sub

Private Sub Class_Terminate  
 if Request.TotalBytes>0 then
     objForm.RemoveAll
     objFile.RemoveAll
     set objForm=nothing
     set objFile=nothing
     Data_Sun.Close
     set Data_Sun =nothing
 end if
End Sub
   
 
 Private function GetFilePath(FullPath)
  If FullPath <> "" Then
   GetFilePath = left(FullPath,InStrRev(FullPath, "/"))
  Else
   GetFilePath = ""
  End If
 End  function
 
 Private function GetFileName(FullPath)
  If FullPath <> "" Then
   GetFileName = mid(FullPath,InStrRev(FullPath, "/")+1)
  Else
   GetFileName = ""
  End If
 End  function
End Class

Class FileInfo
  dim FormName,FileName,FilePath,FileSize,FileType,FileStart
  Private Sub Class_Initialize 
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 0
    FormName = ""
    FileType = ""
  End Sub
  
 Public function SaveAs(FullPath)
    dim dr,ErrorChar,i
    SaveAs=true
    if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
    set dr=CreateObject("Adodb.Stream")
    dr.Mode=3
    dr.Type=1
    dr.Open
    Data_Sun.position=FileStart
    Data_Sun.copyto dr,FileSize
    dr.SaveToFile FullPath,2
    dr.Close
    set dr=nothing 
    SaveAs=false
  end function
  End Class


Class qswhImg
 dim aso
 Private Sub Class_Initialize
  set aso=CreateObject("Adodb.Stream")
  aso.Mode=3 
  aso.Type=1 
  aso.Open 
 End Sub
 Private Sub Class_Terminate
  set aso=nothing
 End Sub

 Private Function Bin2Str(Bin)
  Dim I, Str
  For I=1 to LenB(Bin)
   clow=MidB(Bin,I,1)
   if ASCB(clow)<128 then
    Str = Str & Chr(ASCB(clow))
   else
    I=I+1
    if I <= LenB(Bin) then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
   end if
  Next 
  Bin2Str = Str
 End Function
 
 Private Function Num2Str(num,base,lens)
  'qiushuiwuhen (2002-8-12)
  dim ret
  ret = ""
  while(num>=base)
   ret = (num mod base) & ret
   num = (num - num mod base)/base
  wend
  Num2Str = right(string(lens,"0") & num & ret,lens)
 End Function
 
 Private Function Str2Num(str,base)
  'qiushuiwuhen (2002-8-12)
  dim ret
  ret = 0
  for i=1 to len(str)
   ret = ret *base + cint(mid(str,i,1))
  next
  Str2Num=ret
 End Function
 
 Private Function BinVal(bin)
  'qiushuiwuhen (2002-8-12)
  dim ret
  ret = 0
  for i = lenb(bin) to 1 step -1
   ret = ret *256 + ascb(midb(bin,i,1))
  next
  BinVal=ret
 End Function
 
 Private Function BinVal2(bin)
  'qiushuiwuhen (2002-8-12)
  dim ret
  ret = 0
  for i = 1 to lenb(bin)
   ret = ret *256 + ascb(midb(bin,i,1))
  next
  BinVal2=ret
 End Function
 
 Function getImageSize(filespec) 
  'qiushuiwuhen (2002-9-3)
  dim ret(3)
  aso.LoadFromFile(filespec)
  bFlag=aso.read(3)
  select case hex(binVal(bFlag))
  case "4E5089":
   aso.read(15)
   ret(0)="PNG"
   ret(1)=BinVal2(aso.read(2))
   aso.read(2)
   ret(2)=BinVal2(aso.read(2))
  case "464947":
   aso.read(3)
   ret(0)="GIF"
   ret(1)=BinVal(aso.read(2))
   ret(2)=BinVal(aso.read(2))
  case "535746":
   aso.read(5)
   binData=aso.Read(1)
   sConv=Num2Str(ascb(binData),2 ,8)
   nBits=Str2Num(left(sConv,5),2)
   sConv=mid(sConv,6)
   while(len(sConv)<nBits*4)
    binData=aso.Read(1)
    sConv=sConv&Num2Str(ascb(binData),2 ,8)
   wend
   ret(0)="SWF"
   ret(1)=int(abs(Str2Num(mid(sConv,1*nBits+1,nBits),2)-Str2Num(mid(sConv,0*nBits+1,nBits),2))/20)
   ret(2)=int(abs(Str2Num(mid(sConv,3*nBits+1,nBits),2)-Str2Num(mid(sConv,2*nBits+1,nBits),2))/20)
  case "FFD8FF":
   do 
    do: p1=binVal(aso.Read(1)): loop while p1=255 and not aso.EOS
    if p1>191 and p1<196 then exit do else aso.read(binval2(aso.Read(2))-2)
    do:p1=binVal(aso.Read(1)):loop while p1<255 and not aso.EOS
   loop while true
   aso.Read(3)
   ret(0)="JPG"
   ret(2)=binval2(aso.Read(2))
   ret(1)=binval2(aso.Read(2))
  case else:
   if left(Bin2Str(bFlag),2)="BM" then
    aso.Read(15)
    ret(0)="BMP"
    ret(1)=binval(aso.Read(4))
    ret(2)=binval(aso.Read(4))
   else
    ret(0)=""
   end if
  end select
  ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &""""
  getimagesize=ret
 End Function
End Class
%>