% Option Explicit
%>
<%'Copyright (c)2006 by Foosun Inc. Code by Simpwind.Xie
Response.Buffer = True
Response.Expires = -1
Response.CacheControl = "no-cache"
Dim Conn,User_Conn,obj_Save_Rs,strShowErr,str_checkTF
MF_Default_Conn
MF_User_Conn
'ET增加帐户登陆代码
Function ETlogin
Dim p_RsLoginObj,p_RsLogObj
Dim p_UserName,p_UserPass,p_System,p_SqlLog,p_SqlLogin,p_Url,p_TempUserPass
Dim p_PassArr,p_TrueResult,p_CheckedResult,GetRamCode_adminCode
GetRamCode_adminCode = GetRamCode(8)
p_UserName = NoSqlHack(Replace(Trim(Request.Form("Name")),"'","''"))
p_TempUserPass = Replace(Trim(Request.Form("Password")),"'","''")
if p_UserName = "" or p_TempUserPass = "" then
Response.Write("[err]错误:请填写完整帐户密码[/err]")
Response.End
end if
Set p_RsLoginObj = server.CreateObject (G_FS_RS)
p_SqlLogin = "select Admin_Name,Admin_Pass_Word,Admin_Is_Locked,Admin_Parent_Admin,Admin_Is_Super,Admin_Pop_List,Admin_Add_Admin,Admin_Style_Num from FS_MF_Admin where Admin_Name='"&p_UserName&"'"
p_RsLoginObj.Open p_SqlLogin,Conn,1,1
if Not p_RsLoginObj.EOF then
if cint(p_RsLoginObj("Admin_Is_Locked")) = 1 then
Response.Write("[err]错误:\n您已经被锁定,请与管理联系[/err]")
Response.End
end if
Session("Admin_Name") = p_RsLoginObj("Admin_Name")
Session("Admin_Pass_Word") = p_RsLoginObj("Admin_Pass_Word")
Session("Admin_Parent_Admin") = p_RsLoginObj("Admin_Parent_Admin")
Session("Admin_Is_Super") = p_RsLoginObj("Admin_Is_Super")
Session("Admin_Pop_List") = p_RsLoginObj("Admin_Pop_List")
Session("Admin_Add_Admin") = p_RsLoginObj("Admin_Add_Admin")
Session("Admin_Style_Num") = p_RsLoginObj("Admin_Style_Num")
'更新随机码
Conn.execute("Update FS_MF_Admin Set admin_Code = '"& GetRamCode_adminCode &"' where Admin_Name='"& Session("Admin_Name") &"' and Admin_Pass_Word='"& Session("Admin_Pass_Word") &"'")
session("fs_admin_Code")= GetRamCode_adminCode
SubSys_Cookies:MFConfig_Cookies:NSConfig_Cookies:DSConfig_Cookies
else
Response.Write("[err]错误:\n请检查用户名和密码的正确性[/err]")
Response.End
end if
Set p_RsLoginObj = Nothing
End Function
'ET增加正则查询函数
dim picpatrn
picpatrn="]*src *= *(?:""|')?([^""' ]+\.(?:gif|jpg|bmp|png))(?:""|'| |/>|>)+"
Function Regone(patrn, strng)
Dim regEx, Matches,ms,RetStr ' Create variable.
Set regEx = New RegExp ' Create a regular expression.
RetStr=""
regEx.Pattern = patrn ' Set pattern.
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = false ' Set global applicability.
Set Matches = regEx.Execute(strng) ' Execute search.
if Matches.count>0 then
Set ms=Matches(0)
if not isnull(trim(ms.submatches(0))) then RetStr=trim(ms.submatches(0))
end if
Regone = RetStr
End Function
'以上为ET增加代码
ETlogin
MF_Session_TF
set Fs_news = new Cls_News
Fs_News.GetSysParam()
'If Not Fs_news.IsSelfRefer Then response.write "非法提交数据":Response.end
Dim Fs_news,str_News_Action,str_NewsType,str_isdraft,str_ClassID,str_SpecialEName,str_SpecialID_EName,str_NewsTitle,str_TitleColor,str_titleBorder,str_TitleItalic,str_isShowReview,str_PopID
Dim str_URLAddress,str_CurtTitle,str_KeyWords,str_KeywordSaveTF,str_Templet,str_NewsSmallPicFile,str_NewsPicFile,str_PicborderCss,str_Author,str_AuthorSaveTF,str_Source,str_SourceSaveTF
Dim str_NewsNaviContent,str_Content,str_PointNumber,str_Money,str_GroupID,str_FileName,str_FileExtName,str_addtime,str_Hits,str_NewsID,str_TodayNewsPicTF,str_isDraftTF,str_ReturnUrl,obj_isdraft_rs
Dim str_NewsProperty_Rec,str_NewsProperty_mar,str_NewsProperty_rev,str_NewsProperty_constr,str_NewsProperty_tt,str_NewsProperty_hots,str_NewsProperty_jc,str_NewsProperty_unr,str_NewsProperty_ann,str_NewsProperty_filt,str_NewsProperty_Remote
Dim str_NewsProperty_Rec_1,str_NewsProperty_mar_1,str_NewsProperty_rev_1,str_NewsProperty_constr_1,str_NewsProperty_tt_1 ,str_NewsProperty_hots_1,str_NewsProperty_jc_1,str_NewsProperty_unr_1,str_NewsProperty_ann_1,str_NewsProperty_filt_1,str_NewsProperty_Remote_1,IsAdPic,AdPicWH,AdPicLink,AdPicAdress
'(c)2002-2006 版权所有:Foosun Inc. 不得进行任何性质的程序拷贝、传播。By Foosun__Simpwind.Xie
str_ClassID = Request.Form("ClassID")
str_FileExtName = Request.Form("FileExtName")
str_Templet = Request.Form("Templet")
If Trim(str_ClassID)="" then
'strShowErr = "
请选择栏目或您填写的栏目不正确"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]请选择栏目或您填写的栏目ID不正确[/err]")
Response.end
End if
Dim tmp_class_obj,tmp_defineid,tmp_sTemplets
set tmp_class_obj = conn.execute("select FileExtName,NewsTemplet,DefineID from FS_NS_NewsClass where classID='"& str_ClassID &"'")
if tmp_class_obj.eof then
tmp_class_obj.close:set tmp_class_obj = nothing
response.Write "[err]错误的栏目ID,找不到栏目[/err]"
Response.end
end if
if trim(str_FileExtName)="" then str_FileExtName=tmp_class_obj(0)
tmp_sTemplets = tmp_class_obj(1)
if trim(str_Templet)="" then str_Templet=tmp_sTemplets
tmp_defineid = tmp_class_obj(2)
set tmp_class_obj = nothing
If not tmp_defineid="" Then
If tmp_defineid>0 Then
Dim CustColumnRs,CustSql,CustColumnArr
CustSql="select DefineID,ClassID,D_Name,D_Coul,D_Type,D_isNull,D_Value,D_Content,D_SubType from [FS_MF_DefineTable] Where D_SubType='NS' and Classid="&tmp_defineid &""
Set CustColumnRs=CreateObject(G_FS_RS)
CustColumnRs.Open CustSql,Conn,1,3
If Not CustColumnRs.Eof Then
CustColumnArr=CustColumnRs.GetRows()
End If
CustColumnRs.close:Set CustColumnRs = Nothing
End If
end if
'=====================================
'str_News_Action = Request.Form("News_Action")
str_News_Action = "add_Save"
if str_News_Action = "add_Save" then:str_NewsID = Fs_News.GetRamCode(15):Else:str_NewsID = Trim(Request.Form("NewsID")):End if
str_NewsType = Request.Form("NewsType")
if trim(str_NewsType)="" then str_NewsType="TextNews"
'str_isdraft = Request.Form("isdraft")
str_isdraft =""
' if str_isdraft<>"" then
' Set obj_isdraft_rs = server.CreateObject(G_FS_RS)
' obj_isdraft_rs.Open "Select ID from FS_NS_News where isdraft=1 Order by ID desc",Conn,1,3
' if obj_isdraft_rs.recordcount>20 then
' strShowErr = "您的草稿箱中的"& Fs_news.allInfotitle&"已经超过20条信息,操作失败"
' Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
' Response.end
' End if
' End if
str_SpecialID_EName = Request.Form("SpecialID_EName")
'str_SpecialEName = Request.Form("SpecialID")
str_NewsTitle= Request.Form("NewsTitle")
str_TitleColor = Request.Form("TitleColor")
str_titleBorder = Request.Form("titleBorder")
str_TitleItalic = Request.Form("TitleItalic")
str_isShowReview = Request.Form("isShowReview")
str_PopID = Request.Form("PopID")
if trim(str_PopID)="" then str_PopID=0
str_URLAddress = Request.Form("URLAddress")
str_CurtTitle = Request.Form("CurtTitle")
str_KeyWords = Request.Form("KeywordText")
str_KeywordSaveTF = Trim(Request.Form("KeywordSaveTF"))
'str_NewsSmallPicFile = Request.Form("NewsSmallPicFile")
'str_NewsPicFile = Request.Form("NewsPicFile")
str_PicborderCss = Request.Form("PicborderCss")
str_Author = Request.Form("Author")
str_AuthorSaveTF= Request.Form("AuthorSaveTF")
str_Source = Request.Form("Source")
str_SourceSaveTF = Request.Form("SourceSaveTF")
str_NewsNaviContent = Request.Form("NewsNaviContent")
str_Content = Request.Form("Content")
str_PointNumber = Request.Form("PointNumber")
str_Money = Request.Form("Money")
str_GroupID = Request.Form("BrowPop")
'str_FileName = Request.Form("FileName")
str_FileName = Fs_News.strFileNameRule(Fs_News.fileNameRule,0,0)
'str_addtime = Request.Form("addtime")
str_addtime = now()
str_Hits = Request.Form("Hits")
if trim(str_Hits)="" then str_Hits=0
str_NewsProperty_Rec = Trim(Request.Form("NewsProperty_Rec"))
str_NewsProperty_mar = Trim(Request.Form("NewsProperty_mar"))
str_NewsProperty_rev = Trim(Request.Form("NewsProperty_rev"))
str_NewsProperty_constr = Trim(Request.Form("NewsProperty_constr"))
str_NewsProperty_tt = Trim(Request.Form("NewsProperty_tt"))
str_NewsProperty_hots= Trim(Request.Form("NewsProperty_hots"))
str_NewsProperty_jc= Trim(Request.Form("NewsProperty_jc"))
str_NewsProperty_unr = Trim(Request.Form("NewsProperty_unr"))
str_NewsProperty_ann = Trim(Request.Form("NewsProperty_ann"))
str_NewsProperty_filt = Trim(Request.Form("NewsProperty_filt"))
str_NewsProperty_Remote = Trim(Request.Form("NewsProperty_Remote"))
str_TodayNewsPicTF = Trim(Request.Form("TodayNewsPicTF"))
IsAdPic = Request.Form("IsAdPic")
AdPicWH = Request.Form("AdPicWH")
AdPicLink = Request.Form("AdPicLink")
AdPicAdress = Request.Form("AdPicAdress")
if IsAdPic<>0 and (trim(AdPicWH)="" or trim(AdPicAdress)="") then
Dim GetClassAdPicInfoRs,GetClassAdPicInfoSql
GetClassAdPicInfoSql="Select IsAdPic,AdPicWH,AdPicLink,AdPicAdress From FS_NS_NewsClass Where ClassID='"&str_ClassId&"'"
Set GetClassAdPicInfoRs=Conn.execute(GetClassAdPicInfoSql)
If Not GetClassAdPicInfoRs.Eof Then
IsAdPic=GetClassAdPicInfoRs("IsAdPic")
AdPicWH=GetClassAdPicInfoRs("AdPicWH")
AdPicLink=GetClassAdPicInfoRs("AdPicLink")
AdPicAdress=GetClassAdPicInfoRs("AdPicAdress")
End If
GetClassAdPicInfoRs.Close
Set GetClassAdPicInfoSql=Nothing
end if
Set obj_Save_Rs = server.CreateObject(G_FS_RS)
'判断合法性
If Trim(str_NewsTitle)="" then
'strShowErr = "请填写标题"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]请填写标题[/err]")
Response.end
End if
'自定义字段检查(默认值,必填值)
'(c)2002-2006 版权所有:Foosun Inc. 不得进行任何性质的程序拷贝、传播。By Foosun__Simpwind.Xie
If IsArray(CustColumnArr) Then
For i = 0 to UBound(CustColumnArr,2)
If CustColumnArr(5,i)="0" Then
If Request.Form("FS_NS_Define_"&CustColumnArr(3,i))="" Then
'strShowErr = "["&CustColumnArr(2,i)&"-自定义字段]不可以为空,请填写或设置默认值"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]["&CustColumnArr(2,i)&"-自定义字段]不可以为空,请填写或设置默认值[/err]")
Response.end
End If
If CustColumnArr(4,i)="6" Then
If Not Isdate(Request.Form("FS_NS_Define_"&CustColumnArr(3,i))) Then
'strShowErr="["&CustColumnArr(2,i)&"-自定义字段]必须为为日期,请重新填写!"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]["&CustColumnArr(2,i)&"-自定义字段]必须为为日期,请重新填写![/err]")
Response.end
End If
End If
End If
If CustColumnArr(4,i)="5" Then
If Not IsNumeric(Request.Form("FS_NS_Define_"&CustColumnArr(3,i))) Then
'strShowErr="["&CustColumnArr(2,i)&"-自定义字段]必须为数字,请重新填写!"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]["&CustColumnArr(2,i)&"-自定义字段]必须为数字,请重新填写![/err]")
Response.end
End If
End If
Next
End If
if str_NewsType="TitleNews" then
If Trim(str_URLAddress)="" then
'strShowErr = "选择外部栏目,请填写外部地址连接"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]选择外部栏目,请填写外部地址连接[/err]")
Response.end
End if
Else
If isNull(Trim(str_Templet)) or len(Trim(str_Templet))<5 then
'strShowErr = "请正确填写模板地址"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]请正确填写模板地址[/err]")
Response.end
End if
If isNull(Trim(str_Content)) or len(Trim(str_Content))<3 then
'strShowErr = "请填写内容您填写的内容少于3个字符"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]请填写内容,您填写的内容少于3个字符[/err]")
Response.end
End if
str_NewsSmallPicFile=regone(picpatrn,str_Content)
if (str_NewsSmallPicFile="" and str_NewsType="PicNews") then str_NewsType="TextNews"
str_NewsPicFile = str_NewsSmallPicFile
If isNull(Trim(str_FileName)) then
'strShowErr = "文件名不正确,请填写正确"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]文件名不正确,请填写正确[/err]")
Response.end
End if
If isNull(Trim(str_addtime)) then
'strShowErr = "请填写日期"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]请填写日期[/err]")
Response.end
End if
If isdate(Trim(str_addtime)) =false then
'strShowErr = "请正确填写添加日期"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]请正确填写添加日期[/err]")
Response.end
End if
If isnull(Trim(str_FileName)) then
'strShowErr = "请填写文件名"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]请填写文件名[/err]")
Response.end
End if
If isnumeric(Trim(str_hits)) =false then
'strShowErr = "请正确填写点击率"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]请正确填写点击率[/err]")
Response.end
End if
if str_NewsType="PicNews" then
If isnull(Trim(str_NewsSmallPicFile)) or len(Trim(str_NewsSmallPicFile))<5 then
'strShowErr = "请填写图片小图请正确填写图片小图"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]请填写图片小图,请正确填写图片小图[/err]")
Response.end
End if
End if
if Instr(str_FileName,"自动编号ID") =false and Instr(str_FileName,"唯一NewsID")=false then
if Not fs_news.chkinputchar(str_FileName) then
'strShowErr = "文件名格式有错误允许字符为:
大小写字母及@,.0123456789|-_"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]文件名格式有错误,允许字符为:大小写字母及@,.0123456789|-_[/err]")
Response.end
End if
End if
If IsAdPic=1 Then
If AdPicWH="" or IsNull(AdPicWH) Then
'strShowErr = "请填写图片高度与宽度"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]请填写图片高度与宽度[/err]")
Response.end
End If
if instr(AdPicWH,",")=0 or instr(AdPicWH,",")>0 then
'strShowErr = "图片高度与宽度填写错误"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]图片高度与宽度填写错误[/err]")
Response.end
end if
If Ubound(split(AdPicWH,","))<>3 Then
' strShowErr = "图片高度与宽度,显示布局格式,插入位置有误,格式为100,200,1,400"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]图片高度与宽度,显示布局格式,插入位置有误,格式为100,200,1,400[/err]")
Response.end
End If
If Not IsNumeric(split(AdPicWH,",")(3)) Then
'strShowErr = "插入位置格式有误,应为正整数"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]图片插入位置格式有误,应为正整数[/err]")
Response.end
End If
If split(AdPicWH,",")(3)<0 Then
' strShowErr = "插入位置格式有误,应为正整数"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]图片插入位置格式有误,应为正整数[/err]")
Response.end
End If
If AdPicAdress="" Or IsNull(AdPicAdress) Then
'strShowErr = "图片地址不能为空"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]图片地址不能为空[/err]")
Response.end
End If
End If
End if
' if str_News_Action = "add_Save" then
'判断是否有添加权限
if not Get_SubPop_TF(str_ClassID,"NS001","NS","news") then Err_Show
Set obj_Save_Rs=Server.CreateObject(G_FS_RS)
obj_Save_Rs.Open "Select * from FS_NS_News where NewsID='"& str_NewsID &"'",Conn,1,3
if Not obj_Save_Rs.eof then
'strShowErr = "NewsID意外重复,请重新添加"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]NewsID意外重复,请重新添加[/err]")
Response.end
End if
'判断文件名是否重复
Dim tmp_filename_rs
set tmp_filename_rs = Conn.execute("select ID From FS_NS_News where ClassID ='"& str_ClassID &"' and FileName='"& str_FileName &"' and FileExtName='"& str_FileExtName &"' order by id desc")
if Not tmp_filename_rs.eof then
'strShowErr = "文件名重复"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]文件名重复[/err]")
Response.end
End if
tmp_filename_rs.close:set tmp_filename_rs = nothing
obj_Save_Rs.addnew
obj_Save_Rs("NewsID") = str_NewsID
obj_Save_Rs("SaveNewsPath") = Fs_news.SaveNewsPath(Fs_news.fileDirRule)
' Elseif str_News_Action = "Edit_Save" then
' '判断是否有修改权限
' if not Get_SubPop_TF(str_ClassID,"NS002","NS","news") then Err_Show
' obj_Save_Rs.Open "Select * from FS_NS_News where NewsID='"& str_NewsID &"'",Conn,1,3
' End if
'生成图片头条,有待修正
Dim str_FontSize,str_FontSpace,str_FontColor,str_FontBgColor,FontFace,PicTitle,str_PicTitle,str_Picwidth
str_FontSize = Request.Form("FontSize")
str_FontSpace = Request.Form("FontSpace")
str_FontColor = Request.Form("FontColor")
str_FontBgColor = Request.Form("FontBgColor")
PicTitle = Request.Form("PicTitle")
if PicTitle = "" then
str_PicTitle = str_NewsTitle
else
str_PicTitle = PicTitle
end if
str_Picwidth = Request.Form("PicTitlewidth")
FontFace = Request.Form("FontFace")
If str_TodayNewsPicTF = "FoosunCMS" Then
'图片地址:TempSysRootDir&TmpClassInfo(7) &"/"& TmpClassInfo(2)&NewsPath
Dim NumCanvasWidth,NumCanvasHeight,StrSavePath,TodayClassEName,TempSysRootDir
if str_picwidth = "" then
NumCanvasWidth =CInt(GetStrLengthE(str_PicTitle))*Cint(str_FontSize)
else
NumCanvasWidth =CInt(str_Picwidth)
end if
NumCanvasHeight = str_FontSize
if trim(G_VIRTUAL_ROOT_DIR) = "" then
TempSysRootDir = ""
else
TempSysRootDir = "/"&G_VIRTUAL_ROOT_DIR
end if
TodayClassEName=Conn.Execute("select ClassEName From FS_NS_NewsClass Where ClassID='" & str_ClassID & "'")(0)
StrSavePath=Server.MapPath(TempSysRootDir & "/Files/TodayPicFiles/"& str_NewsID & ".jpg")
'得到水印组件类型
Dim tmp_returnvalue
Select Case request.Cookies("FoosunMFCookies")("FoosunMFPicClassid")
Case "0"
tmp_returnvalue = AspJpegCreateTextPic(NumCanvasWidth,NumCanvasHeight,"&H"&str_FontBgColor,0,str_FontColor,FontFace,0,str_FontSize,str_PicTitle,0,StrSavePath)
Case "1"
tmp_returnvalue = WsImgWatermarkText(NumCanvasWidth,NumCanvasHeight,"&H"&str_FontColor&"&",FontFace,str_FontSize,0,0,0,str_NewsTitle,StrSavePath)
Case "2"
NumCanvasWidth = CInt(GetStrLengthE(str_NewsTitle))*(Cint(str_FontSize))
tmp_returnvalue = ImageGenCreateTextPic(NumCanvasWidth,NumCanvasHeight,rgb(HexToDec(left(str_FontBgColor,2)),HexToDec(mid(str_FontBgColor,3,2)),HexToDec(right(str_FontBgColor,2))),rgb(HexToDec(left(str_FontColor,2)),HexToDec(mid(str_FontColor,3,2)),HexToDec(right(str_FontColor,2))),FontFace,str_FontSize,str_NewsTitle,0,0,StrSavePath)
End Select
if tmp_returnvalue then
Call saveTody()
else
str_TodayNewsPicTF = ""
end if
End If
'开始插入或者更新数据
if trim(str_GroupID)<>"" or str_PointNumber <>"" or str_Money<>"" then
if trim(str_FileExtName)<>"asp" then
'strShowErr = "您设置了浏览权限,扩展名必须为.asp"
'Response.Redirect("lib/Error.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl=")
Response.Write("[err]您设置了浏览权限,扩展名必须为.asp[/err]")
Response.end
End if
End if
obj_Save_Rs("PopId") = str_PopId
obj_Save_Rs("ClassID") = str_ClassID
obj_Save_Rs("SpecialEName") = str_SpecialID_EName
obj_Save_Rs("NewsTitle") = str_NewsTitle
obj_Save_Rs("NewsNaviContent") = str_NewsNaviContent
if str_isShowReview<>"" then:obj_Save_Rs("isShowReview") = 1:Else:obj_Save_Rs("isShowReview") = 0:End if
obj_Save_Rs("TitleColor") = str_TitleColor
if str_titleBorder <>"" then:obj_Save_Rs("titleBorder") = 1:Else:obj_Save_Rs("titleBorder") = 0:End if
if str_TitleItalic <>"" then:obj_Save_Rs("TitleItalic") = 1:Else:obj_Save_Rs("TitleItalic") = 0:End if
if str_NewsType="TitleNews" then
obj_Save_Rs("URLAddress") = str_URLAddress
obj_Save_Rs("IsURL") = 1
obj_Save_Rs("NewsPicFile") = str_NewsPicFile
obj_Save_Rs("NewsSmallPicFile") = str_NewsSmallPicFile
Else
obj_Save_Rs("IsURL") = 0
obj_Save_Rs("CurtTitle") = str_CurtTitle
dim sys_Config,Save_Content,inside_rs ,Remote_Content,config_domain,config_insideLink
set sys_Config = Conn.execute("select top 1 IsDomain,InsideLink From FS_NS_SysParam")
config_domain = sys_Config("isDomain")
config_insideLink = sys_Config("insideLink")
sys_Config.close:set sys_Config=nothing
if config_domain="" then
config_domain = request.Cookies("FoosunMFCookies")("FoosunMFDomain")
else
config_domain = config_domain
end if
Dim TempForVar
'分批保存新闻内容入数据库
Save_Content = ""
For TempForVar = 1 To Request.Form("Content").Count
Save_Content = Save_Content & Request.Form("Content")(TempForVar)
Next
'如果开启远程保存,此处需要引入远程保存函数
if Request.Form("NewsProperty_Remote")<>"" then
if instr(Lcase(Save_Content),"0 then
CreateDateDir(Server.MapPath(Replace("/"&G_VIRTUAL_ROOT_DIR&"/"&G_UP_FILES_DIR&"/Remoteupfile","//","/")))
Remote_Content = ReplaceRemoteUrl(Save_Content,replace("/" & G_VIRTUAL_ROOT_DIR &"/"&G_UP_FILES_DIR & "/Remoteupfile/"&year(Now())&"-"&month(now())&"/"&day(Now()),"//","/"),"http://"&config_domain,replace("/"&G_VIRTUAL_ROOT_DIR,"//","/"))
else
Remote_Content =Save_Content
end if
else
Remote_Content =Save_Content
end if
''--------------------------------------自动分页的处理
'' G_FS_Page_Txtlength [FS:PAGE]
if request.Form("ClearAllPage")="1" then Remote_Content = replace(Remote_Content,"[FS:PAGE]","")
Remote_Content = AutoSplitPages(Remote_Content,"[FS:PAGE]",G_FS_Page_Txtlength)
''--------------------------------------
obj_Save_Rs("Content") = Remote_Content
'远程保存结束
if str_NewsType="PicNews" then:obj_Save_Rs("isPicNews") = 1:Else:obj_Save_Rs("isPicNews") = 0:End if
obj_Save_Rs("NewsPicFile") = str_NewsPicFile
obj_Save_Rs("NewsSmallPicFile") = str_NewsSmallPicFile
obj_Save_Rs("PicborderCss") = str_PicborderCss
obj_Save_Rs("Templet") = str_Templet
if Trim(str_GroupID)<>"" or Trim(str_PointNumber)<>"" or Trim(str_Money)<>"" then:obj_Save_Rs("isPop") =1:else:obj_Save_Rs("isPop")=0:End if
obj_Save_Rs("Source") = str_Source
obj_Save_Rs("Keywords") = str_Keywords
obj_Save_Rs("Author") = str_Author
obj_Save_Rs("Hits") = clng(str_Hits)
obj_Save_Rs("FileName") = str_FileName
obj_Save_Rs("FileExtName") = str_FileExtName
End if
if str_TodayNewsPicTF <> "" then:obj_Save_Rs("TodayNewsPic") = 1:Else:obj_Save_Rs("TodayNewsPic") = 0:End if
obj_Save_Rs("Editor") = Session("Admin_Name")
if Fs_News.isCheck = 1 then
obj_Save_Rs("isLock") = 1
str_checkTF=true
Else
Dim obj_lockTF,tmp_definedid_class
Set obj_lockTF=conn.execute("select NewsCheck,DefineID From FS_NS_NewsClass Where ClassID='"& str_ClassID &"'")
if obj_lockTF("NewsCheck") = 1 then
obj_Save_Rs("isLock") = 1
str_checkTF=true
Else
obj_Save_Rs("isLock") = 0
str_checkTF=false
End if
tmp_definedid_class = obj_lockTF(1)
obj_lockTF.close:set obj_lockTF = nothing
End if
'得到新闻类型参数
if str_NewsProperty_Rec <>"" then:str_NewsProperty_Rec_1 = 1:else:str_NewsProperty_Rec_1 = 0:End if
if str_NewsProperty_mar <>"" then:str_NewsProperty_mar_1 = 1:else:str_NewsProperty_mar_1 = 0:End if
if str_NewsProperty_rev <>"" then:str_NewsProperty_rev_1 = 1:else:str_NewsProperty_rev_1 = 0:End if
if str_NewsProperty_constr <>"" then:str_NewsProperty_constr_1 = 1:else:str_NewsProperty_constr_1 = 0:End if
if str_NewsProperty_tt <>"" then:str_NewsProperty_tt_1 = 1:else:str_NewsProperty_tt_1 = 0:End if
if str_NewsProperty_hots <>"" then:str_NewsProperty_hots_1 = 1:else:str_NewsProperty_hots_1 = 0:End if
if str_NewsProperty_jc <>"" then:str_NewsProperty_jc_1 = 1:else:str_NewsProperty_jc_1 = 0:End if
if str_NewsProperty_unr <>"" then:str_NewsProperty_unr_1 = 1:else:str_NewsProperty_unr_1 = 0:End if
if str_NewsProperty_ann <>"" then:str_NewsProperty_ann_1 = 1:else:str_NewsProperty_ann_1 = 0:End if
if str_NewsProperty_filt <>"" then:str_NewsProperty_filt_1 = 1:else:str_NewsProperty_filt_1 = 0:End if
if str_NewsProperty_Remote <>"" then:str_NewsProperty_Remote_1 = 1:else:str_NewsProperty_Remote_1 = 0:End if
obj_Save_Rs("NewsProperty") = str_NewsProperty_Rec_1&","&str_NewsProperty_mar_1&","&str_NewsProperty_rev_1&","&str_NewsProperty_constr_1&","&str_NewsProperty_Remote_1&","&str_NewsProperty_tt_1&","&str_NewsProperty_hots_1&","&str_NewsProperty_jc_1&","&str_NewsProperty_unr_1&","&str_NewsProperty_ann_1&","&str_NewsProperty_filt_1
obj_Save_Rs("isRecyle") = 0
obj_Save_Rs("addtime") = str_addtime
'辅助字段信息保存
'(c)2002-2006 版权所有:Foosun Inc. 不得进行任何性质的程序拷贝、传播。By Foosun__Simpwind.Xie
' if str_News_Action = "add_Save" then
dim obj_c_rs,i
If IsArray(CustColumnArr) Then
set obj_c_rs = Server.CreateObject(G_FS_RS)
obj_c_rs.open "select * From [FS_MF_DefineData] where 1=2",Conn,1,3
For i = 0 to UBound(CustColumnArr,2)
If Request.Form("FS_NS_Define_"&CustColumnArr(3,i))<>"" Then
obj_c_rs.Addnew
obj_c_rs("InfoType") = "NS"
obj_c_rs("InfoID") = str_NewsID
obj_c_rs("TableEName") =CustColumnArr(3,i)
obj_c_rs("ColumnValue")=Request.Form("FS_NS_Define_"&CustColumnArr(3,i))
obj_c_rs.Update
End If
Next
obj_c_rs.Close:Set obj_c_rs = nothing
End If
' else
'CustSql="select DefineID,ClassID,D_Name,D_Coul,D_Type,D_isNull,D_Value,D_Content,D_SubType from [FS_MF_DefineTable] Where D_SubType='NS' and Classid="& trim(Request.Form("d_Id")) &""
' If IsArray(CustColumnArr) Then
' Dim SaveAuxiSql
' For i = 0 to Ubound(CustColumnArr,2)
' set obj_c_rs = Server.CreateObject(G_FS_RS)
' SaveAuxiSql="select * From [FS_MF_DefineData] where InfoID='"&str_NewsID&"' and TableEName='" & CustColumnArr(3,i) & "' and InfoType='NS'"
' obj_c_rs.Open SaveAuxiSql,Conn,1,3
' If obj_c_rs.Eof Then
' If Request.Form("FS_NS_Define_"&CustColumnArr(3,i))<>"" Then
' obj_c_rs.Addnew
' obj_c_rs("InfoType") = "NS"
' obj_c_rs("TableEName")=CustColumnArr(3,i)
' obj_c_rs("ColumnValue")=Request.Form("FS_NS_Define_"&CustColumnArr(3,i))
' obj_c_rs("InfoID") = str_NewsID
' obj_c_rs.Update
' End If
' Else
' obj_c_rs("ColumnValue")=Request.Form("FS_NS_Define_"&CustColumnArr(3,i))
' obj_c_rs.Update
' End If
' obj_c_rs.Close:set obj_c_rs=nothing
' Next
' End If
' end if
if Trim(str_isdraft)<>"" then:obj_Save_Rs("isdraft")=1:else:obj_Save_Rs("isdraft")=0:end if
If IsAdPic=1 Then
obj_Save_Rs("IsAdPic")=1
obj_Save_Rs("AdPicWH")=AdPicWH
obj_Save_Rs("AdPicLink")=AdPicLink
obj_Save_Rs("AdPicAdress")=AdPicAdress
Else
obj_Save_Rs("IsAdPic")=0
End If
obj_Save_Rs.update
Dim Get_News_ID,rssql '取自动编号ID
if G_IS_SQL_DB = 0 then
Get_News_ID = obj_Save_Rs("ID")
Else
set rssql = Conn.execute("select top 1 id from FS_NS_News order by id desc")
Get_News_ID = rssql(0)
rssql.close:set rssql = nothing
End if
obj_Save_Rs.close:set obj_Save_Rs = nothing
if str_NewsType<>"TitleNews" then
'开始保存关键字,作者,来源等
Dim obj_save_Gener_Rs,obj_save_Gener_Rs1,obj_save_Gener_Rs2,obj_TF_Rs,tmp
if str_KeywordSaveTF <>"" then
for each tmp in split(Trim(Request.Form("KeywordText")),",")
if tmp <> "" then
Set obj_save_Gener_Rs=server.CreateObject(G_FS_RS)
obj_save_Gener_Rs.open "select Gid,G_Type,G_Name From [FS_NS_General] where G_Type=1 and G_Name='"&tmp&"'",Conn,1,3
If obj_save_Gener_Rs.eof Then
obj_save_Gener_Rs.Addnew
obj_save_Gener_Rs("G_Name") = tmp
obj_save_Gener_Rs("G_Type") = 1
obj_save_Gener_Rs.Update
End If
obj_save_Gener_Rs.Close:set obj_save_Gener_Rs = nothing
end if
next
End if
'保存作者
if str_AuthorSaveTF <>"" then
Set obj_save_Gener_Rs1=server.CreateObject(G_FS_RS)
obj_save_Gener_Rs1.Open "select Gid,G_Type,G_Name from FS_NS_General where G_Type=3 and G_Name='"& Trim(Request.Form("Author")) &"'",Conn,3,3
if obj_save_Gener_Rs1.eof then:obj_save_Gener_Rs1.addnew:obj_save_Gener_Rs1("G_Type") =3:obj_save_Gener_Rs1("G_Name") = Request.Form("Author"):obj_save_Gener_Rs1.update:end if:set obj_save_Gener_Rs1 = nothing
End if
'保存来源
if str_SourceSaveTF <>"" then
Set obj_save_Gener_Rs2=server.CreateObject(G_FS_RS)
obj_save_Gener_Rs2.Open "select Gid,G_Type,G_Name from FS_NS_General where G_Type=2 and G_Name='"& Trim(Request.Form("Source")) &"'",Conn,3,3
if obj_save_Gener_Rs2.eof then:obj_save_Gener_Rs2.addnew:obj_save_Gener_Rs2("G_Type") =2:obj_save_Gener_Rs2("G_Name") = Request.Form("Source"):obj_save_Gener_Rs2.update:end if:set obj_save_Gener_Rs2 = nothing
End if
'如果生成文件名规则中有:新闻自动编号ID
Dim TempRsObj
If Instr(str_FileName,"自动编号ID") Then
str_FileName = Replace(str_FileName,"自动编号ID",Get_News_ID)
Set TempRsObj=server.CreateObject(G_FS_RS)
TempRsObj.open "select FileName From [Fs_NS_News] where NewsID='"&str_NewsID&"' and ID="&Clng(Get_News_ID)&"",Conn,1,3
if not TempRsObj.eof Then
TempRsObj("FileName") = Replace(TempRsObj("FileName"),"自动编号ID",Get_News_ID)
TempRsObj.update
End If
TempRsObj.Close
End IF
Dim TempRsObj_1
If Instr(str_FileName,"唯一NewsID") Then
str_FileName = Replace(str_FileName,"唯一NewsID",str_NewsID)
Set TempRsObj_1=server.CreateObject(G_FS_RS)
TempRsObj_1.open "select FileName From [Fs_NS_News] where NewsID='"&str_NewsID&"'",Conn,1,3
if not TempRsObj_1.eof Then
TempRsObj_1("FileName") = Replace(TempRsObj_1("FileName"),"唯一NewsID",str_NewsID)
TempRsObj_1.update
End If
TempRsObj_1.Close
End IF
End if
if Trim(str_GroupID) <>"" or str_PointNumber <> "" or str_Money<>"" then
Dim obj_insert_rs
set obj_insert_rs = Server.CreateObject(G_FS_RS)
if str_News_Action = "add_Save" then
obj_insert_rs.Open "select GroupName,PointNumber,FS_Money,InfoID,PopType,isClass From FS_MF_POP",Conn,1,3
obj_insert_rs.addnew
Elseif str_News_Action = "Edit_Save" then
obj_insert_rs.Open "select GroupName,PointNumber,FS_Money,InfoID,PopType,isClass From FS_MF_POP where InfoID='"& str_NewsID &"' and PopType='NS' and isClass=0",Conn,1,3
if obj_insert_rs.eof then
obj_insert_rs.addnew
end if
End if
obj_insert_rs("GroupName")=str_GroupID
if str_PointNumber <>"" then:obj_insert_rs("PointNumber")=str_PointNumber:Else:obj_insert_rs("PointNumber")=0:End if
if str_Money <>"" then:obj_insert_rs("FS_Money")=str_Money:Else:obj_insert_rs("FS_Money")=0:End if
obj_insert_rs("InfoID")=str_NewsID
obj_insert_rs("PopType")="NS"
obj_insert_rs("isClass")=0
obj_insert_rs.update
obj_insert_rs.close:set obj_insert_rs = nothing
End if
'保存图片头条,插入数据库
sub saveTody()
if str_TodayNewsPicTF<>"" then
dim insertTodayPicobj
set insertTodayPicobj = Server.CreateObject(G_FS_RS)
insertTodayPicobj.open "select * From FS_NS_TodayPic where NewsId='"& str_NewsID &"'",Conn,1,3
if insertTodayPicobj.eof then
insertTodayPicobj.addnew
insertTodayPicobj("NewsID")= str_NewsID
insertTodayPicobj("TodayPic_font")= Request.Form("FontFace")
insertTodayPicobj("TodayPic_size")= Request.Form("FontSize")
insertTodayPicobj("TodayPic_color")= Request.Form("FontColor")
insertTodayPicobj("TodayPic_space")= Request.Form("FontSpace")
insertTodayPicobj("TodayPic_PicColor")= Request.Form("FontBgColor")
insertTodayPicobj("ClassID")= str_ClassID
insertTodayPicobj("TodayPic_SavePath")= str_NewsID
insertTodayPicobj("TodayTitle")= Request.Form("PicTitle")
if not isnumeric(Request.Form("PicTitlewidth")) then
insertTodayPicobj("Todaywidth")= 300
else
insertTodayPicobj("Todaywidth")= clng(Request.Form("PicTitlewidth"))
end if
insertTodayPicobj("addtime")= now
insertTodayPicobj.update
insertTodayPicobj.close:set insertTodayPicobj = nothing
Else
insertTodayPicobj("TodayPic_font")= Request.Form("FontFace")
insertTodayPicobj("TodayPic_size")= Request.Form("FontSize")
insertTodayPicobj("TodayPic_color")= Request.Form("FontColor")
insertTodayPicobj("TodayPic_space")= Request.Form("FontSpace")
insertTodayPicobj("TodayPic_PicColor")= Request.Form("FontBgColor")
insertTodayPicobj("TodayPic_SavePath")= str_NewsID
insertTodayPicobj("addtime")= now
insertTodayPicobj("TodayTitle")= Request.Form("PicTitle")
if not isnumeric(Request.Form("PicTitlewidth")) then
insertTodayPicobj("Todaywidth")= 300
else
insertTodayPicobj("Todaywidth")= clng(Request.Form("PicTitlewidth"))
end if
insertTodayPicobj.update
insertTodayPicobj.close:set insertTodayPicobj = nothing
End if
End if
end sub
'生成静态文件开始
If Not str_NewsType="TitleNews" Then
Call Refresh("NS_news",Get_News_ID)
End If
'*****保留
' if Trim(str_isdraft)<>"" then
' str_isDraftTF=""& Fs_news.allInfotitle &"已经保存到草稿箱中"& Fs_news.allInfotitle &"未发布"
' str_ReturnUrl ="../News_MyFolder.asp?Action=draft"
' else
' if str_News_Action = "Edit_Save" then
' str_isDraftTF=""
' Else
' str_isDraftTF=""& Fs_news.allInfotitle &"添加成功!"
' End if
' str_ReturnUrl = "../news_Manage.asp?ClassID="&str_ClassID&""
' end if
' if str_News_Action = "add_Save" then
if str_checkTF = true then
strShowErr = ""& str_isDraftTF &"系统设置(或者栏目)为需要审核后才能发布到前台
继续添加 返回编辑 返回管理"
Else
'strShowErr = ""& str_isDraftTF &"
继续添加 返回编辑 返回管理"
End if
if str_TodayNewsPicTF<>"" then
If tmp_returnvalue = False Then
strShowErr = ""& str_isDraftTF &"新闻添加成功注意:头条图片生成失败,没有开启水印组件或者水印组件异常!!
继续添加 返回编辑 返回管理"
End If
end if
' Elseif str_News_Action = "Edit_Save" then
' strShowErr = ""& str_isDraftTF &"修改成功!!继续修改新闻?? 返回新闻管理??"
' if str_TodayNewsPicTF<>"" then
' If tmp_returnvalue = False Then
' strShowErr = ""& str_isDraftTF &"修改成功注意:头条图片生成失败,没有开启水印组件或者水印组件异常!!继续修改新闻?? 返回新闻管理??"
' End If
' end if
' End if
'Response.Redirect("lib/Success.asp?ErrCodes="&Server.URLEncode(strShowErr)&"&ErrorUrl="& str_ReturnUrl &"")
Response.Write("1"&strShowErr&"")
Response.end
%>