📄 newspic.asp

📁 asp源码图片ASP整站
💻 ASP
📖 第 1 页 / 共 3 页
字号:
12 3 下一页
<% Option Explicit %>
<!--#include file="../../../Inc/Const.asp" -->
<!--#include file="../../../Inc/Cls_DB.asp" -->
<!--#include file="../../../Inc/Cls_Cache.asp" -->
<!--#include file="../../../Inc/Cls_User.asp" -->
<!--#include file="../../../Inc/Function.asp" -->
<!--#include file="../../../Inc/ThumbnailFunction.asp" -->
<!--#include file="../Refresh/Cls_Refresh.asp" -->
<!--#include file="../Refresh/Function.asp" -->
<!--#include file="../Refresh/RefreshFunction.asp" -->
<%
'==============================================================================
'软件名称：风讯网站信息管理系统
'当前版本：Foosun Content Manager System(FoosunCMS V3.1.0930)
'最新更新：2005.10
'==============================================================================
'Copyright (C) 2002-2004 Foosun.Net  All rights reserved.
'商业注册联系：028-85098980-601,项目开发：028-85098980-606、609,客户支持：608
'产品咨询QQ：394226379,159410,125114015
'技术支持QQ：315485710,66252421 
'项目开发QQ：415637671，655071
'程序开发：四川风讯科技发展有限公司(Foosun Inc.)
'Email:service@Foosun.cn
'MSN：skoolls@hotmail.com
'论坛支持：风讯在线论坛(http://bbs.foosun.net)
'官方网站：www.Foosun.cn  演示站点：test.cooin.com 
'网站通系列(智能快速建站系列)：www.ewebs.cn
'==============================================================================
'免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接
'风讯公司保留此程序的法律追究权利
'如需进行2次开发，必须经过风讯公司书面允许。否则将追究法律责任
'==============================================================================
response.buffer=true
Dim DBC,Conn,UserConn
Set DBC = New DataBaseClass
Set Conn = DBC.OpenConnection()
DBC.ConnStr = "DBQ=" + Server.MapPath(UserDBConnectStr) + ";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
Set UserConn = DBC.OpenConnection()
Set DBC = Nothing
%>
<!--#include file="../../../Inc/Session.asp" -->
<!--#include file="../../../Inc/CheckPopedom.asp" -->
<%
Dim sHaveValueTF
if CInt(GetConfig(20)) = 1 then
	sHaveValueTF = True
Else
	sHaveValueTF = False
End if
if Not JudgePopedomTF(Session("Name"),"" & Request("ClassID") & "") then Call ReturnError1()
if Request("NewsID") <> "" then
	if Not JudgePopedomTF(Session("Name"),"P010502") then Call ReturnError1()
else
	if Not JudgePopedomTF(Session("Name"),"P010501") then Call ReturnError1()
end if
Dim TempClassID,OldClassObj,OldClassEName,NewsExtFileName
Dim Action
Dim ITodayNewsTF,IBrowPop,IAddDate,IKeyWords,ITxtSource,IAuthor,IFilterNews,IAuditTF,ITitleSHowReview
Dim IEditer,IClickNum,ISpecialID,IPicPath,IShowReviewTF,IReviewTF,ISBSNews,IMarqueeNews,IProclaimNews,ILinkTF,IClassBuildNewsTemp
Dim IFocusNewsTF,IClassicalNewsTF,INewsTemplet,INaviWords,ITitleColor,ISavePic,IFileName,IFileExtName,IPath,IRecTF
Dim EditContentTF
Dim RsSelectObj,HaveValueTF
EditContentTF = False
Action = Request("Action")
IClassID = Request.Form("ClassID")
if IClassID="" then IClassID=Request("ClassID")
INewsID = Request("NewsID")
if INewsID = "" then
	EditContentTF = False
else
	EditContentTF = True
