打印

[asp] ewebeditor 不能上传PPT文件

haolanlanxin [楼主]

初级会员

帖子: 61
体力: 140
威望: 0
当前: 陕西西安
离线: 48 天

1^# 大中小发表于 2008-8-17 15:09

<%
%>
<%
Server.ScriptTimeOut = 1800
' 参数变量
Dim sType, sStyleName
' 设置变量
Dim sAllowExt, nAllowSize, sUploadDir, nUploadObject, nAutoDir, sBaseUrl, sContentPath
' 接口变量
Dim sFileExt, sOriginalFileName, sSaveFileName, sPathFileName, nFileNum
Call DBConnBegin()		' 初始化数据库连接
Call InitUpload()		' 初始化上传变量
Call DBConnEnd()		' 断开数据库连接
Dim sAction
sAction = UCase(Trim(Request.QueryString("action")))
Select Case sAction
Case "REMOTE"
	Call DoRemote()			' 远程自动获取
Case "SAVE"
	Call ShowForm()			' 显示上传表单
	Call DoSave()			' 存文件
Case Else
	Call ShowForm()			' 显示上传表单
End Select
Sub ShowForm() 
%>
<HTML>
<HEAD>
<TITLE>文件上传</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">
body, a, table, div, span, td, th, input, select{font:9pt;font-family: "宋体", Verdana, Arial, Helvetica, sans-serif;}
body {padding:0px;margin:0px}
</style>
<script language="JavaScript" src="dialog/dialog.js"></script>
</head>
<body bgcolor=menu>
<form action="?action=save&type=<%=sType%>&style=<%=sStyleName%>" method=post name=myform enctype="multipart/form-data">
<input type=file name=uploadfile size=1 style="width:100%" onchange="originalfile.value=this.value">
<input type=hidden name=originalfile value="">
</form>
<script language=javascript>
var sAllowExt = "<%=sAllowExt%>";
// 检测上传表单
function CheckUploadForm() {
	
return true
}
// 提交事件加入检测表单
var oForm = document.myform ;
oForm.attachEvent("onsubmit", CheckUploadForm) ;
if (! oForm.submitUpload) oForm.submitUpload = new Array() ;
oForm.submitUpload[oForm.submitUpload.length] = CheckUploadForm ;
if (! oForm.originalSubmit) {
	oForm.originalSubmit = oForm.submit ;
	oForm.submit = function() {
		if (this.submitUpload) {
			for (var i = 0 ; i < this.submitUpload.length ; i++) {
				this.submitUpload[i]() ;
			}
		}
		this.originalSubmit() ;
	}
}
// 上传表单已装入完成
try {
	parent.UploadLoaded();
}
catch(e){
}
</script>
</body>
</html>
<% 
End Sub 
' 保存操作
Sub DoSave()
	' 默认无组件上传类
	Call DoUpload_Class
	
	sPathFileName = sContentPath & sSaveFileName
	Call OutScript("parent.UploadSaved('" & sPathFileName & "');var obj=parent.dialogArguments.dialogArguments;if (!obj) obj=parent.dialogArguments;try{obj.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){}")
