upload.asp

打开目录ads文件夹 找到top_ads.js文件 用记事本打开后就可以看到: -------------------------------------- var head_ads_tx

  select case mn
  case 0
    uptemp=vbcrlf&"<font class=red>上传失败</font>：参数出错！"&go_back
  case 1
    uptemp=vbcrlf&"<font class=red>上传失败</font>：您可能没有选择想要上传的文件！"&go_back
  case 2
    uptemp=vbcrlf&"<font class=red>上传失败</font>：文件太大！(不能超过<font class=red>"&int(upload_size)&"kB</font>) "&go_back
  case 3
    uptemp=vbcrlf&"<font class=red>上传失败</font>：文件类型只能为：<font class=blue>"&replace(upload_type,"|","、")&"</font> 等格式 "&go_back
  case 4
    if lcase(upfile_name2)="jpg" or lcase(upfile_name2)="jpeg" then
      wmobj.con_filename=upload_path&uppath&"/"&upfile_name
      call wmobj.create_watermark()
    end if
    uptemp=vbcrlf&"<font class=red>上传成功</font>：<a href='"&upload_path&uppath&"/"&upfile_name&"' target=_blank>"&upfile_name&"</a> ("&upfilesize&")"
    if instr(up_text,"pic")>0 then
      if uppath="face" then
        tmpjs=tmpjs&"parent.document.all."&up_text&".value='"&upload_path&uppath&"/"&upfile_name&"';"
        upid=0
      else
        tmpjs=tmpjs&"parent.document.all."&up_text&".value='"&uppath&"/"&upfile_name&"';"
      end if
        '//*新增：判断传回 HTML 编辑器上传 JS 变量(相对根路径) *//
    elseif instr(up_text,"htmledit")>0 then
        tmpjs=tmpjs&"parent.document.all."&up_text&".value='"&web_dim(6)&upload_path&uppath&"/"&upfile_name&"';"
    else
    '//* 结束 *//
      uptemp=uptemp&vbcrlf&"&nbsp;&nbsp;[ <a href='?uppath="&uppath&"&upname=&uptext="&up_text&"&action=upload'>点击继续上传</a> ]"
      tmpjs=tmpjs&"parent.document.all."&up_text&".value+='"
      select case lcase(upfile_name2)
      case "gif","jpg","bmp","png"
        tmpjs=tmpjs&"[imG]"&upload_path&uppath&"/"&upfile_name&"[/imG]"
      case "swf"
        tmpjs=tmpjs&"[flash=350,250]"&upload_path&uppath&"/"&upfile_name&"[/flash]"
      case else
        'tmpjs=tmpjs&"[DOWNLOAD]"&upload_path&uppath&"/"&upfile_name&"[/DOWNLOAD]"
        tmpjs=tmpjs&"[download]upload_download.asp?id="&upid&"[/download]"
      end select
      tmpjs=tmpjs&"\n';"
    end if
    if int(upid)>0 then tmpjs=tmpjs&"parent.document.all.upid.value+=',"&upid&"';"
    if tmpjs<>"" then
      uptemp=uptemp&vbcrlf&"<script language=javascript>"&vbcrlf&tmpjs&vbcrlf&"</script>"
    end if
    call val_chk_end("up_"&uppath)
  case 5
    uptemp=vbcrlf&"<font class=red>上传失败</font>：未知错误！"&go_back
  case 6
    uptemp=vbcrlf&"<font class=red>上传失败</font>： <font class=red>验证码</font> 为空或有错误！"&go_back
  end select
end sub
sub upload_way()
  on error resume next
  dim up_way
  select case upload_mode
  case 0
    up_way="无"
    set upload=new upload_classes
  case 1
    up_way="lyfupload"
    set upload=server.createobject("lyfupload.uploadfile")
  case 2
    up_way="aspupload"
    set upload = server.createobject("persits.upload")
  end select
  if err then
    set upload=nothing
    err.clear
    response.write "空间不支持 <font class=red>"&up_way&" 组件</font> 上传！请后台配置后再进行上传功能。"
    exit sub
  end if
  
  select case upload_mode
  case 1
    call upload_1()
  case 2
    call upload_2()
  case else
    call upload_0()
  end select
  
  set upload=nothing
  if err then err.clear
end sub

sub upload_val_folder(uf_upload,uf_uppath)
  dim myfso,myfile,up_path
  set myfso=createobject("scripting.filesystemobject")
  if uf_uppath<>"" then
    myfile=server.mappath(uf_upload&uf_uppath)
    if not myfso.folderexists(myfile) then
      set up_path=myfso.createfolder(myfile)
    end if
  end if
  set myfso=nothing
end sub

sub upload_main()
  dim cid
  session(session_for&"uploadtype")=""
  if session(session_for&"admin")<>"joekoe_admin" then
    if len(upname)>2 then upname=""
  end if
  if not upsort_path(uppath) then
    response.write "参数(1)出错！"
    exit sub
  end if
  if uppath="face" then
    session(session_for&"uploadtype")="s"
    if int(login_id)<1 then
      response.write "参数(2)出错！"
      exit sub
    end if
    upname="face_"&login_id
  end if
  if len(uppath)<1 or len(uptext)<1 then
    response.write "参数(3)出错！"
    exit sub
  end if
