www.gusucode.com > 栽豆迷你博客 MiniBlog 3.0 正式版源码程序 > Include/CB_Main.asp

    <%
Class keep_main
Public SqlQueryNum,ScriptName,Userid,UserWord,UserDisp,UserTrueIP,SkinID,SysData,SysAdmin,Com,NothingNav,UserFr
Public SystemName,DomainName,CookiePath,LogFiles,WebFiles,MailServer,RootMail,DefaultSkin,Isinstall,AllFavorites,AllUser,NewUser,TopSignUser,htmlpath,BadWords,BadNames,Integral,MasterName,NickName,udata
'Private 
Private Sub Class_Initialize()
	SqlQueryNum = 0
	If Not Response.IsClientConnected Then
		Session(CacheName&"UserID")=empty
		Set Caluoob=Nothing
		Response.End
	End If
	Dim TmpScript
	TmpScript = Request.ServerVariables("PATH_INFO")
	TmpScript = Split(TmpScript,"/")
	ScriptName = Lcase(TmpScript(UBound(TmpScript)))
	UserID=Request.cookies(CookieName)("UserID")
	NickName=Request.cookies(CookieName)("NickName")
	UserWord=Request.cookies(CookieName)("UserPW")
	UserDisp=Request.cookies(CookieName)("UserDisp")
	SkinID=Request.cookies(CookieName)("UserSkin")
	UserTrueIP = getIP()
	Call SysCache():Call LoadAdmin()
	SystemName=SysData(0,0)
	DomainName=SysData(1,0):CookiePath=SysData(2,0)
	LogFiles=SysData(3,0):WebFiles=SysData(4,0)
	MailServer=SysData(5,0):RootMail=SysData(6,0)
	DefaultSkin=SysData(7,0):Isinstall=Split(SysData(8,0),","):AllFavorites=SysData(10,0)
	AllUser=SysData(11,0):NewUser=SysData(12,0)
	TopSignUser=SysData(13,0):htmlpath=SysData(14,0)
	BadWords=Split(SysData(16,0),"|"):BadNames=Split(SysData(17,0),"|"):MasterName=SysAdmin(0,0)
	If IsNumeric(UserID) = 0 Or UserID="" Then UserID=0
	If IsNumeric(UserDisp) = 1 Or UserDisp="" Then UserDisp=1
	Com=false
	CheckUserLogin:NothingNav=""
End Sub

Public Function Execute(Command)
	If Not IsObject(Conn) Then ConnectionDatabase
		Set Execute = Conn.Execute(Command)
		If Err Then
			err.Clear
			Set Conn = Nothing
			Response.Redirect "Error.asp?txt=操作失败，请审查您提交的数据。"
			Response.End
		End If
		SqlQueryNum = SqlQueryNum+1
End Function

Private Sub SysCache()
	IF isArray(Application(CachesName&"loadSystem"))=False then
		Dim Rs:Set Rs = Execute("Select sysnames,domainames,cookispath,logfiles,webfiles,servmail,rootmail,dftskins,isinstall,lockips,allfav,alluser,newuser,topuser,htmlpath,iconum,BadWords,BadNames From [cb_system]")
		Application.Lock
		Application(CachesName&"LoadSystem")=Rs.GetRows(1)
		Application.UnLock
		Rs.close:Set Rs=nothing
	End if
		SysData=Application(CachesName&"LoadSystem")
End Sub

Private Sub LoadAdmin()
	IF isArray(Application(CachesName&"Admin"))=False then
		Dim Rs:Set Rs = Execute("Select usernames From [cb_admin]")
		Application.Lock
		Application(CachesName&"Admin")=Rs.GetRows(1)
		Application.UnLock
		Rs.close:Set Rs=nothing
	End if
		SysAdmin=Application(CachesName&"Admin")
End Sub

Public Sub CheckUserLogin()
		If UserID<>"" and UserWord<>"" then
			Com=true
			If isarray(udata)=False and Com=true then UserData
		Else
			Call GuestSession
		End If
		'IP锁定
		Dim IpData,j:IpData=Split(SysData(9,0),"|")
		For j=0 to ubound(Split(SysData(9,0),"|"))
		If IpData(j)=UserTrueIP then Response.Write "您的IP已被禁止。":Response.end
		next
End Sub