end if
If IClassID <> "" then
	TempClassID = Cstr(IClassID)
	TempClassID = Replace(Replace(Replace(Replace(Replace(TempClassID,"'",""),"and",""),"select",""),"or",""),"union","")
	Set OldClassObj = Conn.Execute("Select ClassID,ClassEName,NewsTemp,ClassCName,FileExtName from FS_NewsClass where ClassID='" & TempClassID & "'")
	if Not OldClassObj.Eof then
		NewsExtFileName=OldClassObj("FileExtName")
		OldClassEName = OldClassObj("ClassCName")
		IClassBuildNewsTemp = OldClassObj("NewsTemp")
	end if
	OldClassObj.Close
	Set OldClassObj = Nothing
else
	Response.Write("<script>alert(""参数传递错误"");history.back();</script>")
	Response.End
End If
if Action = "Submit" then
	HaveValueTF = False
else
	if INewsID <> "" Then
		INewsID = Replace(Replace(Replace(Replace(Replace(INewsID,"'",""),"and",""),"select",""),"or",""),"union","")
		Set RsSelectObj = Conn.Execute("Select * from FS_News where NewsID='" & INewsID & "'")
		if Not RsSelectObj.Eof then
			ITitle = RsSelectObj("Title")
			ISubTitle = RsSelectObj("SubTitle")
			ITitleColor = Left(RsSelectObj("Titlestyle"),7)
			TitleBoldstr = Mid(RsSelectObj("Titlestyle"),8,1)
			TitleUstr = Right(RsSelectObj("Titlestyle"),1)
			IContent = RsSelectObj("Content")
			ITodayNewsTF = RsSelectObj("TodayNewsTF")
			IManuTF = RsSelectObj("ManuTF")
			IFileName = RsSelectObj("FileName")
			IBrowPop = RsSelectObj("BrowPop")
			IFileExtName = RsSelectObj("FileExtName")
			IPath = RsSelectObj("Path")
			IAddDate = RsSelectObj("AddDate")
			IKeyWords = RsSelectObj("KeyWords")
			ITxtSource = RsSelectObj("TxtSource")
			IAuthor = RsSelectObj("Author")
			IEditer = RsSelectObj("Editer")
			IClickNum = RsSelectObj("ClickNum")
			IRecTF = RsSelectObj("RecTF")
			ISpecialID = RsSelectObj("SpecialID")
			IAuditTF = RsSelectObj("AuditTF")
			IShowReviewTF = RsSelectObj("ShowReviewTF")
			IReviewTF = RsSelectObj("ReviewTF")
			ISBSNews = RsSelectObj("SBSNews")
			IMarqueeNews = RsSelectObj("MarqueeNews")
			IProclaimNews = RsSelectObj("ProclaimNews")
			ILinkTF = RsSelectObj("LinkTF")
			IFilterNews = RsSelectObj("FilterNews")
			INewsTemplet = RsSelectObj("NewsTemplet")
			IPicPath = RsSelectObj("PicPath")
			IFocusNewsTF = RsSelectObj("FocusNewsTF")
			IClassicalNewsTF = RsSelectObj("ClassicalNewsTF")
			ITitleSHowReview=RsSelectObj("TitleSHowReview")
			HaveValueTF = True
		else
			HaveValueTF = False
		end if
		Set RsSelectObj = Nothing
	else
		HaveValueTF = False
	end if
