＝＝ 高分求救：无组件上传函数 ！@@#￥＝ 分不够再给

limenghao2 2004-05-12 10:55:19
上传表态页面：pictest.htm
<html>
<head>
<title>Untitled Document</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>

<body>
<form action="pictest.asp" method="post" enctype="multipart/form-data" name="form1">
<input name="picinfo" type="text" id="picinfo">
<br>
<input name="pic" type="file" id="pic">
<br>
<input type="submit" name="Submit" value="Submit">
</form></body>
</html>



上传页面：pictest.asp 其中conn.asp是数据库链接文件
<!--#include file="conn.asp"-->
<!--#include file="comm.asp"-->
<!--#include file="upload_5xsoft.inc"-->
<%
on error resume next
set upload=new upload_5xsoft ''建立上传对象
call SavePic("photo")
picinfo = upload.form(trim("picinfo"))
echo filename&"<br>"&picinfo
call EndSavePic
%>

函数页面：comm.asp
'***** 输出简写 *****
sub echo(s)
Response.write s & chr(13) '输出单行内容, 加“回车”
end sub

Function getExt(ename)'得到文件扩展名
getExt = right(ename, 3)
End Function

Function isPIC(fileName) '检测是否为图片类型

ext = getExt(fileName)
picType = "jpg,gif,png" '图片类型 (使用","将图片格式分开)
isPIC = False

typeList = split(picType, ",")

For ii = LBound(typeList) To UBound(typeList)
If UCase(ext) = UCase(typeList(ii)) Then
isPIC = True
Exit For
End If
Next

End Function

'*********无组件上传图片函数**********
Function SavePic(path)
dim upload,file,filename
if right(path,1)<>"/" then
path = path&"/"
end if
thefilename = year(date())&month(now())&day(now())&hour(now())&minute(now())&second(now())
set file=upload.file(formname)
filename2 = getext(file.FileName)
response.Write("asdfasdfasdfasdfasd")
if IsPic(filename2) then
if file.FileSize < 0 or file.FileSize > 200*1024 then
echo "未选择图片文件或是图片文件超过200K，请核对后重新上传！<br>"
echo "<a href='javascript:window.history.back()'>返回</a>"
else
filename = thefilename&"."&filename2
file.SaveAs Server.mappath(path & filename)
response.write file.FilePath&file.FileName&" ("&file.FileSize&") => "&Path&File.FileName&" 成功!<br>"
end if
else
echo "文件类型不对，请核对后重新上传！只支持JPG\GIF\PNG图片类型！<br>"
echo "<a href='javascript:window.history.back()'>返回</a>"
end if
End function

'*********无组件上传图片结束函数**********
Function EndSavePic()
set file=nothing
set upload=nothing
End Function

问题：为什么执行后页面是一片空白，而图片也未上传，就连基本的输出信息都看不到呢：？想知道化境无组件上传可不可以这样写成函数，如果可以的话，请指出小弟问题出在哪里！！～
感谢各位帮忙了，分不够再加，，急！！～～～～～～～～～～～～～～～
...全文
50 11 打赏 收藏 转发到动态 举报
写回复
用AI写文章
11 条回复
切换为时间正序
请发表友善的回复…
发表回复
AspDelphi 2004-05-12
  • 打赏
  • 举报
 回复
MsgBox ("Error # " & CStr(Err.Number) & " " & Err.Description)
打印一上错误信息看看有什么提示
diveas 2004-05-12
  • 打赏
  • 举报
 回复
on error resume next
给这些语句去掉，看看有什么错误提示没！
不提示错误最难查找了
limenghao2 2004-05-12
  • 打赏
  • 举报
 回复
没得一个解决实际问题的？

这些代码我都找得到，不用你们贴，

现在是想把现有的问题解决掉，各位高手帮忙！～
diveas 2004-05-12
  • 打赏
  • 举报
 回复