Public Sub UserData()
		Dim Rs
		Set Rs=Execute("Select top 1 id,nicknames,passwords,emails,questionid,answers,locks,favcount,lastlogin,display,friendsnum,album,friends From [cb_user] Where id="&UserID)
		If Not(Rs.Eof and Rs.Bof) Then
			If UserWord=left(Rs(2),16) then
			udata=Rs.GetRows(1)
			Else
			Call GuestSession
			Response.Redirect "Exit.asp":Response.End
			End If
		Else
			Call GuestSession
		End If
		Rs.close:Set Rs=Nothing
End Sub

Public Sub LogString
	If UserID="" Then Response.Redirect "Exit.asp"
	If Isinstall(4)=1 Then Exit Sub
	Dim Arguments:Arguments=Checkstr(Request.ServerVariables("Query_String"))
	If Arguments="" Then Arguments="unknown"
	Execute("insert into [cb_log] (ScriptName,Arguments,UserName,UserIP) values('"&ScriptName&"','"&Arguments&"','"&NickName&"','"&UserTrueIP&"')")
End Sub

Public Sub GuestSession()
	Response.Cookies(CookieName).path=CookiePath
	Response.Cookies(CookieName)("UserID") = 0
	Response.Cookies(CookieName)("UserDisp")= "0,0,1"
	Response.Cookies(CookieName)("UserSkin")=DefaultSkin
End Sub

Public Function OtherHerder(str)
	If Isinstall(0)=1 Then Response.Write "系统暂时关闭。":Response.End
	OtherHerder=loadskins("other_header.txt")
	If UserID=Empty or UserWord=Empty then
		OtherHerder=Replace(OtherHerder,"$navigation",Split(loadskins("navigation.txt"),"§")(0))
	Else
		OtherHerder=Replace(OtherHerder,"$navigation",Split(loadskins("navigation.txt"),"§")(1)&"")
	End If
	OtherHerder=Replace(OtherHerder,"$title_l",Str)
	OtherHerder=Replace(OtherHerder,"$skins",DefaultSkin)
	Response.Write OtherHerder
End Function

Public Function WoHerder(str)
	If Isinstall(0)=1 Then Response.Write "系统暂时关闭。":Response.End
	WoHerder=loadskins("wo_header.txt")
	If UserID=Empty or UserWord=Empty then
		WoHerder=Replace(WoHerder,"$navigation",Split(loadskins("navigation.txt"),"§")(0))
	Else
		WoHerder=Replace(WoHerder,"$navigation",Split(loadskins("navigation.txt"),"§")(1)&"")
	End If
	WoHerder=Replace(WoHerder,"$title_l",Str)
	WoHerder=Replace(WoHerder,"$skins",DefaultSkin)
	Response.Write WoHerder
End Function

Public Function Herder(str)
	If Isinstall(0)=1 Then Response.Write "系统暂时关闭。":Response.End
	Herder=loadskins("header.txt")
	If UserID=Empty or UserWord=Empty then
		Herder=Replace(Herder,"$navigation",Split(loadskins("navigation.txt"),"§")(0))
	Else
		Herder=Replace(Herder,"$navigation",Split(loadskins("navigation.txt"),"§")(1)&"")
	End If
	Herder=Replace(Herder,"$title_l",Str)
	Herder=Replace(Herder,"$skins",DefaultSkin)
	Response.Write Herder
End Function

Public Function IndexLogin()
	If UserID=Empty or UserWord=Empty then
	    IndexLogin=loadskins("index_login.txt")
	Else
		IndexLogin=""
	End If
	IndexLogin=Replace(IndexLogin,"$skins",DefaultSkin)
End Function

Public Function Login()
	If UserID=Empty or UserWord=Empty then
	   Login=loadskins("login.txt")
	   Response.Write Login
	end if
End Function

Private Function getIP()
		Dim strIPAddr 
		If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then 
			strIPAddr = Request.ServerVariables("REMOTE_ADDR") 
		ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then 
			strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1) 
			actforip=Request.ServerVariables("REMOTE_ADDR")
		ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then 
			strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
			actforip=Request.ServerVariables("REMOTE_ADDR")
		Else 
			strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR") 
			actforip=Request.ServerVariables("REMOTE_ADDR")
		End If 
		getIP = CheckStr(Trim(Mid(strIPAddr, 1, 30)))
End Function 

