⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 commond.asp

📁 1、日志增加首页显示调用index_show.asp 2、日志增加用户的修改和删除权利 3、日志增加文件上传大小修改和限制 4、时间的动态修改 5、增加日志的日志推荐功能 6、用户的ip查询
💻 ASP
字号:
🔍 
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%Option Explicit
Response.Buffer = True
Server.ScriptTimeOut = 90

Session.CodePage=65001

If Trim(Request.QueryString("CP"))="GBK" Then Session.CodePage = 936

'定义 Cookie,Application 域，必须修改，否则可能运行不正常
Const CookieName="loveyuki"

'站点开关操作
IF Not isNumeric(Application(CookieName & "_SiteEnable")) Then
	Application.Lock
	Application(CookieName & "_SiteEnable") = 1
	Application(CookieName & "_SiteDisbleWhy") = ""
	Application.UnLock
End IF
IF Application(CookieName & "_SiteEnable") = 0 AND Application(CookieName & "_SiteDisbleWhy")<>"" AND inStr(Replace(Lcase(Request.ServerVariables("URL")),"\","/"),"/admincp.asp") = 0  AND inStr(Replace(Lcase(Request.ServerVariables("URL")),"\","/"),"/logging.asp") = 0 Then
	Response.Write(Application(CookieName & "_SiteDisbleWhy"))
	Response.End
End IF

Dim StartTime,SQLQueryNums,opensql,errmsg_data
opensql=1'1为Access数据库，0为SQL数据库
errmsg_data="<head><meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"" /><title>数据库连接出错，请检查连接字串</title></head><body> <div align=""center"" style=""width:422px;height:125px;padding: 8px;font-size:9pt;border: 1px solid ThreeDShadow;POSITION:absolute;top:expression((document.body.offsetHeight-100)/2);left:expression((document.body.offsetWidth-400)/2);""  valign=""top"">  <table width=""100%"" height=""100%"" border=""1"" cellpadding=""2"" cellspacing=""0"" bordercolor=""#999999"" style=""font-size:12px;font-family:Tahoma;""  valign=""top""><tr>    <td height=""18"" align=""center"" valign=""top"" bgcolor=""#999999"">提示 </td>  </tr>    <tr>      <td align=""center"" valign=""top""><strong><font color=""#FF3333"">数据库连接出错，请检查连接字串</font></strong></td>    </tr>  </table></div></body>"
	StartTime=Timer()
SQLQueryNums=0

'定义数据库链接文件，根据自己的情况修改
Const AccessPath="blog_yler"
Const AccessFile="#mengxisky_blog.mdb" 
Const IPAccessFile="#ipdata.asa"
 
  'sql数据库连接参数
    Dim SqlDatabaseName,SqlPassword,SqlUsername,SqlSource,Driver,Conn
        SqlDatabaseName = "blog"    '数据库名    
        SqlUsername = "sa"            '用户名
        SqlPassword = "admin"        '用户密码
        SqlSource = "(local)"        '数据地址（本地用local，远程用IP）
        Driver = "Provider = Sqloledb; User ID = " & SqlUsername & "; Password = " & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source = " & SqlSource & ";"
       On Error Resume Next
	   if opensql=1 then
          Set Conn= Server.CreateObject("ADODB.Connection")
          Conn.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(AccessPath&"/"&AccessFile)
          Conn.Open
		else
       set Conn = server.CreateObject("ADODB.Connection")
       Conn.open Driver
       If Err Then
        err.Clear
        Set Conn = Nothing
        Response.Write(""&errmsg_data&"")
        Response.End
       End If
end if
Dim SQL,TempVar,siteTitle '定义常用变量

Dim blog_Infos,SiteName,SiteUrl,blogPerPage,blog_LogNums,blog_CommNums,blog_MemNums,blog_VisitBaseNums,blog_VisitNums,blog_QuoteNums,blog_GuestbookNums,admin_upsize,blog_upfilesize,blog_time_year,blog_time_mon,blog_time_day
dim blog_time
Set blog_Infos=Server.CreateObject("ADODB.Recordset")
SQL="SELECT * FROM blog_Info"
blog_Infos.Open SQL,Conn,1,1
SQLQueryNums=SQLQueryNums+1
If blog_Infos.EOF And blog_Infos.BOF Then
	Response.Write(""&errmsg_data&"")
	Response.End
Else
   '站点基本信息设置
	SiteName=blog_Infos("blog_Name")
	admin_upsize=blog_infos("blog_upfilesize")/1024
	blog_time_year=blog_infos("blog_time_year")
	blog_time_mon=blog_infos("blog_time_mon")
	blog_time_day=blog_infos("blog_time_day")
	SiteURL=blog_Infos("blog_URL")
	blogPerPage=blog_Infos("blog_PerPage")
	blog_LogNums=blog_Infos("blog_LogNums")
	blog_CommNums=blog_Infos("blog_CommNums")
	blog_GuestbookNums=blog_Infos("blog_GuestbookNums")
	blog_MemNums=blog_Infos("blog_MemNums")
	blog_QuoteNums=blog_Infos("blog_QuoteNums")
	blog_VisitBaseNums=blog_Infos("blog_VisitBaseNums")
	blog_VisitNums=blog_Infos("blog_VisitNums")+blog_VisitBaseNums
End If
blog_Infos.Close
Set blog_Infos=Nothing

Dim Guest_IP
Guest_IP=Replace(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),"'","")
If Guest_IP=Empty Then Guest_IP=Replace(Request.ServerVariables("REMOTE_ADDR"),"'","")

'站点统计代码
IF Session("GuestIP")<>Guest_IP Then
	Dim Guest_Agent,Guest_Refer
	Guest_Agent=Trim(Request.ServerVariables("HTTP_USER_AGENT"))
	Guest_Refer=Trim(Request.ServerVariables("HTTP_REFERER"))
	Conn.ExeCute("INSERT INTO blog_Counter(coun_IP,coun_Agent,coun_Refer) VALUES ('"&Guest_IP&"','"&Guest_Agent&"','"&Guest_Refer&"')")
	Conn.ExeCute("UPDATE blog_Info SET blog_VisitNums=blog_VisitNums+1")
	SQLQueryNums=SQLQueryNums+2
	Session("GuestIP")=Guest_IP
End IF

Dim memName,memPassword,memStatus
memName=CheckStr(Request.Cookies(CookieName)("memName"))
memPassword=CheckStr(Request.Cookies(CookieName)("memPassword"))
memStatus=CheckStr(Request.Cookies(CookieName)("memStatus"))

IF memName<>Empty Then
    Dim CheckCookie
    Set CheckCookie=Server.CreateObject("ADODB.RecordSet")
    SQL="SELECT mem_Name,mem_Password,mem_Status,mem_LastIP FROM blog_Member WHERE mem_Name='"&memName&"' AND mem_Password='"&memPassword&"' AND mem_Status='"&memStatus&"'"
    CheckCookie.Open SQL,Conn,1,1
    SQLQueryNums=SQLQueryNums+1
    If CheckCookie.EOF AND CheckCookie.BOF Then
        Response.Cookies(CookieName)("memName")=""
        memName=Empty
        Response.Cookies(CookieName)("memPassword")=""
        memPassword=Empty
        Response.Cookies(CookieName)("memStatus")=""
        memStatus=Empty
    Else
        If CheckCookie("mem_LastIP")<>Guest_IP Or isNull(CheckCookie("mem_LastIP")) Then
            Response.Cookies(CookieName)("memName")=""
            memName=Empty
            Response.Cookies(CookieName)("memPassword")=""
            memPassword=Empty
            Response.Cookies(CookieName)("memStatus")=""
            memStatus=Empty
        End If
    End IF
    CheckCookie.Close
    Set CheckCookie=Nothing
Else
    Response.Cookies(CookieName)("memName")=""
    memName=Empty
    Response.Cookies(CookieName)("memPassword")=""
    memPassword=Empty
    Response.Cookies(CookieName)("memStatus")=""
    memStatus=Empty
End IF

'上传文件的大小以及后缀名限制
Dim Adm_UP_FileSize,Adm_UP_FileType,Mem_UP_FileSize,Mem_UP_FileType
Dim MemCanUP
MemCanUP = 0   '设定一般用户是否可以上传文件，0为不可以，1为可以
Adm_UP_FileSize = admin_upsize*1024
Adm_UP_FileType = "RAR,ZIP,SWF,JPG,PNG,GIF,DOC,TXT,CHM,PDF,ACE,JPG,MP3,WMA,WMV,MIDI,AVI,RM,RA,RMVB,MOV,TORRENT"
Mem_UP_FileSize = 1024000  '如果不允许一般会员上传设置为0即可！
Mem_UP_FileType = "RAR,ZIP,SWF,JPG,PNG,GIF,DOC,TXT,CHM,PDF,ACE,JPG,MP3,WMA,WMV,MIDI,AVI,RM,RA,RMVB,MOV,TORRENT"


'写入日志分类
Dim Arr_Category
IF Not IsArray(Application(CookieName&"_blog_Category")) Then
	Dim log_CategoryList
	Set log_CategoryList=Server.CreateObject("ADODB.RecordSet")
	SQL="SELECT cate_ID,cate_Name,cate_Order FROM blog_Category ORDER BY cate_Order ASC"
	log_CategoryList.Open SQL,Conn,1,1
	SQLQueryNums=SQLQueryNums+1
	If log_CategoryList.EOF And log_CategoryList.BOF Then
		Redim Arr_Category(3,0)
	Else
		Arr_Category=log_CategoryList.GetRows
	End If
	log_CategoryList.Close
	Set log_CategoryList=Nothing
	Application.Lock
	Application(CookieName&"_blog_Category")=Arr_Category
	Application.UnLock
Else
	Arr_Category=Application(CookieName&"_blog_Category")
End IF

'写入表情符号
Dim Arr_Smilies
IF Not IsArray(Application(CookieName&"_blog_Smilies")) Then
	Dim log_SmiliesList
	Set log_SmiliesList=Server.CreateObject("ADODB.RecordSet")
	SQL="SELECT sm_ID,sm_Image,sm_Text FROM blog_Smilies ORDER BY sm_ID ASC"
	log_SmiliesList.Open SQL,Conn,1,1
	SQLQueryNums=SQLQueryNums+1
	If log_SmiliesList.EOF And log_SmiliesList.BOF Then
		Redim Arr_Smilies(3,0)
	Else
		Arr_Smilies=log_SmiliesList.GetRows
	End If
	log_SmiliesList.Close
	Set log_SmiliesList=Nothing
	Application.Lock
	Application(CookieName&"_blog_Smilies")=Arr_Smilies
	Application.UnLock
Else
	Arr_Smilies=Application(CookieName&"_blog_Smilies")
End IF

'写入关键字列表
Dim Arr_Keywords
IF Not IsArray(Application(CookieName&"_blog_Keywords")) Then
	Dim log_KeywordsList
	Set log_KeywordsList=Server.CreateObject("ADODB.RecordSet")
	SQL="SELECT key_ID,key_Text,key_URL,key_Image FROM blog_Keywords ORDER BY key_ID ASC"
	log_KeywordsList.Open SQL,Conn,1,1
	SQLQueryNums=SQLQueryNums+1
	If log_KeywordsList.EOF And log_KeywordsList.BOF Then
		Redim Arr_Keywords(4,0)
	Else
		Arr_Keywords=log_KeywordsList.GetRows
	End If
	log_KeywordsList.Close
	Set log_KeywordsList=Nothing
	Application.Lock
	Application(CookieName&"_blog_Keywords")=Arr_Keywords
	Application.UnLock
Else
	Arr_Keywords=Application(CookieName&"_blog_Keywords")
End IF

'写入首页链接列表
Dim Arr_Bloglinks
IF Not IsArray(Application(CookieName&"_blog_Bloglinks")) Then
	Dim log_BloglinksList
	Set log_BloglinksList=Server.CreateObject("ADODB.RecordSet")
	SQL="SELECT link_Name,link_URL,link_Image FROM blog_Links WHERE link_IsMain=True ORDER BY link_Order ASC"
	log_BloglinksList.Open SQL,Conn,1,1
	SQLQueryNums=SQLQueryNums+1
	If log_BloglinksList.EOF And log_BloglinksList.BOF Then
		Redim Arr_Bloglinks(3,0)
	Else
		Arr_Bloglinks=log_BloglinksList.GetRows
	End If
	log_BloglinksList.Close
	Set log_BloglinksList=Nothing
	Application.Lock
	Application(CookieName&"_blog_Bloglinks")=Arr_Bloglinks
	Application.UnLock
Else
	Arr_Bloglinks=Application(CookieName&"_blog_Bloglinks")
End IF
%>

⌨️ 快捷键说明

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