http://junchao.vipcn.com/InfoView/Article_1763.html 无组件上传及注释



6行代码实现无组件上传

目前有很多无组件上传类，我大概看了一下，大多写的相当复杂，有的居然还只能传文本
最关键的是没有10行代码以下的 ：）
我花了一个晚上时间研究了一下ADODB.Stream，并且用了6行代码实现了无组件上传：

strFileName = Request.QueryString("file1")
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1 ' adTypeBinary
objStream.Open
objStream.LoadFromFile strFileName
objStream.SaveToFile Server."123_onweb.gif",2


使用方法：
把上面的代码写成upload.asp
在浏览器里面输入：
http://XXX/upload.asp?file1=c:\上传文件\123.gif
XXX为你的主机地址
执行完后你会看到你的目录下面多了一个123_onweb.gif
他就是你要文件拉！！！！


根据原理我们可以扩展以下代码：
upload.asp文件
<%
Function GetFileName(ByVal strFile)
If strFile <> "" Then
GetFileName = mid(strFile,InStrRev(strFile, "\")+1)
Else
GetFileName = ""
End If
End function

strFileName = Request.Form("file1")
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1 ' adTypeBinary
objStream.Open
objStream.LoadFromFile strFileName
objStream.SaveToFile Server.MapPath(GetFileName(strFileName)),2
objStream.Close
%>

upload.htm文件
<form name="FORM" action="upload.asp" method="post">
　　<input type="submit" name="submit" value="OK">
<input type="file" name="file1" style="width:400" value="">
</form>
diveas 2004-05-12
  • 打赏
  • 举报
 回复
http://www.pconline.com.cn/pcedu/empolder/wz/asp/0402/315140.html
diveas 2004-05-12
  • 打赏
  • 举报
 回复
http://www.playicq.com/dispdocprow.php?id=1167
limenghao2 2004-05-12
  • 打赏
  • 举报
 回复
错误类型：
Server 对象, ASP 0177 (0x800401F3)
无效的类别字符串
/product/uploadx.asp, 第 124 行


浏览器类型：
Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; MyIE2)

网页：
POST 135546 ??? /product/upload.asp

POST Data:
错误 '80020009'
发生意外。

/iisHelp/common/500-100.asp，行 188



我的系统是XP的，是不是IIS不支持Server.CreateObject("Scripting.FileSystemObject")？？

应该如何解决？
孟子E章 2004-05-12
  • 打赏
  • 举报
 回复
真正无组件图文混合上传，功能强大，无须数据库，支持中文

文件名：UploadX.asp
<%
Dim FormData, FormSize, Divider, bCrLf
FormSize = Request.TotalBytes
FormData = Request.BinaryRead(FormSize)
bCrLf = ChrB(13) & ChrB(10)
Divider = LeftB(FormData, InStrB(FormData, bCrLf) - 1)

'将上传的文件保存到path所指定的目录下面。
'Formfield 上传表单的"file"域名
'Path 要保存文件的服务器绝对路径，形式为："d:\path\subpath"或"d:\path\subpath\"
'MaxSize 限制上传文件的最大长度，以KByte为单位
'SavType 服务器保存文件的方式：
' 0 唯一文件名方式，如果有同名则自动改名；
' 1 报错方式，如果有同名则出错；
' 2 覆盖方式，如果有同名则覆盖原来的文件
Function SaveFile(FormFileField, Path, MaxSize, SavType)
Dim StreamObj,StreamObj1
Set StreamObj = Server.CreateObject("ADODB.Stream")
Set StreamObj1 = Server.CreateObject("ADODB.Stream")
StreamObj.Mode = 3
StreamObj1.Mode = 3
StreamObj.Type = 1
StreamObj1.Type = 1
SaveFile = ""
StartPos = LenB(Divider) + 2
FormFileField = Chr(34) & FormFileField & Chr(34)
If Right(Path,1) <> "\" Then
Path = Path & "\"
End If
Do While StartPos > 0
strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormFileField) > 0 Then
FileName = bin2str(GetFileName(SearchStr,path,SavType))
If FileName <> "" Then
FileStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
FileLen = InStrB(StartPos, FormData, Divider) - 2 - FileStart
If FileLen <= MaxSize*1024 Then
FileContent = MidB(FormData, FileStart, FileLen)
StreamObj.Open
StreamObj1.Open
StreamObj.Write FormData
StreamObj.Position=FileStart-1
StreamObj.CopyTo StreamObj1,FileLen
If SavType =0 Then
SavType = 1
End If
StreamObj1.SaveToFile Path & FileName, SavType
StreamObj.Close
StreamObj1.Close
If SaveFile <> "" Then
SaveFile = SaveFile & "," & FileName
Else
SaveFile = FileName
End If
Else
If SaveFile <> "" Then
SaveFile = SaveFile & ",*TooBig*"
Else
SaveFile = "*TooBig*"
End If
End If
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function

