www.gusucode.com > QQ空间互踩整站源码asp网站源码程序 > QQ空间互踩整站源码asp网站源码程序/class.asp
<%
class cls_cutelink
Public BaseUrl
Public WebName,WebUrl,SysName,SysNameE,SysVersion,ip
Public rs
Private Sub Class_Initialize()
WebName="qq网"
WebUrl="http://www.qqcss.com/"
SysName="自助Qzone系统"
SysNameE="cdQzone"
SysVersion="V1.0"
BaseUrl = LCase(Replace(Request.ServerVariables("SERVER_NAME") & Request.ServerVariables("URL"),Split(request.ServerVariables("SCRIPT_NAME"),"/")(ubound(Split(request.ServerVariables("SCRIPT_NAME"),"/"))),""))
ip=checkstr(request.ServerVariables("REMOTE_ADDR"),15)
'初始化当天数据
if application("CL_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
CloseDatabase
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 Fx_Qtype where id="&id)
if rs.eof then
showwebtype="另类其它"
else
showwebtype=rs(0)
End if
set rs=nothing
End Function
Public Sub listwebtype(id)
set rs=execute("select * from Fx_Qtype order by id")
do while not rs.eof
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>"
rs.movenext
loop
End Sub
Public Sub listQface(id)
set rs=execute("select * from Fx_Qface order by id")
do while not rs.eof
response.write " <option value= " & rs("img")
if int(rs("id"))=int(id) then response.write " selected"
response.write ">"
response.write rs("img")
response.write "</option>"
rs.movenext
loop
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 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
'OutStr = OutStr & "</P>"
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.qqcss.com/' target='_blank'>技术支持:"&SysVersion&"</a>"
OutStr = OutStr & "</p>"
Response.Write(OutStr)
End Sub
Public Sub write_log(num)
dim come
come=checkstr(request.ServerVariables("HTTP_REFERER"),100)
if ip="" then ip=" "
execute("insert into CL_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 CL_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 CL_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("CL_Date")=date()
End Sub
End class
Class Cls_Cache
Rem ==================使用说明=================================================================================
Rem = 本类模块是三明在线根据动网先锋(作者：迷城浪子)的缓存类模块修改而成。 =
Rem = CacheName 缓存组的总名称，缺省值为"hx",如果一个站点中有超过一个缓存组，则需要外部改变这个值。 =
Rem ===========================================================================================================
Public Reloadtime,CacheName
Private LocalCacheName,CacheData,DelCount
Private Sub Class_Initialize()
Reloadtime=14400
CacheName="hx"
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
%>