?? class.asp
字號:
<%
'-------------------------------------
'功能：CuteLink類
'天天智能友情鏈接管理系統
'天天DV網制作 http://www.ttdv.cn
'博大網址庫http://www.ip126.com
'海納數據廣西http://www.idcgx.net
'可自由傳播和免費使用，但必須保留此完整版權信息
'本程序擷取了ITlearner、博大網址庫智能友情鏈接系統、飛
'越智能友情鏈接系統等優秀程序中的源代碼，對他們的作者表示感謝
'-------------------------------------
class cls_cutelink
Public BaseUrl
Public WebName,WebUrl,SysName,SysNameE,SysVersion,ip
Public rs
Private Sub Class_Initialize()
WebName="天天DV網"
WebUrl="http://www.ttdv.cn"
SysName="自助友情鏈接系統"
SysNameE="TTLink"
SysVersion="V2.0"
BaseUrl = LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"),Split(request.ServerVariables("SCRIPT_NAME"),"/")(ubound(Split(request.ServerVariables("SCRIPT_NAME"),"/"))),""))
if IPanti = 1 then
ip = checkstr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"),15)
if ip = "" then ip = checkstr(Request.ServerVariables("REMOTE_ADDR"),15)
else
ip = checkstr(Request.ServerVariables("REMOTE_ADDR"),15)
end if
'初始化當天數據
if application(hxCacheName&"_Date")<>Date() then
init_data
end if
End Sub
Private Sub class_terminate()
If IsObject(conn) Then
conn.Close
Set conn = Nothing
End If
End Sub
Public Function Execute(Command)
If Not IsObject(conn) Then ConnectionDatabase
On Error Resume Next
Set Execute = conn.Execute(Command)
If Err Then
If IsDeBug = 1 Then
Response.Write "你執行的語句是：" & Command
Response.Write "<BR>錯誤信息為：" & Err.description
Else
Response.Write "查詢數據的時候發現錯誤，請檢查您的查詢代碼是否正確。"
End If
Err.Clear
conn.close
set conn=nothing
Response.End
End If
End Function
Public Function Checkstr(Str,length)
If Isnull(Str) Then
CheckStr = ""
Exit Function
End If
CheckStr = trim(Replace(Str,"'","''"))
if instr(Str,"%27") then
CheckStr = trim(Replace(Str,"%27","''"))
End if
if length>0 and strlength(CheckStr)>length then
CheckStr=Strleft(CheckStr,length)
End if
End Function
Public Function htmlencode2(str)
htmlencode2=Server.Htmlencode(str)
htmlencode2=replace(htmlencode2,chr(10)," ")
htmlencode2=replace(htmlencode2,chr(13)," ")
htmlencode2=replace(htmlencode2,chr(32)," ")
End Function
Public Function Strlength(Str)
dim Temp_Str,I,Test_Str
Temp_Str=Len(Str)
For I=1 To Temp_Str
Test_Str=(Mid(Str,I,1))
If Asc(Test_Str)>0 Then
Strlength=Strlength+1
Else
Strlength=Strlength+2
End If
Next
End Function
Public Function Strleft(Str,L)
dim Temp_Str,I,lens,Test_Str
Temp_Str=Len(Str)
For I=1 To Temp_Str
Test_Str=(Mid(Str,I,1))
Strleft=Strleft&Test_Str
If Asc(Test_Str)>0 Then
lens=lens+1
Else
lens=lens+2
End If
If lens>=L Then Exit For
Next
End Function
Public Function isInteger(para)
on error resume next
dim str
dim l,i
if isNUll(para) then
isInteger=false
exit function
End if
str=cstr(para)
if trim(str)="" then
isInteger=false
exit function
End if
l=len(str)
for i=1 to l
if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
isInteger=false
exit function
End if
next
isInteger=true
if err.number<>0 then err.clear
End Function
Public Function showwebtype(id)
dim rs
set rs=execute("select name from tt_WebType where id="&id)
if rs.eof then
showwebtype="另類其它"
else
showwebtype=rs(0)
End if
set rs=nothing
End Function
'num:0表示option 1表示橫排
Public Sub listwebtype(id,num)
set rs=execute("select * from tt_WebType order by orderid")
do while not rs.eof
if num=0 then
response.write " <option value="""&rs("id")&""""
if int(rs("id"))=int(id) then response.write " selected"
response.write ">"
response.write rs("name")
response.write "</option>"
else
response.write "<li><a href=""?webtype="&rs("id")&""""
if int(rs("id"))=int(id) then response.write " class=""sel"""
response.write ">"
response.write rs("name")
response.write "</a></li>"
end if
rs.movenext
loop
set rs=nothing
End Sub
Public Sub ShowPageInfo(table,id,condition,PageNo,PageSize,LinkFile)
dim strsql,TotalCount,TotalPageCount,OutStr
strsql="SELECT count("&id&") FROM "&table&" "&condition&""
Set rs = Execute(strsql)
TotalCount=rs(0)
rs.Close
Set rs=Nothing
'如果記錄數為0，那么退出
If TotalCount=0 Then
Exit Sub
End If
'得到總頁數
If (TotalCount mod PageSize)=0 Then
TotalPageCount=TotalCount\PageSize
Else
TotalPageCount=(TotalCount\PageSize)+1
End If
'防止提交的page參數大于第二次提交的總頁數
if PageNo>TotalPageCount then
PageNo=TotalPageCount
End if
OutStr = OutStr & "共有"&TotalCount&"條記錄"
OutStr = OutStr & " 第<font color='#FF0000'>"&PageNo&"</font>頁/共<font color='#FF0000'>"&TotalPageCount&"</font>頁"
If LinkFile<>"" and right(LinkFile,1)<>"&" then
LinkFile=LinkFile&"&"
end if
LinkFile = Replace(LinkFile,"&","&")
If PageNo>1 Then
OutStr = OutStr & " <a href='?"&LinkFile&"PageNo=1'>首頁</a>"
OutStr = OutStr & " <a href='?"&LinkFile&"PageNo="&PageNo-1&"'>上一頁</a>"
End If
If PageNo<TotalPageCount Then
OutStr = OutStr & " <a href='?"&LinkFile&"PageNo="&PageNo+1&"'>下一頁</a>"
OutStr = OutStr & " <a href='?"&LinkFile&"PageNo="&TotalPageCount&"'>尾頁</a>"
End If
Response.Write(OutStr)
End Sub
Public Sub ShowFooter()
dim Endtime,Runtime,OutStr
Endtime=timer()
OutStr = "<p align=""center"">"
Runtime=FormatNumber((endtime-startime)*1000,2)
if Runtime>0 then
if Runtime>1000 then
OutStr = OutStr & "頁面執行時間：約"& FormatNumber(runtime/1000,2) & "秒"
else
OutStr = OutStr & "頁面執行時間：約"& Runtime & "毫秒"
end if
end if
OutStr = OutStr & " "
OutStr = OutStr & "<a href=""http://www.ttdv.cn"" target=""_blank"">本程序由天天DV網提供</a>"
OutStr = OutStr & "</p>"
Response.Write(OutStr)
End Sub
Public Sub write_log(num)
Execute("insert into tt_Log (username,ip,come,inout) values('"&username&"','"&ip&"','"&comeurl&"',"&num&")")
End Sub
Public Function isrec(num)
dim rs
set rs=execute("select top 1 dateandtime from tt_Log where ip='"&ip&"' and username='"&username&"' and inout="&num&" order by id desc")
if rs.eof then
Call write_log(num)
isrec=false
elseif DateDiff("h",rs(0),now())>HitsTime then
Call write_log(num)
isrec=false
else
isrec=true
end if
End Function
Public Sub init_data
dim sql
set rs=Server.CreateObject("ADODB.RecordSet")
sql="select outc,outj,outp,outdate,fromdate,inc,inj,inp,indate from tt_Link order by outdate desc"
rs.open sql,conn,1,2
do while not rs.eof
If DateDiff("d",rs("outdate"),Date())<>0 then
rs("outj")=0
rs("outp")=rs("outc")/(DateDIff("d",rs("fromdate"),date())+1)
End If
If DateDiff("d",rs("indate"),Date())<>0 then
rs("inj")=0
rs("inp")=rs("inc")/(DateDIff("d",rs("fromdate"),date())+1)
End If
rs.update
rs.movenext
loop
rs.close
set rs = nothing
application(hxCacheName&"_Date")=date()
End Sub
'網站名稱過濾參數V1.5新加
'V1.6增加num參數，1判斷字符，2判斷域名
Public Function blnfilter(str,num)
dim StrFilter
if num = 1 then StrFilter = FilterWord :else StrFilter = FilterDomain
if StrFilter <> "" then
dim arrfilter,j
arrfilter = split(StrFilter,"|")
for j = 0 to ubound(arrfilter)
if instr(str,arrfilter(j))>0 then
blnfilter = true
Exit Function
end if
next
end if
blnfilter = false
End Function
End class
Class Cls_Cache
Rem ==================使用說明=================================================================================
Rem = 本類模塊是ITlearner根據動網先鋒(作者：迷城浪子)的緩存類模塊修改而成。 =
Rem = CacheName 緩存組的總名稱 Reloadtime 緩存時間 =
Rem = CuteLink V1.4新增類 V1.6略做修改 =
Rem ===========================================================================================================
Public Reloadtime,CacheName
Private LocalCacheName,CacheData,DelCount
Private Sub Class_Initialize()
Reloadtime=CacheTime
CacheName=hxCacheName
End Sub
Private Sub SetCache(SetName,NewValue)
Application.Lock
Application(SetName) = NewValue
Application.unLock
End Sub
Private Sub makeEmpty(SetName)
Application.Lock
Application(SetName) = Empty
Application.unLock
End Sub
Public Property Let Name(ByVal vNewValue)
LocalCacheName=LCase(vNewValue)
End Property
Public Property Let Value(ByVal vNewValue)
If LocalCacheName<>"" Then
CacheData=Application(CacheName&"_"&LocalCacheName)
If IsArray(CacheData) Then
CacheData(0)=vNewValue
CacheData(1)=Now()
Else
ReDim CacheData(2)
CacheData(0)=vNewValue
CacheData(1)=Now()
End If
SetCache CacheName&"_"&LocalCacheName,CacheData
Else
Err.Raise vbObjectError + 1, "hxCacheServer", " please change the CacheName."
End If
End Property
Public Property Get Value()
If LocalCacheName<>"" Then
CacheData=Application(CacheName&"_"&LocalCacheName)
If IsArray(CacheData) Then
Value=CacheData(0)
Else
Err.Raise vbObjectError + 1, "hxCacheServer", " The CacheData Is Empty."
End If
Else
Err.Raise vbObjectError + 1, "hxCacheServer", " please change the CacheName."
End If
End Property
Public Function ObjIsEmpty()
ObjIsEmpty=True
CacheData=Application(CacheName&"_"&LocalCacheName)
If Not IsArray(CacheData) Then Exit Function
If Not IsDate(CacheData(1)) Then Exit Function
If DateDiff("s",CDate(CacheData(1)),Now()) < 60*Reloadtime Then
ObjIsEmpty=False
End If
End Function
Public Sub DelCahe(MyCaheName)
makeEmpty(CacheName&"_"&MyCaheName)
End Sub
End Class
%>?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -