bloginterface.asp

来自「是个不错的文件代码,希望大家好好用,」· ASP 代码 · 共 812 行 · 第 1/2 页

<!--#include file="../inc/inc_syssite.asp"-->
<!--#include file="../inc/md5.asp"-->
<!--#include file="../inc/class_blog.asp"-->
<!--#include file="../inc/class_Trackback.asp"-->
<%
Dim afxDebug
Const MAX_GETRECENTPOSTS_NUM				= 0		'getRecentPosts最多允许的文章数量,0为不限制
Const MAX_PUBLISHSPACE_TIME					= 10		'两次发布文章最小时间间隔 单位/秒, 0为不限制
'无效Const MAX_UPLOADFILESPACE_TIME				= 0		'两次上传文件最小时间间隔 单位/秒, 0为不限制

Const UPLOADFILE_SIGN						= true	'是否允许上传文件.

Const ERROR_NOT_LEGAL_XMLREQUEST			= 1		'不是有效格式的XML请求
Const ERROR_UNKNOW_BLOGAPIMETHOD			= 2		'未知的BlogAPI方法
Const ERROR_NOT_LEGAL_USER					= 3		'用户名或密码错误
Const ERROR_NOT_EXIST_ARTICLE				= 4		'要修改的文章不存在
Const ERROR_ACCESS_DATABASE_FAILED			= 5		'ASP端数据库操作失败
Const ERROR_NOT_LEGAL_TITLE					= 6		'标题为空或大于100
Const ERROR_NOT_LEGAL_CONTENT				= 7		'内容为空或过长oblog.setup(75,0)
Const ERROR_NOT_LEGAL_KEYWORD				= 8		'内容中含有不合法的关键字
Const ERROR_FORBID_UPLOADFILE				= 9		'当前系统设置不允许上传文件
Const ERROR_NOSPACE_FOR_UPLOADFILE			= 10	'上传空间已满，不允许上传文件,请整理上传文档
Const ERROR_NOT_LEGAL_GETRECENTPOSTS_NUM	= 11	'超过允许的获取文章数量
Const ERROR_NOT_LEGAL_PUBLISHSPACE_TIME		= 12	'不符合允许发布的最小时间间隔
Const ERROR_SHUTDOWN_UPLOADFILE				= 13	'不允许上传文件
Const ERROR_SHUTDOWN_UPLOADFILE_1			= 14	'单个文件尺寸超过限制
Const ERROR_SHUTDOWN_UPLOADFILE_2			= 15	'不是合法的上传类型

Function ErrorDetail(faultCode)

	Select Case faultCode
		Case 1
			ErrorDetail = "不是有效格式的XML请求"
		Case 2
			ErrorDetail = "未知的BlogAPI方法"
		Case 3
			ErrorDetail = "用户名或密码错误"
		Case 4
			ErrorDetail = "要修改的文章不存在"
		Case 5
			ErrorDetail = "ASP端数据库操作失败"
		Case 6
			ErrorDetail = "标题为空或大于100"
		Case 7
			ErrorDetail = "内容为空或过长(不超过" & oblog.CacheConfig(34) & ")"
		Case 8
			ErrorDetail = "内容中含有不合法的关键字"
		Case 9
			ErrorDetail = "当前系统设置不允许上传文件" & afxDebug
		Case 10
			ErrorDetail = "上传空间已满，不允许上传文件,请整理上传文档"
		Case 11
			ErrorDetail = "超过允许获取的最多文章数量"
		Case 12
			ErrorDetail = "不符合允许的两次发布文章的最小时间间隔"
		Case 13
			ErrorDetail = "当前设置不允许上传文件"
		Case 14
			ErrorDetail = "文件尺寸超过限制"
		Case 15
			ErrorDetail = "不是合法的上传类型"
		Case Else
			ErrorDetail = "调试代码" & afxDebug
	End Select
	
End Function


Function ResponseError(faultCode)

	Dim strXML
	Dim strError

	strXML="<?xml version=""1.0"" encoding=""gb2312""?><methodResponse><fault><value><struct><member><name>faultCode</name><value><int>$1</int></value></member><member><name>faultString</name><value><string>$2</string></value></member></struct></value></fault></methodResponse>"

	strError=strXML
	strError=Replace(strError,"$1",TransferHTML(faultCode,"[<][>][&][""]"))
	strError=Replace(strError,"$2",TransferHTML(ErrorDetail(faultCode),"[<][>][&][""]"))

	Response.Clear
	Response.Write strError
	Response.End

	conn.Close
	Set conn = Nothing
End Function