end if
if HaveValueTF = False then
	ITitle = NoCSSHackAdmin(Request("Title"),"标题")
	ISubTitle = Request("SubTitle")
	ITitleColor = Request("TitleColor")
	TitleBoldstr = Request("TitleBold")
	TitleUstr = Request("Titles")
	ISavePic = Request("SavePic")
	Dim TempForVar
	For TempForVar = 1 To Request.Form("Content").Count
		IContent = IContent & Request.Form("Content")(TempForVar)
	Next
	ITodayNewsTF = Request("TodayNewsTF")
	IManuTF = Request("ManuTF")
	IFileName = Request("FileName")
	IBrowPop = Request("BrowPop")
	IFileExtName = Request("FileExtName")
	IPath = Request("Path")
	IAddDate = Request("AddDate")
	if IAddDate = "" then IAddDate = Now()
	IKeyWords = Request("KeyWords")
	ITxtSource = Request("TxtSource")
	IAuthor = Request("Author")
	IEditer = Request("Editer")
	IClickNum = Request("ClickNum")
	IRecTF = Request("RecTF")
	ISpecialID = Request("SpecialID")
	IAuditTF = Request("AuditTF")
	IShowReviewTF = Request("ShowReviewTF")
	IReviewTF = Request("ReviewTF")
	ISBSNews = Request("SBSNews")
	IMarqueeNews = Request("MarqueeNews")
	IProclaimNews = Request("ProclaimNews")
	ILinkTF = Request("LinkTF")
	IFilterNews = Request("FilterNews")
	INewsTemplet = Request("NewsTemplet")
	IPicPath = Request("PicPath")
	IFocusNewsTF = Request("FocusNewsTF")
	IClassicalNewsTF = Request("ClassicalNewsTF")
	ITitleSHowReview=Request("TitleSHowReview")
	INaviWords=Request("NaviWords")
end if
if IsNull(IContent) then
	IContent = ""