End Sub
' 自动获取远程文件
Sub DoRemote()
	Dim sContent, i
	For i = 1 To Request.Form("eWebEditor_UploadText").Count 
		sContent = sContent & Request.Form("eWebEditor_UploadText")(i) 
	Next
	If sAllowExt <> "" Then
		sContent = ReplaceRemoteUrl(sContent, sAllowExt)
	End If
	Response.Write "<HTML><HEAD><TITLE>远程上传</TITLE><meta http-equiv='Content-Type' content='text/html; charset=gb2312'></head><body>" & _
		"<input type=hidden id=UploadText value=""" & inHTML(sContent) & """>" & _
		"</body></html>"
	Call OutScriptNoBack("parent.setHTML(UploadText.value);try{parent.addUploadFile('" & sOriginalFileName & "', '" & sSaveFileName & "', '" & sPathFileName & "');} catch(e){} parent.remoteUploadOK();")
End Sub
' 无组上传类
Sub DoUpload_Class()
	On Error Resume Next
	Dim oUpload, oFile
	' 建立上传对象
	Set oUpload = New upfile_class
	' 取得上传数据,限制最大上传
	oUpload.GetData(nAllowSize*1024)
	If oUpload.Err > 0 Then
		Select Case oUpload.Err
		Case 1
			Call OutScript("parent.UploadError('请选择有效的上传文件！')")
		Case 2
			Call OutScript("parent.UploadError('你上传的文件总大小超出了最大限制（" & nAllowSize & "KB）！')")
		End Select
		Response.End
	End If
	Set oFile = oUpload.File("uploadfile")
	sFileExt = LCase(oFile.FileExt)
	Call CheckValidExt(sFileExt)
	sOriginalFileName = oFile.FileName
	sSaveFileName = GetRndFileName(sFileExt)
	oFile.SaveToFile Server.Mappath(sUploadDir & sSaveFileName)
	
	Set oFile = Nothing
	Set oUpload = Nothing
End Sub
' 取随机文件名
Function GetRndFileName(sExt)
	Dim sRnd
	Randomize
	sRnd = Int(900 * Rnd) + 100
	GetRndFileName = year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now) & sRnd & "." & sExt
End Function
' 输出客户端脚本
Sub OutScript(str)
	Response.Write "<script language=javascript>" & str & ";history.back()</script>"
End Sub
Sub OutScriptNoBack(str)
	Response.Write "<script language=javascript>" & str & "</script>"
End Sub
' 检测扩展名的有效性
Sub CheckValidExt(sExt)
Dim b, i, aExt
b = True
aExt = Split(sAllowExt, "|")
For i = 0 To UBound(aExt)
If LCase(aExt(i)) = sExt Then
b = True
Exit For
End If
Next
End Sub
' 初始化上传限制数据
Sub InitUpload()
	sType = UCase(Trim(Request.QueryString("type")))
	sStyleName = Get_SafeStr(Trim(Request.QueryString("style")))
	sSql = "select * from ewebeditor_style where s_name='" & sStyleName & "'"
	oRs.Open sSql, oConn, 0, 1
	If Not oRs.Eof Then
		sBaseUrl = oRs("S_BaseUrl")
		nUploadObject = oRs("S_UploadObject")
		nAutoDir = oRs("S_AutoDir")
		sUploadDir = oRs("S_UploadDir")
		Select Case sBaseUrl
		Case "0"
			sContentPath = oRs("S_ContentPath")
		Case "1"
			sContentPath = RelativePath2RootPath(sUploadDir)
		Case "2"
			sContentPath = RootPath2DomainPath(RelativePath2RootPath(sUploadDir))
		End Select
		Select Case sType
		Case "REMOTE"
			sAllowExt = oRs("S_RemoteExt")
			nAllowSize = oRs("S_RemoteSize")
		Case "FILE"
			sAllowExt = oRs("S_FileExt")
			nAllowSize = oRs("S_FileSize")
		Case "MEDIA"
			sAllowExt = oRs("S_MediaExt")
			nAllowSize = oRs("S_MediaSize")
		Case "FLASH"
			sAllowExt = oRs("S_FlashExt")
			nAllowSize = oRs("S_FlashSize")
		Case Else
			sAllowExt = oRs("S_ImageExt")
			nAllowSize = oRs("S_ImageSize")
		End Select
	Else
		OutScript("parent.UploadError('无效的样式ID号，请通过页面上的链接进行操作！')")
	End If
	oRs.Close
	' 任何情况下都不允许上传asp脚本文件
	sAllowExt = Replace(UCase(sAllowExt), "ASP", "")
End Sub
' 转为根路径格式
Function RelativePath2RootPath(url)
	Dim sTempUrl
	sTempUrl = url
	If Left(sTempUrl, 1) = "/" Then
		RelativePath2RootPath = sTempUrl
		Exit Function
	End If
	Dim sWebEditorPath
	sWebEditorPath = Request.ServerVariables("SCRIPT_NAME")
	sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
	Do While Left(sTempUrl, 3) = "../"
		sTempUrl = Mid(sTempUrl, 4)
		sWebEditorPath = Left(sWebEditorPath, InstrRev(sWebEditorPath, "/") - 1)
	Loop
	RelativePath2RootPath = sWebEditorPath & "/" & sTempUrl
End Function
' 根路径转为带域名全路径格式
Function RootPath2DomainPath(url)
	Dim sHost, sPort
	sHost = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
	sPort = Request.ServerVariables("SERVER_PORT")
	If sPort <> "80" Then
		sHost = sHost & ":" & sPort
	End If
	RootPath2DomainPath = sHost & url
End Function
'================================================
'作  用：替换字符串中的远程文件为本地文件并保存远程文件
'参  数：
'	sHTML		: 要替换的字符串
'	sExt		: 执行替换的扩展名
'================================================
Function ReplaceRemoteUrl(sHTML, sExt)
	Dim s_Content
	s_Content = sHTML
	If IsObjInstalled("Microsoft.XMLHTTP") = False then
		ReplaceRemoteUrl = s_Content
		Exit Function
	End If
	
	Dim re, RemoteFile, RemoteFileurl, SaveFileName, SaveFileType
	Set re = new RegExp
	re.IgnoreCase  = True
	re.Global = True
	re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}(([A-Za-z0-9_-])+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(" & sExt & ")))"
	Set RemoteFile = re.Execute(s_Content)
	Dim a_RemoteUrl(), n, i, bRepeat
	n = 0
	' 转入无重复数据
	For Each RemoteFileurl in RemoteFile
		If n = 0 Then
			n = n + 1
			Redim a_RemoteUrl(n)
			a_RemoteUrl(n) = RemoteFileurl
		Else
			bRepeat = False
			For i = 1 To UBound(a_RemoteUrl)
				If UCase(RemoteFileurl) = UCase(a_RemoteUrl(i)) Then
					bRepeat = True
					Exit For
				End If
			Next
			If bRepeat = False Then
				n = n + 1
				Redim Preserve a_RemoteUrl(n)
				a_RemoteUrl(n) = RemoteFileurl
			End If
		End If		
	Next
	' 开始替换操作
	nFileNum = 0
	For i = 1 To n
		SaveFileType = Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), ".") + 1)
		SaveFileName = GetRndFileName(SaveFileType)
		If SaveRemoteFile(SaveFileName, a_RemoteUrl(i)) = True Then
			nFileNum = nFileNum + 1
			If nFileNum > 0 Then
				sOriginalFileName = sOriginalFileName & "|"
				sSaveFileName = sSaveFileName & "|"
				sPathFileName = sPathFileName & "|"
			End If
			sOriginalFileName = sOriginalFileName & Mid(a_RemoteUrl(i), InstrRev(a_RemoteUrl(i), "/") + 1)
			sSaveFileName = sSaveFileName & SaveFileName
			sPathFileName = sPathFileName & sContentPath & SaveFileName
			s_Content = Replace(s_Content, a_RemoteUrl(i), sContentPath & SaveFileName, 1, -1, 1)
		End If
	Next
	ReplaceRemoteUrl = s_Content
End Function
'================================================
'作  用：保存远程的文件到本地
'参  数：s_LocalFileName ------ 本地文件名
'		 s_RemoteFileUrl ------ 远程文件URL
'返回值：True  ----成功
'        False ----失败
'================================================
Function SaveRemoteFile(s_LocalFileName, s_RemoteFileUrl)
	Dim Ads, Retrieval, GetRemoteData
	Dim bError
	bError = False
	SaveRemoteFile = False
	On Error Resume Next
	Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
	With Retrieval
		.Open "Get", s_RemoteFileUrl, False, "", ""
		.Send
		GetRemoteData = .ResponseBody
	End With
	Set Retrieval = Nothing
	If LenB(GetRemoteData) > nAllowSize*1024 Then
		bError = True
	Else
		Set Ads = Server.CreateObject("Adodb.Stream")
		With Ads
			.Type = 1
			.Open
			.Write GetRemoteData
			.SaveToFile Server.MapPath(sUploadDir & s_LocalFileName), 2
			.Cancel()
			.Close()
		End With
		Set Ads=nothing
	End If
	If Err.Number = 0 And bError = False Then
		SaveRemoteFile = True
	Else
		Err.Clear
	End If
End Function
'================================================
'作  用：检查组件是否已经安装
'参  数：strClassString ----组件名
'返回值：True  ----已经安装
'        False ----没有安装
'================================================
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = False
Set xTestObj = Nothing
Err = 0
End Function
%>

提示：您可以先修改部分代码再运行

我用ewebeditor  版本是2.8  修改取消了所有文件格式上传限制

   但是现在有PPT文件上传  就出现文件和文件名后缀丢失

   看了upload.asp文件,发现上传不正确格式的文件时程序正确运行,可一旦上传正确格式文件时扩展名就丢失。这是怎么回事啊

网站竞争力

TOP

做西部数码代理.Cn1元国际45元 | 微软开发者工具互动网站

l870605

初级会员

帖子: 42
体力: 97
威望: 0
当前: 江苏南京
离线: 1 天

2^# 大中小发表于 2008-8-17 15:30

你可以进入到ewebeditor的后台管理页面，然后有个设置，可以设置上传文件格式，大小之类的东西

TOP

美橙vps独立IP月付189元 | 千千静听皮肤设计大赛

andywu520

新手上路

帖子: 16
体力: 40
威望: 0
当前: 广东东莞
离线: 1 天

3^# 大中小发表于 2008-8-17 15:41

不是吧，还在用2.8版的

，我都用5.2版的了

TOP

activeTechPros 共享IT行业薪资信息 | 《疯狂的程序员》劲爆上市

haolanlanxin [楼主]

初级会员

帖子: 61
体力: 140
威望: 0
当前: 陕西西安
离线: 48 天

4^# 大中小发表于 2008-8-17 16:39

楼上给个5。2的啊
我没有找到这个版本的

网站竞争力

TOP

还在为头像烦恼?还在为不能关注好友动态烦忧?快来蓝色理想家园吧!

andywu520

新手上路

帖子: 16
体力: 40
威望: 0
当前: 广东东莞
离线: 1 天

5^# 大中小发表于 2008-8-18 09:11

因为这个版本目前没有后台,偶正在想办法破解,等弄好了,发上来共享给大家

TOP

wyq29

银牌会员

帖子: 1314
体力: 2636
威望: 0
当前: 河南郑州

6^# 大中小发表于 2008-8-18 09:25

2.8是asp最完整的一个版本其它都没有完全破解
但2.8足够了

你进入到 2.8 的后台管理里把文件类型添加上去你自己不要修改程序试试吧

TOP

haolanlanxin [楼主]

初级会员

帖子: 61
体力: 140
威望: 0
当前: 陕西西安
离线: 48 天

7^# 大中小发表于 2008-8-18 10:25

不知道进过后台没有
后台就没有增加上传文件类型的设置  呵呵

这个问题好像一直不能解决  官方演示最近版本的可以上传任何附件的

为了上传我就在UPLOAD.asp中冒险把文件上传的判断去掉的  就是不管什么后缀都可以传

等传完我再给他给回来啊

网站竞争力

TOP

lq917

初级会员

帖子: 53
体力: 115
威望: 0
离线: 20 天

专长 ASP,Access

8^# 大中小发表于 2008-9-6 19:35

确实是这样，我用5.0也是这样的，设置断点检查，确定是丢失了扩展名；
关键是不是所有的PPT文件，好像部分有的可以上传，有的死活不行，不知如何处理

TOP