本页主题: asp无组件上传图片的基本方法(附:源码) 打印 | 加为IE收藏 | 复制链接 | 收藏主题 | 上一主题 | 下一主题

大群
方便别人 提高自己
终身成就奖 金点子奖
级别: 管理员


精华: 24
发帖: 1600
威望: 1783 点
金钱: 12200 RMB
贡献值: 500 点
注册时间:2006-02-22
最后登录:2008-09-08

 asp无组件上传图片的基本方法(附:源码)

实现图片上传需要建立以下文件

1、建立文件夹 image 

2、文件 upfile.htm  直接将文件名键入文本框,或用“浏览”键从文件对话框中选择一个文件,提交表单时所选文件被同时提交。
Copy code
<html>
<head>
<title>上传选择</title>
<Script language="javascript">
function mysubmit(theform)
{
if(theform.file1.value=="")
{
alert("请点击浏览按钮,选择您要上传的jpg或gif文件!")
theform.file1.focus;
return (false);
}
else
{
str= form1.file1.value;
strs=str.toLowerCase();
lens=strs.length;
extname=strs.substring(lens-4,lens);
if(extname!=".jpg" && extname!=".gif"&& extname!=".jpeg" && extname!=".bmp" )
{
alert("请选择jpg或gif文件!");
return (false);
}
}
return (true);
}
</script>

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">
<!--
td {  font-size: 9pt}
a {  color: #000000; text-decoration: none}
a:hover {  text-decoration: underline}
.tx {  height: 16px; width: 30px; border-color: black black #000000; border-top-width: 0px; border-right-width: 0px; border-bottom-width: 1px; border-left-width: 0px; font-size: 9pt; background-color: #eeeeee; color: #0000FF}
.bt {  font-size: 9pt; border-top-width: 0px; border-right-width: 0px; border-bottom-width: 0px; border-left-width: 0px; height: 16px; width: 80px; background-color: #eeeeee; cursor: hand}
.tx1 { height: 20px; width: 30px; font-size: 9pt; border: 1px solid; border-color: black black #000000; color: #0000FF}
-->
</style>
</head>

<body bgcolor="#FFFFFF" text="#000000">
<form name="form1" method="post" action="upfile.asp" enctype="multipart/form-data"  onSubmit="return mysubmit(this)">
  <input type="hidden" name="act" value="upload">
  <table width="400" border="0" cellspacing="0" cellpadding="5" align="center" bordercolordark="#CCCCCC" bordercolorlight="#000000">
      <tr align="center" valign="middle">选择文件: 
        <input type="file" name="file1" style="width:200" class="tx1" value="">
        <input type="submit" name="Submit" value="· 提交 ·" class="bt">
    </tr>
  </table>
</form>
</body>
</html>


3、文件 upfile.asp  文件上传。
Copy code
<%OPTION EXPLICIT%>
<%Server.ScriptTimeOut=5000%>
<!--#include FILE="upload_5xsoft.inc"-->
<html>
<head>
<title>文件上传</title>
</head>
<body>
<%
dim upload,file,formName,formPath,iCount,filepath
set upload=new upload_5xsoft ''建立上传对象
filepath="image/"
iCount=1
for each formName in upload.objForm ''列出所有form数据
  formName=upload.form(formName)
next
for each formName in upload.objFile ''列出所有上传了的文件
set file=upload.file(formName)  ''生成一个文件对象
if file.FileSize>0 then        ''如果 FileSize > 0 说明有文件数据
  file.SaveAs Server.mappath("image/"&file.FileName)  ''保存文件
 
session("uploadpath")="image/"&file.filename
response.write session("uploadpath")
response.write "      上传成功!        "
  iCount=iCount+1
response.write"<a href=upfile.htm>继续</a>"
else
response.write"<a href=upfile.htm>返回</a>"
end if
next
set upload=nothing
response.end
%>
</body>
</html>


4、文件 upload_5xsoft.inc  文件处理上传脚本
Copy code
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim Data_5xsoft

Class upload_5xsoft
 
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="化境HTTP上传程序 Version 2.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_5xsoft = Server.CreateObject("adodb.stream")
  Data_5xsoft.Type = 1
  Data_5xsoft.Mode =3
  Data_5xsoft.Open
  Data_5xsoft.Write  Request.BinaryRead(Request.TotalBytes)
  Data_5xsoft.Position=0
  RequestData =Data_5xsoft.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_5xsoft.Position = iFormStart
    Data_5xsoft.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_5xsoft.Position = iInfoEnd
        Data_5xsoft.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_5xsoft.Close
    set Data_5xsoft =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_5xsoft.position=FileStart
    Data_5xsoft.copyto dr,FileSize
    dr.SaveToFile FullPath,2
    dr.Close
    set dr=nothing
    SaveAs=false
  end function
  End Class
</SCRIPT>


5、如果需要向数据库中加入图片上传地址可以:

rs("path")=session("uploadpath")

path 为你数据库中的字段;session("uploadpath")  直接使用就可以..



以上文件已经在数据管理系统中应用,如果有兴趣可以直接下载      upfile.rar      直接使用或根据需要对代码进行适当处理。
千百度工作室网站      汽车报废服务 
Posted: 2007-12-28 20:31 | [楼 主]
kwant
优秀会员勋章
级别: 侠客


精华: 0
发帖: 238
威望: 257 点
金钱: 0 RMB
贡献值: 58 点
注册时间:2006-10-04
最后登录:2008-08-10

 

asp网页用的吗?看动还真难啊~
感谢千百度工作室为战火帝国军事做的支持!

【第一期】墓地战歌
Posted: 2008-01-12 22:40 | 1 楼
guoqun
优秀斑竹奖 灌水天才奖
级别: 论坛版主


精华: 2
发帖: 239
威望: 255 点
金钱: 4930 RMB
贡献值: 0 点
注册时间:2006-07-25
最后登录:2008-07-29

 

很好拿来就可以使用,谢谢
Posted: 2008-03-18 12:25 | 2 楼
帖子浏览记录 版块浏览记录
千百度工作室 » 网页学堂 Homepage