html_add_save.asp

很好的企业网站管理系统!可以适应各种不同的小型企业!

<%Admin="InfoAdd"%>
<!--#include file="check.asp"-->
<!--#include file="mdb_path_info.asp"-->
<!--#include file="config.asp"-->
<!--#include file="char.inc"-->
<!--#include file="inc/ubbcode.asp"-->
<%
'#################################################################
'#  晓宇听幽网站内容管理系统(xoYu CMS)
'# 
'#  版权所有: 晓宇听幽工作室
'#
'#  制作人  :  xoyu(晓宇)            
'#           
'#  主页地址: http://www.xoYu.com	晓宇听幽工作室
'#
'#【版权声明】
'#################################################################
'# 本软体为共享软体(shareware)提供个人网站免费使用，请勿非法修改,
'# 转载，散播，或用于其他图利行为，并请勿删除版权声明。
'# 如果您的网站正式起用了这个脚本，请您通知我们，以便我们能够知晓！
'# 如果可能，请在您的网站做上我们的链接，希望能给予合作。谢谢！
'#################################################################
'# 程序名称：晓宇听幽网站内容管理系统·网站内容管理系统
'# 英文名称：xoYu News 2004 Professional For xoYu CMS
'# 程序创建时间：2003-7-10
'# 程序完成时间：2003-9-11
'# 最后修改时间：2003-11-15
'#################################################################
'# 请您尊重我们的劳动和版权，不要删除以上的版权声明部分，谢谢合作
'# 如有任何问题请到我们的论坛(http://www.xoyu.com/bbs/)告诉我们。                       
'#################################################################
'**************************************************
'函数名：IsObjInstalled
'作  用：检查组件是否已经安装
'参  数：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
'==================================================
'过程名：ReplaceRemoteUrl
'作  用：替换字符串中的远程文件为本地文件并保存远程文件
'参  数：strContent ------ 要替换的字符串
'==================================================
function ReplaceRemoteUrl(strContent)
	if IsObjInstalled("Microsoft.XMLHTTP")=False or EnableSaveRemote="No" then
		ReplaceRemoteUrl=strContent
		exit function
	end if
			
	dim re,RemoteFile,RemoteFileurl,SaveFilePath,SaveFileName,SaveFileType,arrSaveFileName,ranNum
	SaveFilePath = "../Upload/newsimg"			'文件保存的本地路径
	if right(SaveFilePath,1)<>"/" then SaveFilePath=SaveFilePath&"/"
	Set re=new RegExp
	re.IgnoreCase =true
	re.Global=True
	re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(gif|jpg|png|bmp)))"
	Set RemoteFile = re.Execute(strContent)
	For Each RemoteFileurl in RemoteFile
		arrSaveFileName = split(RemoteFileurl,".")
		SaveFileType=arrSaveFileName(ubound(arrSaveFileName))
		ranNum=int(900*rnd)+100
		SaveFileName = SaveFilePath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&SaveFileType	
		call SaveRemoteFile(SaveFileName,RemoteFileurl)
		strContent=Replace(strContent,RemoteFileurl,SaveFileName)
		if UploadFiles="" then
			UploadFiles=SaveFileName
		else
			UploadFiles=UploadFiles & "|" & SaveFileName
		end if
	Next
	ReplaceRemoteUrl=strContent
end function



'==================================================
'过程名：SaveRemoteFile
'作  用：保存远程的文件到本地
'参  数：LocalFileName ------ 本地文件名
'		 RemoteFileUrl ------ 远程文件URL
'==================================================
sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
	dim Ads,Retrieval,GetRemoteData
	Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
	With Retrieval
		.Open "Get", RemoteFileUrl, False, "", ""
		.Send
		GetRemoteData = .ResponseBody
	End With
	Set Retrieval = Nothing
	Set Ads = Server.CreateObject("Adodb.Stream")
	With Ads
		.Type = 1
		.Open
		.Write GetRemoteData
		.SaveToFile server.MapPath(LocalFileName),2
		.Cancel()
		.Close()
	End With
	Set Ads=nothing
end sub

ObjInstalled=IsObjInstalled("Scripting.FileSystemObject")
FoundErr=false
Response.cookies("body")=body
tid=request("id")
savetime=Now()+webtime/24
set rs=server.CreateObject("ADODB.RecordSet")             
if request.form("tid")="" then errmsg=errmsg & "＂文章类别＂必选! \n"
if request.form("sid")="" then errmsg=errmsg & "＂文章专题请确定＂ \n"
if request.form("se")="" then errmsg=errmsg & "＂文章关键字＂必填，因为留空无法产生相关文章! \n"                 
if request.form("title")="" then errmsg=errmsg & "＂文章名称＂不能为空! \n"
if request("title")<>"" then
rs.open "select * from info where title='"&request("title")&"' and tid="&request("id"),conn,1,1
if not rs.eof then errmsg=errmsg & "本类别内已经有相同的文章了! \n"
rs.close
end if

if errmsg<>"" then
   set rs=nothing
   conn.close
   set conn=nothing
   response.write("<script>alert('" & errmsg & "');history.go(-1)</script>") 
else
		sql="select * from info where (id is null)"
		rs.open sql,conn,1,3
		rs.addnew
		rs("tid")=request("id")
		rs("sid")=request("sid")
		rs("dj")=request("xoYuNewsDJ")
		rs("commend")=request("commend")
		rs("se")=request("se")
		rs("title")=request("title")
		rs("form_user")=request("form_user")
		rs("mbname")=request("mbname")
		rs("form_url")=request("form_url")
		rs("pic")=request("pic")
		rs("user")=request("user")
		rs("marquee")=request("marquee")
		rs("bingpai")=request("bingpai")
		rs("reply")=request("reply")
		rs("SpecialName")=Request.Form("SpecialName")
		body=request("body")
		rs("info")=ReplaceRemoteUrl(body)
		rs("date")=savetime
		rs.update
		if request("makehtml")="yes" then
		temp = rs.bookmark
		rs.bookmark = temp
		newid=rs.Fields("ID")
		end if
		rs.close
		
  rs.open "select * from infotype where id="&tid,conn,1,1
  if not rs.eof then
      ts=rs("ts")
 TI=split(rs("ts"), ",")
           for i = 0 to ubound(TI)-1
                     next
   end if
   tx=TI(0)&","
  rs.close				
set rs=nothing
conn.close
set conn=nothing
if request("makehtml")="yes" then
response.write("<script>window.open(""makehtml.asp?type=page&id="&newid&""","""",""width=200,height=100,resizable=yes,scrollbars=yes,status=yes,toolbar=no,menubar=no,location=no"")</script>")
end if
if flash="1" or flashjs="1" then
response.write("<script>alert('成功:添加文章完成,即将刷新相关分类页!');location.href='makeall.asp?tid="&request("id")&"'</script>") 
response.end
else
response.write("<script>alert('成功:添加文章完成,请继续添加文章!');location.href='html_add.asp?id="&request("id")&"'</script>") 
response.end
end if
end if
%>