无组件上传图片之文件采用方案

网络编程 2024/9/21 佚名

3 2 1

无为清净楼资源网 Design By www.qnjia.com

首先，图片在页面中能查找选择。设计表单页面index.asp和上传选择页upload.asp，upload.asp在index.asp中以iframe包含。

其次，所选图片应能上传到某文件夹。建立一文件夹uploadimg

最后，传上去的图片应如何引用？很显然，采用UBB立即显示。upload.asp的指向对象upfile.asp具有写入UBB标签的功能。

无组件上传调试文件夹
    -- index.asp
    -- upload.asp
    -- upfile.asp
    -- uploadimg文件夹

图片上传采用稻香老农的无组件上传。所以upload.inc文件必不可少。

1，upload.inc（拷贝以下文本框的所有代码）

dim upfile_5xSoft_Stream

Class upload_5xSoft
 
dim Form,File,Version
 
Private Sub Class_Initialize 
    dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile
    dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr
    Version=""
    if Request.TotalBytes<1 then Exit Sub
    set Form=CreateObject("Scripting.Dictionary")
    set File=CreateObject("Scripting.Dictionary")
    set upfile_5xSoft_Stream=CreateObject("Adodb.Stream")
    upfile_5xSoft_Stream.mode=3
    upfile_5xSoft_Stream.type=1
    upfile_5xSoft_Stream.open
    upfile_5xSoft_Stream.write Request.BinaryRead(Request.TotalBytes)
    
    vbEnter=Chr(13)&Chr(10)
    iDivLen=inString(1,vbEnter)+1
    strDiv=subString(1,iDivLen)
    iFormStart=iDivLen
    iFormEnd=inString(iformStart,strDiv)-1
    while iFormStart < iFormEnd
     iStart=inString(iFormStart,"name=""")
     iEnd=inString(iStart+6,"""")
     mFormName=subString(iStart+6,iEnd-iStart-6)
     iFileNameStart=inString(iEnd+1,"filename=""")
     if iFileNameStart>0 and iFileNameStart<iFormEnd then
     iFileNameEnd=inString(iFileNameStart+10,"""")
     mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10)
     iStart=inString(iFileNameEnd+1,vbEnter&vbEnter)
     iEnd=inString(iStart+4,vbEnter&strDiv)
     if iEnd>iStart then
      mFileSize=iEnd-iStart-4
     else
      mFileSize=0
     end if
     set theFile=new FileInfo
     theFile.FileName=getFileName(mFileName)
     theFile.FilePath=getFilePath(mFileName)
     theFile.FileSize=mFileSize
     theFile.FileStart=iStart+4
     theFile.FormName=FormName
     file.add mFormName,theFile
     else
     iStart=inString(iEnd+1,vbEnter&vbEnter)
     iEnd=inString(iStart+4,vbEnter&strDiv)
    
     if iEnd>iStart then
      mFormValue=subString(iStart+4,iEnd-iStart-4)
     else
      mFormValue="" 
     end if
     form.Add mFormName,mFormValue
     end if
    
     iFormStart=iformEnd+iDivLen
     iFormEnd=inString(iformStart,strDiv)-1
    wend
End Sub

Private Function subString(theStart,theLen)
 dim i,c,stemp
 upfile_5xSoft_Stream.Position=theStart-1
 stemp=""
 for i=1 to theLen
 if upfile_5xSoft_Stream.EOS then Exit for
 c=ascB(upfile_5xSoft_Stream.Read(1))
 If c > 127 Then
 if upfile_5xSoft_Stream.EOS then Exit for
 stemp=stemp&Chr(AscW(ChrB(AscB(upfile_5xSoft_Stream.Read(1)))&ChrB(c)))
 i=i+1
 else
 stemp=stemp&Chr(c)
 End If
 Next
 subString=stemp
End function

Private Function inString(theStart,varStr)
 dim i,j,bt,theLen,str
 InString=0
 Str=toByte(varStr)
 theLen=LenB(Str)
 for i=theStart to upfile_5xSoft_Stream.Size-theLen
 if i>upfile_5xSoft_Stream.size then exit Function
 upfile_5xSoft_Stream.Position=i-1
 if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then
 InString=i
 for j=2 to theLen
  if upfile_5xSoft_Stream.EOS then 
  inString=0
  Exit for
  end if
  if AscB(upfile_5xSoft_Stream.Read(1))<>AscB(MidB(Str,j,1)) then
  InString=0
  Exit For
  end if
 next
 if InString<>0 then Exit Function
 end if
 next
End Function

Private Sub Class_Terminate 
 form.RemoveAll
 file.RemoveAll
 set form=nothing
 set file=nothing
 upfile_5xSoft_Stream.close
 set upfile_5xSoft_Stream=nothing
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

Private function toByte(Str)
 dim i,iCode,c,iLow,iHigh
 toByte=""
 For i=1 To Len(Str)
 c=mid(Str,i,1)
 iCode =Asc(c)
 If iCode<0 Then iCode = iCode + 65535
 If iCode>255 Then
  iLow = Left(Hex(Asc(c)),2)
  iHigh =Right(Hex(Asc(c)),2)
  toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
 Else
  toByte = toByte & chrB(AscB(c))
 End If
 Next
 End function
End Class

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

[Ctrl+A 全部选择进行拷贝提示：可先修改部分代码，再点击运行]

2，表单页面index.asp。注意框架包含的上传选择页upload.asp

[Ctrl+A 全部选择进行拷贝提示：可先修改部分代码，再点击运行]

4，最后一个文件 upfile.asp 主要作用：生成图片名，并将图片上传，同样也要将UBB标签写入index.asp中的textarea中。
（拷贝以下文本框的所有代码）

formPath=upload.form("filepath")
 ''在目录后加(/)
 if right(formPath,1)<>"/" then formPath=formPath&"/"

response.write "<body>"

iCount=0
for each formName in upload.file ''列出所有上传了的文件
 set file=upload.file(formName) ''生成一个文件对象
 if file.filesize<100 then
   response.write "请选择你要上传的文件　[ <a href=# onclick=history.go(-1)>重新上传</a> ]"
  response.end
 end if
   
 if file.filesize>100*1000 then
   response.write "文件大小超过了限制100K　[ <a href=# onclick=history.go(-1)>重新上传</a> ]"
  response.end
 end if

fileExt=lcase(right(file.filename,4))
 uploadsuc=false
Forum_upload="gif,jpg,png"
 Forumupload=split(Forum_upload,",")
 for i=0 to ubound(Forumupload)
  if fileEXT="."&trim(Forumupload(i)) then
  uploadsuc=true
  exit for
  else
  uploadsuc=false
  end if
 next
 if uploadsuc=false then
   response.write "文件格式不正确　[ <a href=# onclick=history.go(-1)>重新上传</a> ]"
  response.end
 end if

randomize
 ranNum=int(90000*rnd)+10000
 filename=formPath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&fileExt

if file.FileSize>0 then   ''如果 FileSize > 0 说明有文件数据
 file.SaveAs Server.mappath(FileName) ''保存文件
  for i=0 to ubound(Forumupload)
    if fileEXT="."&trim(Forumupload(i)) then
     response.write "<script>parent.form_name.cn_content.value+='[img]"&FileName&"[/img]'</script>"
    exit for
    end if
  next
 iCount=iCount+1
 end if
 set file=nothing
next
set upload=nothing ''删除此对象

Htmend iCount&" 个文件上传结束!"

sub HtmEnd(Msg)
 set upload=nothing

response.write "上传成功 [ <a href=# onclick=history.go(-1)>继续上传</a>]"
 response.end
end sub

%>
</body>
</html>

[Ctrl+A 全部选择进行拷贝提示：可先修改部分代码，再点击运行]

当然，保持图片的文件夹uploadimg不能少

无组件上传图片之文件采用方案

标签：

无组件上传图片之文件采用方案

无为清净楼资源网 Design By www.qnjia.com

广告合作：本站广告合作请联系QQ：858582 申请时备注：广告合作（否则不回）
免责声明：本站文章均来自网站采集或用户投稿，网站不提供任何软件下载或自行开发的软件！如有用户或公司发现本站内容信息存在侵权行为，请邮件告知！ 858582#qq.com

无为清净楼资源网 Design By www.qnjia.com

评论“无组件上传图片之文件采用方案”

暂无评论...

www.qnjia.com 无为清净楼资源网

139,976互联网资源

144,792高清电影

21,817无损音乐

631,128技术资源

无组件上传图片之文件采用方案

无组件上传图片之文件采用方案

ASP编程入门进阶（二十）：ADO组件之查询数据记录

ASP初学者常犯的几个错误（ZT）

评论“无组件上传图片之文件采用方案”

RTX 5090要首发性能要翻倍！三星展示GDDR7显存

更新日志

友情链接

无组件上传图片之文件采用方案

无组件上传图片之文件采用方案

ASP编程入门进阶（二十）：ADO组件之查询数据记录

ASP初学者常犯的几个错误（ZT）

评论“无组件上传图片之文件采用方案”

RTX 5090要首发 性能要翻倍！三星展示GDDR7显存

更新日志

友情链接

RTX 5090要首发性能要翻倍！三星展示GDDR7显存