'过滤输入
Public Function Checkstr(Str)
		If Isnull(Str) Then
			CheckStr = ""
			Exit Function 
		End If
		Str = Replace(Str,Chr(0),"")
		CheckStr = Replace(Str,"'","''")
End Function

'过滤发表文字
Public Function ChkBadWords(fString)
If fString="" then Exit Function
dim bwords,i_back
	fString=replace(fString,"'","''")
		for i_back = 0 to ubound(BadWords)
			 fString = Replace(fString, BadWords(i_back), string(len(BadWords(i_back)),"*")) 
		next    
		ChkBadWords = fString
End Function

'判断网址
Public Function ArChiveLink(str)
Dim SplitLink
ArChiveLink = LCase(RequesT.ServerVariables("QUERY_STRING"))
	SplitLink = Split(ArChiveLink,".")
		If Ubound(SplitLink) < 1 Then
		ArChiveLink = LCase(RequesT.ServerVariables("QUERY_STRING"))
		else
		ArChiveLink = SplitLink(str)
		End if
End Function

'判断外部数据
Public Function ChkPost()
		Dim server_v1,server_v2
		Chkpost=False 
		server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
		server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
		If Mid(server_v1,8,len(server_v2))=server_v2 Then Chkpost=True 
End Function

'载入皮肤
Public Function loadskins(Str)
Dim ShellFile,Shelltempfile,tempfile:Set ShellFile=Server.CreateObject("Scripting.FileSystemObject")
tempfile = Server.MapPath("skins/"&DefaultSkin&"/"&Str)
	IF not(ShellFile.FileExists(tempfile)) then
		loadskins="模板文件"&Str&"错误!"
	Else
		Set Shelltempfile=ShellFile.opentextfile(tempfile,1,True)
		loadskins=Shelltempfile.readall

		Set Shelltempfile=nothing
	End if
End Function

Public Function Footer()
Dim StrHtmlF
StrHtmlF=Caluoob.Loadskins("footer.txt")
Response.Write StrHtmlF
End Function

Public Function TimeToStr(DateTime)
	If DateTime="" then Exit Function  
	Dim DateYear,DateMonth,DateDay
	DateYear=Right(Year(DateTime),2)
	DateMonth=Month(DateTime)
	DateDay=Day(DateTime)
	If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
	If Len(DateDay)<2 Then DateDay="0"&DateDay
	TimeToStr=DateYear&"-"&DateMonth&"-"&DateDay
End Function

'推荐用户
Function CommendUsers()
	Dim myrs
	Set myrs = Caluoob.Execute("select top 8 * from [cb_user] where Display=1 order by id desc")
		CommendUsers="<ul class=alist>"
		if myrs.Eof or myrs.bof then
	    CommendUsers=CommendUsers&"还没有任何信息！"
	    else
		Do while not myrs.eof
		CommendUsers=CommendUsers&"<li><a href=hi.asp?u="&myrs("id")&"><img src=face/"&myrs("userface")&"><span>"&myrs("nicknames")&"</span></a></li>"
		myrs.movenext
		If myrs.EOF Then Exit do
		loop
		CommendUsers=CommendUsers&"</ul>"
	myrs.close
	set myrs=nothing
	end if
End Function

'最新用户
Function NewUsers()
	Dim myrs
	Set myrs = Caluoob.Execute("select top 8 * from [cb_user] order by id desc")
		NewUsers="<ul class=alist>"
		if myrs.Eof or myrs.bof then
	    NewUsers=NewUsers&"还没有任何信息！"
	    else
		Do while not myrs.eof
		NewUsers=NewUsers&"<li><a href=hi.asp?u="&myrs("id")&"><img src=face/"&myrs("userface")&"><span>"&myrs("nicknames")&"</span></a></li>"
		myrs.movenext
		If myrs.EOF Then Exit do
		loop
		NewUsers=NewUsers&"</ul>"
	myrs.close
	set myrs=nothing
	end if
End Function

Public Function CheckNum(Str)
	If Str="" Then Exit Function
		If Session(Str)=False Then
			RanDomize Timer
			Session(Str)=Int(Rnd*9)+1
		End If
	CheckNum=Session(Str)
End Function

Sub ShowErr(str)
	Response.Redirect "Error.asp?Err="&server.URLEncode(str)&""
	Response.end
End Sub

End Class
%>