Function GetFormVal(FormName)
GetFormVal = ""
StartPos = LenB(Divider) + 2
FormName = Chr(34) & FormName & Chr(34)
Do While StartPos > 0
strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormName) > 0 Then
ValStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
ValLen = InStrB(StartPos, FormData, Divider) - 2 - ValStart
ValContent = MidB(FormData, ValStart, ValLen)
If GetFormVal <> "" Then
GetFormVal = GetFormVal & "," & bin2str(ValContent)
Else
GetFormVal = bin2str(ValContent)
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function

Function bin2str(binstr)
Dim varlen, clow, ccc, skipflag
skipflag = 0
ccc = ""
varlen = LenB(binstr)
For i = 1 To varlen
If skipflag = 0 Then
clow = MidB(binstr, i, 1)
If AscB(clow) > 127 Then
ccc = ccc & Chr(AscW(MidB(binstr, i + 1, 1) & clow))
skipflag = 1
Else
ccc = ccc & Chr(AscB(clow))
End If
Else
skipflag = 0
End If
Next
bin2str = ccc
End Function

Function str2bin(str)
For i = 1 To Len(str)
str2bin = str2bin & ChrB(Asc(Mid(str, i, 1)))
Next
End Function

Function GetFileName(str,path,savtype)
Set fs = Server.CreateObject("s cripting.FileSystemObject")
str = RightB(str,LenB(str)-InstrB(str,str2bin("filename="))-9)
GetFileName = ""
FileName = ""
For i = LenB(str) To 1 Step -1
If MidB(str, i, 1) = ChrB(Asc("\")) Then
FileName = MidB(str, i + 1, LenB(str) - i - 1)
Exit For
End If
Next
If savtype = 0 and fs.FileExists(path & bin2str(FileName)) = True Then
hFileName = FileName
rFileName = ""
For i = LenB(FileName) To 1 Step -1
If MidB(FileName, i, 1) = ChrB(Asc(".")) Then
hFileName = LeftB(FileName, i-1)
rFileName = RightB(FileName, LenB(FileName)-i+1)
Exit For
End If
Next
For i = 0 to 9999
'hFileName = hFileName & str2bin(i)
If fs.FileExists(path & bin2str(hFileName) & i & bin2str(rFileName)) = False Then
FileName = hFileName & str2bin(i) & rFileName
Exit For
End If
Next
End If
Set fs = Nothing
GetFileName = FileName
End Function
%>

应用举例：

upload.htm

<html>

<head>
<meta http-equiv="Content-Language" content="zh-cn">
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<title>New Page 1</title>
</head>

<body>

<form method="POST" action="upload.asp" enctype="multipart/form-data">
<p>姓名：<input type="text" name="name" size="20"></p>
<p>城市：<input type="text" name="city" size="20"></p>
<p>爱好：1、<input type="text" name="lover" size="10"> 2、<input type="text" name="lover" size="10"></p>
<p>性别：<input type="radio" value="男" checked name="sex">男
<input type="radio" name="sex" value="女">女</p>
<p>省份：<select size="1" name="province">
<option selected value="江苏">江苏</option>
<option value="山西">山西</option>

</select></p>
爱好(补充)：3、<input type="text" name="lover" size="10"> 4、<input type="text" name="lover" size="10">
<p>作品1：<input type="file" name="fruit" size="20"></p>
<p>作品1：<input type="file" name="fruit" size="20"></p>
<p>作品2：<input type="file" name="fruit2" size="20"></p>
<p><input type="submit" value="提交" name="subbutt"><input type="reset" value="全部重写" name="rebutt"></p>
</form>

</body>

</html>


upload.asp

<%@ LANGUAGE = VBs cript %>
<!-- #include file="uploadx.asp" -->
<%
Response.Write "<br>Name=""" & GetFormVal("name") & """"
Response.Write "<br>Sex=""" & GetFormVal("sex") & """"
Response.Write "<br>province=""" & GetFormVal("province") & """"
Response.Write "<br>city=""" & GetFormVal("city") & """"
Response.Write "<br>lover=""" & GetFormVal("lover") & """"
dim filename
path = Server.MapPath("./")
filename = SaveFile("fruit",path,1024,0)
If filename <> "*TooBig*" Then
Response.Write "<br><br>""" & filename & """已经上传"
Else
Response.Write "<br><br>文件超出限制太大"
End IF

filename = SaveFile("fruit2",path,1024,0)
If filename <> "*TooBig*" Then
Response.Write "<br><br>""" & filename & """已经上传"
Else
Response.Write "<br><br>文件超出限制太大"
End IF
%>
evice 2004-05-12
  • 打赏
  • 举报
 回复
推荐去http://www.2yup.com/asp/看看。
aspnetxp 2004-05-12
  • 打赏
  • 举报
 回复
No.1
up...
limenghao2 2004-05-12
  • 打赏
  • 举报
 回复
自己搞掂了，×～～～～
HTML(3):IE浏览器编程 - vcmute的专栏 - CSDNBlog
导读： Q求救!!! 取ie浏览器文字乱码问题,高分相赠!!! T我所写的一个程序中有这样一个功能:用户选取了ie浏览器中的一段文字copy到剪贴板,我的程序从剪贴板中取出文字并显示在edit框中,这在中文系统下没有任何问题,...
禅与维修摩托车的艺术_罗伯特-M-波西格
的“道”难以言传、佛经中的“禅”无 法身教、柏拉图的“善”无法定义一样， 结合了禅的智慧的“良质”也是独立于 思考之外，而刻意追寻则会失去它本身 的价值。  显然，禅不是一种哲学，它没有规 ----------------...
HTML(3):IE浏览器编程
Q求救!!! 取ie浏览器文字乱码问题,高分相赠!!! T我所写的一个程序中有这样一个功能:用户选取了ie浏览器中的一段文字copy到剪贴板,我的程序从剪贴板中取出文字并显示在edit框中,这在中文系统下没有任何问题,而当程序...
基础
请问怎么得到一个函数的执行时间，单位毫秒！如何调试asp组件呀。用vc++调试编制的组件怎样画一个箭头？高分请教如何限制程序运行的方法？求助：通过编程DirectX抓屏------>masterz:再麻烦你一下，谢谢熟悉RichEdit...
HTML编程3
Q求救!!! 取ie浏览器文字乱码问题,高分相赠!!! T我所写的一个程序中有这样一个功能:用户选取了ie浏览器中的一段文字copy到剪贴板,我的程序从剪贴板中取出文字并显示在edit框中,这在中文系统下没有任何问题,而当程序...
ASP

28,390

社区成员

357,068

社区内容

发帖
与我相关
我的任务
社区描述
ASP即Active Server Pages，是Microsoft公司开发的服务器端脚本环境。
社区管理员
  • ASP
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章