saveaddnews.asp

ASP编写的一个公司网站的源程序

<%Response.Buffer=true %>
<link rel="stylesheet" href="../Css/css.css" type="text/css">
<!--#include virtual="/include/DBConn.asp"-->
<!--#include virtual="/include/ChkSession.asp"-->
<!--#include virtual="/include/upload_5xsoft.inc"--> 
<!--#include virtual="/include/FuncPub.asp"-->
<!--#include virtual="/include/Const.asp"-->
<!--#include file="Menu.asp"-->
<%
Dim News_ID
Dim News_Title
Dim News_Author
Dim News_Source
Dim News_Content
Dim State
Dim Photo_Path
Dim Orderline


Dim fso
'创建文件上传对象
'Set fileup = Server.CreateObject("SoftArtisans.FileUp")
Dim fileup 
Set fileup = New upload_5xsoft
'创建文件操作对象
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Dim rs,StrSQL
Set rs=server.CreateObject ("ADODB.RecordSet")
	News_Title = ModifyInput(fileup.form("News_Title"))
	checkinput
	News_Author = ModifyInput(fileup.form("News_author"))
	News_Source = ModifyInput(fileup.form("News_Source"))
	News_Content = Replace(fileup.form("body"),"'","''")
	State = ModifyInput(fileup.form("state"))
	Dim years,months,days,Newsdate
	years = ModifyInput(fileup.form("years"))
	months = ModifyInput(fileup.form("months"))
	days = ModifyInput(fileup.form("days"))
	Newsdate = years & "-" & months & "-" & days
	Dim fileupimg
	Set fileupimg = fileup.file("Photo_Path")
	Photo_Path = trim(fileupimg.filename)
	If Photo_Path<>"" then
		IF UCASE(GetFileNameExt(Photo_Path))<>"GIF" and UCASE(GetFileNameExt(Photo_Path))<>"JPG" then
			Response.Write "<script language='javascript'>"
			Response.Write "alert('对不起！你上传的图片格式只能是GIF或JPG！');"
			Response.Write "window.history.go(-1);"
			Response.Write "</script>"
			Response.End
		End IF
		If fileupimg.filesize > UPLOAD_IMGMAXFILESIZE then
			Response.Write "<script language='javascript'>"
			Response.Write "alert('对不起！请将您的缩小图片控制在5M以下！');"
			Response.Write "window.history.go(-1);"
			Response.Write "</script>"
			Response.End
		End If
	Else
			'Response.Write "<script language='javascript'>"
			'Response.Write "alert('请上传图片！');"
			'Response.Write "window.history.go(-1);"
			'Response.Write "</script>"
			'Response.End	
	End If

	'On Error Resume Next
	StrSQL = "Select * From News Where News_ID=0"
	rs.CursorLocation = 3
	rs.Open StrSQL,conn,1,3 
	rs.AddNew 
		rs("News_Title") = News_Title
		rs("News_Author") = News_Author
		rs("News_Source") = News_Source
		rs("News_Content") = News_Content
		rs("News_Pubdate") = Newsdate
		rs("State") = State
		rs("CatID") = Session("CatID")
	rs.Update 
		News_ID = rs("News_ID")
	rs.Close
	Conn.Execute "Update News Set Orderline="&News_ID&" where News_ID="&News_ID	
	Dim strFullPath
	strFullPath = Request.ServerVariables("APPL_PHYSICAL_PATH")
	if Right(strFullPath,1) = "\" then
		strFullPath = left(strFullPath,len(strFullPath)-1)
	end if
If Photo_Path<>"" then
	if fso.FolderExists(strFullPath & UPLOAD_NEWSPATH & Session("CatID") )=False then
		fso.CreateFolder strFullPath & UPLOAD_NEWSPATH & Session("CatID")
	end if
	if fso.FolderExists(strFullPath & UPLOAD_NEWSPATH & Session("CatID") & "\" & News_ID )=False then
		fso.CreateFolder strFullPath & UPLOAD_NEWSPATH & Session("CatID") & "\" & News_ID 
	end if
	
	fileupimg.SaveAs strFullPath & UPLOAD_NEWSPATH & Session("CatID") & "\" & News_ID & "\" & Photo_Path
	
	Photo_Path = Replace(UPLOAD_NEWSPATH & Session("CatID") & "\" & News_ID & "\" & Photo_Path,"\","/")
	Conn.Execute "Update News Set Photo_Path='"&Photo_Path&"' where News_ID="&News_ID&""
End IF	
	
	Set rs = Nothing
	Set fileup = Nothing
	Set fso = Nothing
	If Err.number<>0 then
		Call MsgBack("数据库操作错误！","4")
	Else
		Response.Redirect "NewsManage.asp?Catalog_ID="&Session("CatID")
		Response.End	
	End IF 
	
Sub Checkinput
	Dim Rs,StrSQL
	StrSQL="select count(*) as cou from News where News_title='"&News_Title&"' and CatID="&Session("CatID")&""
	set Rs = conn.execute(StrSQL)
	If cint(Rs("cou"))<>0 then
		Rs.close 
		Call MsgBack("标题重复,请重新输入！","4")
		exit Sub
	End If
	Rs.Close
End Sub	
%>