else
	IContent = Replace(Replace(IContent,"""",""),"'","")
	end if
if INewsTemplet = "" OR INewsTemplet = Null then
	INewsTemplet = IClassBuildNewsTemp
end if
if IFileExtName = "" OR IFileExtName = Null then
	IFileExtName = NewsExtFileName
end if

if Request.Form("Action")="Submit" then
	Dim INewsAddObj,INewsAddSql
	Dim NewsFileNames
	if GetStrTrueLen(Trim(ITitle)) >0 And GetStrTrueLen(Trim(ITitle))<=255 then
		ITitle = Replace(Replace(ITitle,"""",""),"'","")
	Else
		'2006-4-27
		Response.Write("<script>alert('新闻标题长度应该大于0小于255个字符（127个汉字）');history.back();</script>")
		Response.End
		'=================
	end if
	if IClassID <> "" then
		IClassID = Replace(Replace(IClassID,"""",""),"'","")
	else
		Response.Write("<script>alert('栏目参数传递错误');history.back();</script>")
		Response.End
	end if
	if INewsTemplet <> "" then
		INewsTemplet = Replace(Replace(INewsTemplet,"""",""),"'","")
	else
		Response.Write("<script>alert('请选择新闻模板文件');history.back();</script>")
		Response.End
	end if 
	if Isnumeric(IClickNum) then
		IClickNum = Clng(IClickNum)
	else
		Response.Write("<script>alert('新闻初始点击次数必须为数字类型');history.back();</script>")
		Response.End
	end if 
	if IsDate(IAddDate) then
		IAddDate = Formatdatetime(IAddDate)
	else
		Response.Write("<script>alert('新闻添加时间类型错误,请重新输入');history.back();</script>")
		Response.End
	end if
	if IPicPath = "" and request("ToWords")="" then
		Response.Write("<script>alert('请输入图片地址');history.back();</script>")
		Response.End
	end if
	if IContent = "" or IsNull(IContent) then
		Response.Write("<script>alert('请输入新闻内容');history.back();</script>")
		Response.End
	end if
	if INewsID <> "" Then
		INewsID = Replace(Replace(Replace(Replace(Replace(INewsID,"'",""),"and",""),"select",""),"or",""),"union","")
		Set INewsAddObj = Server.CreateObject(G_FS_RS)
		INewsAddSql = "select * from FS_News where NewsID='" & INewsID & "'"
		INewsAddObj.open INewsAddSql,Conn,3,3
	else
		INewsID = GetRandomID18()
		Set INewsAddObj = Server.CreateObject(G_FS_RS)
		INewsAddSql = "select * from FS_News where 1=0"
		INewsAddObj.open INewsAddSql,Conn,3,3
		INewsAddObj.AddNew
		INewsAddObj("NewsID") = INewsID    '新闻ID
		NewsFileNames = NewsFileName(GetConfig(16),IClassID,INewsID)
		INewsAddObj("FileName") = NewsFileNames   '新闻文件名
		INewsAddObj("Path") =  "/" & year(now())&"-"&month(now())&"/"&day(now())             '新闻路径 
	end if
	Dim INewsID,ITitle,ISubTitle,TitleBoldstr,TitleUstr,IClassID,IContent,IManuTF
	INewsAddObj("Title") = ITitle
	'If ISubTitle <> "" then
		INewsAddObj("SubTitle") = Replace(Replace(ISubTitle,"""",""),"'","")
	'end if
	If request("ToWords")<>"" then 
		INewsAddObj("PicNewsTF") =  0
	else
		INewsAddObj("PicNewsTF") =  1
	End If
	If TitleBoldstr <> "" then
		TitleBoldstr = "1"		
	else
		TitleBoldstr="0"		
	end if
	If TitleUstr <> "" then
		TitleUstr="1"		
	else
		TitleUstr="0"		
	end if
	INewsAddObj("Titlestyle") =  ITitleColor & TitleBoldstr & TitleUstr
	INewsAddObj("ClassID") =  IClassID
	INewsAddObj("HeadNewsTF") = "0"
	If IFileName <> "" then
INewsAddObj("FileName") = IFileName
Else
INewsAddObj("FileName") = NewsFileNames
End If
	Dim Content_Loop_Var,Save_Content
	For Content_Loop_Var = 1 To Request.Form("Content").Count
		Save_Content = Save_Content & Request.Form("Content")(Content_Loop_Var)
	Next
	'===========================
	'自动分页
	If instr(Save_Content,"[NoPage]") then
		Save_Content=replace(replace(Save_Content,"[Page]",""),"[NoPage]","")
	Else
		Save_Content=AutoSplitPages(Save_Content)
	End If
	'============================
	'过滤脏字
	Save_Content = CutBadChar(Save_Content)
	'============================
	If ISavePic = "1" then
		CreateDateDir(Server.MapPath(Get_RootDir&"/"&UpFiles & "/" & BeyondPicDir))
		Save_Content = ReplaceRemoteUrl(Save_Content,"/" & UpFiles & "/" & BeyondPicDir&"/"&year(Now())&"-"&month(now())&"/"&day(Now()),GetConfig(0),Get_RootDir)
	End If
	'============================
	'生成缩略图
	Dim AutoRefreshSmallPic,PicFileName,CreateSmallPicOK
	CreateSmallPicOK=False
	AutoRefreshSmallPic=GetConfig(32)
	If AutoRefreshSmallPic="1" then
		PicFileName=mid(IPicPath,InstrRev(IPicPath,"/")+1)
		If left(IPicPath,4)="http" then
			SaveRemoteFile Get_RootDir&"/"&UpFiles&"/"&BeyondPicDir&"/sPic_"&PicFileName,IPicPath
			CreateSmallPicOK=CreateThumbnailEx(Get_RootDir&"/"&UpFiles&"/"&BeyondPicDir&"/sPic_"&PicFileName,Get_RootDir&"/"&UpFiles&"/"&BeyondPicDir&"/sPic_"&PicFileName)
			If CreateSmallPicOK=true then  IPicPath="/"&UpFiles&"/"&BeyondPicDir&"/sPic_"&PicFileName
		ElseIf Instr(IPicPath,"/sPic_")=0 then
			CreateSmallPicOK=CreateThumbnailEx(Get_RootDir&IPicPath,Get_RootDir&left(IPicPath,InstrRev(IPicPath,"/"))&"sPic_"&PicFileName)
			If CreateSmallPicOK=true then  IPicPath=left(IPicPath,InstrRev(IPicPath,"/"))&"sPic_"&PicFileName
		End If
	End If
	'============================
12 3 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -