<%@language=vbscript codepage=936 %>
<%
option explicit
response.buffer=true	
Const PurviewLevel=2
Const CheckChannelID=2
Const PurviewLevel_Article=3
%>
<!--#include file="../../conn/conn2.asp"-->
<!--#include file="../../config.asp"-->
<!--#include file="inc/configf.asp"-->
<!--#include file="inc/ubbcode.asp"-->
<!--#include file="inc/function.asp"-->
<!--#include file="inc/admin_code_article.asp"-->
<!--#include file="../inc.asp"-->
<%
if request.form("title")="" then 
response.write "错误提示:请输入标题!"
response.end
end if
dim rs,sql,ErrMsg,FoundErr,ObjInstalled
dim classid,Title,Content,Author,CopyFrom,Editor
dim flag,IncludePic,DefaultPicUrl,UploadFiles
dim TitleFontColor,TitleFontType,AuthorName,AuthorEmail,CopyFromName,CopyFromUrl,PaginationType,ReadLevel,ReadPoint,Stars,SkinID,LayoutID,MaxCharPerPage
dim tClass,ClassName,Depth,ParentPath,Child
ObjInstalled=IsObjInstalled("Scripting.FileSystemObject")
FoundErr=false
ClassID=trim(request.form("ClassID"))
Title=trim(request.form("Title"))
Content=trim(request.form("Content"))
Author=trim(request.form("Author"))
CopyFrom=trim(request.form("CopyFrom"))
flag=trim(request.form("flag"))
IncludePic=trim(request.form("IncludePic"))
DefaultPicUrl=trim(request.form("DefaultPicUrl"))
UploadFiles=trim(request.form("UploadFiles"))
if Author="" then
Author="不详"
end if
if CopyFrom="" then
CopyFrom="春风君官方中文网"
end if
	set rs=server.createobject("adodb.recordset")
	sql="select * from article where title='"&title&"' and ClassID="&ClassID&"" 
	rs.open sql,conn,1,3
	if not(rs.bof and rs.eof) then
	response.write"相同标题，出现在同一分类文章,或未选择类别，请重输入!<a href=""javascript:history.go(-1)"">返回重输</a>"
    response.end
    end if  
	rs.addnew
	rs("ClassID")=ClassID
	rs("Title")=Title
	rs("Content")=Content
	rs("Author")=Author
	rs("CopyFrom")=CopyFrom
	if flag<>"" then
	rs("flag")=flag
	end if
	if IncludePic<>"" then
	rs("IncludePic")=IncludePic
    end if
	'***************************************
	'删除无用的上传文件
	if ObjInstalled=True and UploadFiles<>"" then
		dim fso,strRubbishFile
		Set fso = Server.CreateObject("Scripting.FileSystemObject")
		if instr(UploadFiles,"|")>1 then
			dim arrUploadFiles,intTemp
			arrUploadFiles=split(UploadFiles,"|")
			UploadFiles=""
			for intTemp=0 to ubound(arrUploadFiles)
				if instr(Content,arrUploadFiles(intTemp))<=0 and arrUploadFiles(intTemp)<>DefaultPicUrl then
					strRubbishFile=server.MapPath("" & arrUploadFiles(intTemp))
					if fso.FileExists(strRubbishFile) then
						fso.DeleteFile(strRubbishFile)
						response.write "<br><li>" & arrUploadFiles(intTemp) & "在文章中没有用到，也没有被设为首页图片，所以已经被删除！</li>"
					end if
				else
					if intTemp=0 then
						UploadFiles=arrUploadFiles(intTemp)
					else
						UploadFiles=UploadFiles & "|" & arrUploadFiles(intTemp)
					end if
				end if
			next
		else
			if instr(Content,UploadFiles)<=0 and UploadFiles<>DefaultPicUrl then
				strRubbishFile=server.MapPath("" & UploadFiles)
				if fso.FileExists(strRubbishFile) then
					fso.DeleteFile(strRubbishFile)
					response.write "<br><li>" & UploadFiles & "在文章中没有用到，也没有被设为首页图片，所以已经被删除！</li>"
				end if
				UploadFiles=""
			end if
		end if
		set fso=nothing
	end If
	'结束
	'***************************************
	if DefaultPicUrl<>""  then
	rs("DefaultPicUrl")=DefaultPicUrl
	end if
	if UploadFiles<>"" then
	rs("UploadFiles")=UploadFiles
	end if
rs.update
rs.close
set rs=nothing
%>
<html>
<head>
<title></title>
<link rel="stylesheet" type="text/css" href="Admin_Style.css">
</head>
<body leftmargin="2" topmargin="0" marginwidth="0" marginheight="0">
<br><br>
<table class="border" align=center width="400" border="0" cellpadding="0" cellspacing="0" bordercolor="#999999">
  <tr align=center> 
    <td  height="22" align="center" class="title"><b><b>添加文章成功</b></b></td>
  </tr>
  <tr class="tdbg"> 
    <td height="60" align="center">祝贺您!</td>
  </tr>
  <tr> 
    <td>&nbsp;</td>
  </tr>
  <tr class="tdbg"> 
    <td height="30" align="center">【<a href="add.asp">继续添加文章</a>】&nbsp;【<a href="Admin_ArticleManage.asp">文章管理</a>】</td>
  </tr>
</table>
</body>
</html>
<%



'==================================================
'过程名：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 = "UploadFiles"			'文件保存的本地路径
	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

%>