Function TransferHTML(source,para)
	On Error Resume Next
	Dim objRegExp

	'先换"&"
	If Instr(para,"[&]")>0 Then  source=Replace(source,"&","&amp;")
	If Instr(para,"[<]")>0 Then  source=Replace(source,"<","&lt;")
	If Instr(para,"[>]")>0 Then  source=Replace(source,">","&gt;")
	If Instr(para,"[""]")>0 Then source=Replace(source,"""","&quot;")
	If Instr(para,"[space]")>0 Then source=Replace(source," ","&nbsp;")
	If Instr(para,"[enter]")>0 Then
		source=Replace(source,vbCrLf,"<br/>")
		source=Replace(source,vbLf,"<br/>")
	End If

	TransferHTML=source

End Function


Function FilterSQL(strSQL)

	FilterSQL=CStr(Replace(strSQL,chr(39),chr(39)&chr(39)))

End Function


Function GetGeneralCategories()

	GetGeneralCategories = False
	Dim i
	Dim aryAllData
	Dim arySingleData()
	Dim rs

	Erase GeneralCategories
	
	set rs=server.createobject("adodb.recordset")
	rs.open "SELECT [subjectid],[subjectname],[subjectname],[ordernum],[subjectlognum] FROM [oblog_subject] where userid="&objUser.id,conn,1,1
	If (Not rs.bof) And (Not rs.eof) Then
		i=rs.RecordCount
		ReDim GeneralCategories(i)
		aryAllData = rs.GetRows()
		rs.Close
		Set rs = Nothing
		'k = UBound(aryAllData,0)
		'l = UBound(aryAllData,1)
		For i = 0 To i-1
			Set GeneralCategories(i) = New BlogCategory
			GeneralCategories(i).LoadInfoByArray(Array(aryAllData(0,i),aryAllData(1,i),aryAllData(2,i),aryAllData(3,i),aryAllData(4,i)))
		Next
	else
		rs.close
		set rs=nothing
	End If

	GetGeneralCategories = True

End Function


Function GetSystemCategories()

	GetSystemCategories = False
	Dim i
	Dim aryAllData
	Dim arySingleData()
	Dim rs

	Erase SystemCategories
	
	set rs=server.createobject("adodb.recordset")
	rs.open "SELECT [classid],[classname],[classname],[ordernum],[classlognum] FROM [oblog_logclass] WHERE idType = 0",conn,1,1
	If (Not rs.bof) And (Not rs.eof) Then
		i=rs.RecordCount
		ReDim SystemCategories(i)
		aryAllData = rs.GetRows()
		rs.Close
		Set rs = Nothing
		'k = UBound(aryAllData,0)
		'l = UBound(aryAllData,1)
		For i = 0 To i-1
			Set SystemCategories(i) = New BlogCategory
			SystemCategories(i).LoadInfoByArray(Array(aryAllData(0,i),aryAllData(1,i),aryAllData(2,i),aryAllData(3,i),aryAllData(4,i)))
		Next
	else
		rs.close
		set rs=nothing
	End If

	GetSystemCategories = True

End Function


Sub deloneblog(logid)
	Dim truedel,wsql
	truedel = false
	wsql=" and ( userid="&objUser.Id&" or authorid="&objUser.Id&" )"
	
    logid = Int(logid)
    Dim uid, delname, rst, fso, sid,Scores
    Set rst = Server.CreateObject("adodb.recordset")
    If Not IsObject(conn) Then link_database
    rst.open "select userid,logfile,subjectid,logtype,scores,isdel from oblog_log where logid="&logid&wsql,conn,1,3
    If rst.Eof Then
        rst.Close
        Set rst = Nothing
        Exit Sub
    End If
	uid = rst(0)
	delname = Trim(rst(1))
	sid = rst(2)
	'清理图片记录,已取消
'	If rst("logtype") = 1 Then
'	    Call DeletePhotos(logid)
'	End If
	'真实域名需要重新整理文件数据
	'物理文件即时删除
	If true_domain = 1 And delname <> "" Then
	    If InStr(delname, "archives") Then
	        delname = Right(delname, Len(delname) - InStrRev(delname, "archives") + 1)
	    Else
	        delname = Right(delname, Len(delname) - InStrRev(delname, "/"))
	    End If
	    delname=oblog.l_udir&"/"&oblog.l_ufolder&"/"&delname
	    'response.write(delname)
	    'response.end
	End If
	If delname <> "" Then
	    Set fso = Server.CreateObject("Scripting.FileSystemObject")
	    If fso.FileExists(Server.MapPath(delname)) Then fso.DeleteFile Server.MapPath(delname)
	End If
	Scores=OB_IIF(rst("scores"),0)
	'回收与删除
	'response.Write(truedel)
	'response.End()
	If not truedel Then
		rst("isdel")=1
		rst.Update
	Else	
		rst.Delete
	End If
	rst.Close
	'--------------------------------------------
	Call Tags_UserDelete(logid)		
	'更新计数器
	oblog.Execute ("update oblog_user set log_count=log_count-1 where userid=" & uid)
	If not truedel Then
		oblog.Execute ("Update oblog_comment Set isdel=1 where mainid=" & Int(logid)) 
	Else
		oblog.Execute ("delete from oblog_comment where mainid=" & Int(logid))
	End If
	oblog.Execute ("update oblog_subject set subjectlognum=subjectlognum-1 where subjectid=" & Int(sid))
	'删除积分
	Call oblog.GiveScore("",-1*Abs(oblog.CacheScores(3)),"")
	'--------------------------------------------
	Dim blog
	Set blog = New class_blog
	blog.userid = uid
	blog.Update_Subject uid
	blog.Update_index 0
	blog.Update_newblog (uid)
	Set blog = Nothing
	Set fso = Nothing
	Set rst = Nothing
End Sub


Class BlogUser

	Public Name
	Public Password
	Public Id
	Public Url

	Public Function Verify()
	
		Dim strUserName
		Dim strPassWord
		Verify = False		
		strUserName = FilterSQL(Name)
		strPassWord = FilterSQL(Password)
		
		oblog.SaveCookie strUserName, strPassWord, 0, ""
		
		if oblog.checkuserlogined() then
			Id = oblog.l_uid
			Verify = True
		else
			Verify = False
		end if	
	End Function

End Class


Class BlogCategory

	Public Id
	Public Name
	Public Intro
	Public Order
	Public Count

	Public Function LoadInfoByArray(aryCateInfo)

		If IsArray(aryCateInfo) = True Then
			Id		= aryCateInfo(0)
			Name	= aryCateInfo(1)
			Intro	= aryCateInfo(2)
			Order	= aryCateInfo(3)
			Count	= aryCateInfo(4)
		End If

		If IsNull(Intro) Then
			Intro=""
		End If

		LoadInfoByArray=True

	End Function

End Class


Class BlogArticle

	Public Id

	Public Topic
	Public Log_Text
	Public Face
	Public AddTime
	Public Tags
	Public Trackback

	Public ClassId
	Public SubjectId
	Public AuthorID
	Public Author
	Public UserId
	
	
	Public IsHide
	Public IsTop
	Public TbUrl
	Public LogType
	Public IsEncomment
	Public Abstract
	Public IsPassword
	Public PassCheck
	Public IsDraft
	Public Iis
	Public CommentNum
	Public TrackbackNum
	Public Blog_Password
	Public TrueTime
    
	Private Function SetDefaultData()
	
		Topic			= EncodeJP(oblog.filt_astr(Topic,250))
		Log_Text		= EncodeJP(oblog.filtpath(oblog.filt_badword(Log_Text)))
		Face			= 0
		'AddTime			=		'xml传入
		If ClassId = "" Then ClassId = 0 End If		'xml传入
		If SubjectId = "" Then SubjectId = 0 End If	'xml传入
		'AuthorID		=		'由全局变量传入
		'Author			=		'由全局变量传入
		'UserId			=		'由全局变量传入
		IsHide			= 0
		IsTop			= 0
		TbUrl			= ""
		LogType			= 0
		IsEncomment		= 1
		Abstract		= ""
		IsPassword		= ""
		If oblog.l_Group(11,0) = 1 Then'日志需要管理员审核后才可见
			PassCheck = 0
		Else
			PassCheck = 1
		End If
		'IsDraft		= 		'是否为草稿,由xml传入
		Iis				= 0
		CommentNum		= 0
		TrackbackNum	= 0
		Blog_Password	= 0
		TrueTime		= Now()		
		'Tags			=		'由xml传入
		'TrackBack		=		'由xml传入
	
	End Function

	Public Function AddNew()

		AddNew = False
		SetDefaultData()
		
		'标题为空或大于100
		If Topic = "" Or StrLength(Topic) > 100 Then
			ResponseError(ERROR_NOT_LEGAL_TITLE)
			Exit Function
		End If
		'内容为空或大于oblog.setup(75,0)
		If Log_Text = "" Or StrLength(Log_Text)>oblog.cacheconfig(34) Then
			ResponseError(ERROR_NOT_LEGAL_CONTENT)
			Exit Function
		End If
		'内容中含有系统不允许发布的关键字
		If oblog.chk_badword(Log_Text) > 0 Then
			ResponseError(ERROR_NOT_LEGAL_KEYWORD)
			Exit Function
		End If
		
		Dim rs
		Set rs = server.createobject("adodb.recordset")
		rs.open "SELECT TOP 1 * FROM [oblog_log] where Userid="&Userid&" ORDER BY logid desc", conn, 2, 2