%>
<script language=javascript>
function frm_submit(theform)
{
  if (document.all||document.getelementByid)
  {
    for (i=0;i<theform.length;i++)
    {
      var tempobj=theform.elements[i];
      if(tempobj.type.tolowercase()=="submit"||tempobj.type.tolowercase()=="reset")
      tempobj.disabled=true;
    }
  }
}
</script>
<table border=0 cellspacing=0 cellpadding=2>
<form name=form1 action='?uptype=<%response.write uptype%>&upbg=<% response.write upbg %>&action=upfile' method=post enctype='multipart/form-data'<%if cstr(upload_mode)<>"0" then response.write " onsubmit=""javascript:frm_submit(this);"""%>>
<input type=hidden name=up_path value='<%response.write uppath%>'>
<input type=hidden name=up_name value='<% response.write upname %>'>
<input type=hidden name=up_text value='<% response.write uptext %>'>
<input type=hidden name=up_temp value=''>
<%response.write val_code_num("up_"&uppath,1)%>
<tr>
<td><input type=file name=file_name1 value='' size=10></td>
<td align=center height=30><%
  if uppath="face" then
    response.write "<input type=submit name=submit onclick=""up_temp.value=file_name1.value"" value='上 传'> <font class=blue>Gif</font> 格式，小于<font class=red>"&upload_size&"</font>kB"
  else
    response.write "<input type=submit name=submit onclick=""up_temp.value=file_name1.value"" value='点击上传'> ("
    if instr(",pics,swfs,files,",","&lcase(uptype)&",")=0 then
      response.write "今天上传<font class=red>"&today_num&"</font>个,"
    end if
    if is_admin=false then
      response.write "每天<font class=red>"&upload_mn&"</font>个,"
    end if
    response.write "每个<font class=red>"&upload_size&"</font>kB)"
  end if
%></td>
</tr>
</form>
</table>
<%
end sub

function up_val_chk(vsort)
  if not val_is_true then
    up_val_chk=true
    exit function
  end if
  dim valcode,valc
  up_val_chk=false
  valcode="jk"&up_valcode
  valc=trim(request.cookies(joekoe_cms.web_cookies)("vc_up_"&vsort))
  if valcode<>"" and valcode<>"jk" and cstr(valcode)=cstr(valc) then
    up_val_chk=true
  end if
end function

function upsort_path(pvar)
  dim si
  upsort_path=true
  if pvar="face" then exit function
  upsort_path=msort_true(pvar)
end function

'//* 远程保存图片代码开始，ngbanyan 添加 *//
'//* 部分代码改动过 *//
Sub upload_Remote()
	uppath = trim(request.querystring("uppath"))
	if not upsort_path(uppath) then
		response.write joekoe_cms.js_put("parent.remoteUploadOK();",1)
		Exit Sub
	end if
	Dim sContent, k
	For k = 1 To Request.Form("eWebEditor_UploadText").Count
		sContent = sContent & Request.Form("eWebEditor_UploadText")(k)
	Next
	sContent = ReplaceRemoteUrl(sContent, ReFilType)
	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>"
	response.write joekoe_cms.js_put("parent.setHTML(UploadText.value); parent.remoteUploadOK();",1)
End Sub
'================================================
'作  用：替换字符串中的远程文件为本地文件并保存远程文件
'参  数：
'	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
	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, k, 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
	' 开始替换操作
	For k = 1 To n
		upfile_name2 = Mid(a_RemoteUrl(k), InstrRev(a_RemoteUrl(k), ".") + 1)
		SaveFileName = Left(uppath,1) & joekoe_cms.rand_file("") & "." & upfile_name2
		If SaveRemoteFile(SaveFileName, a_RemoteUrl(k)) = True Then
			s_Content = Replace(s_Content, a_RemoteUrl(k), web_dim(6) & upload_path & uppath & "/" & 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) > ReFilSize*1024 Then
		bError = True
	Else
		Set Ads = Server.CreateObject("Adodb.Stream")
		With Ads
			.Type = 1
			.Open
			.Write GetRemoteData
			.SaveToFile Server.MapPath(upload_path & uppath & "/" & s_LocalFileName), 2
			.Cancel()
			.Close()
		End With
		Set Ads=nothing
		upfilesize=LenB(GetRemoteData)
		upfile_name=s_LocalFileName
	    call upload_data()
 		if int(upid)>0 then response.write joekoe_cms.js_put("parent.insertUpid("","&upid&""");",1)
	End If

	If Err.Number = 0 And bError = False Then
		SaveRemoteFile = True
	Else
		Err.Clear
	End If
End Function
' ============================================
' 去除Html格式，用于从数据库中取出值填入输入框时
' 注意：value="?"这边一定要用双引号
' ============================================
Function inHTML(str)
	Dim sTemp
	sTemp = str
	inHTML = ""
	If IsNull(sTemp) = True Then
		Exit Function
	End If
	sTemp = Replace(sTemp, "&", "&amp;")
	sTemp = Replace(sTemp, "<", "&lt;")
	sTemp = Replace(sTemp, ">", "&gt;")
	sTemp = Replace(sTemp, Chr(34), "&quot;")
	inHTML = sTemp
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 = True
	Set xTestObj = Nothing
	Err = 0
End Function 

sub upload_frame(ft)
  if ft=1 then
    response.write vbcrlf&"</td></tr>" & _
                   vbcrlf&"</table>"
    exit sub
  end if
  response.write vbcrlf&"<table border=0 height='100%' width='100%' cellspacing=0 cellpadding=0 class=bg>" & _
                 vbcrlf&"<tr><td height='100%' align=left bgcolor="""&upbg&""">"
end sub
%>