程序代码：
<%
class cls_8808qq_cn
Public BaseUrl
Public WebName,WebUrl,SysName,SysNameE,SysVersion,ip
Public rs
Private Sub Class_Initialize()
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 09Qzone_Cn_WebType where id="&id)
if rs.eof then
showwebtype="其它"
else
showwebtype=rs(0)
End if
set rs=nothing
End Function
Public Sub write_log(num)
Execute("insert into 09Qzone_Cn_Log (username,ip,inout) values('"&username&"','"&ip&"',"&num&")")
End Sub
Public Function isrec(num)
dim rs
set rs=execute("select top 1 dateandtime from 09Qzone_Cn_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,fromdate,inc,inj,indate from 09Qzone_Cn_Link order by indate desc"
rs.open sql,conn,1,2
do while not rs.eof
If DateDiff("d",rs("indate"),Date())<>0 then
rs("inj")=0
rs("outj")=0
End If
rs.update
rs.movenext
loop
rs.close
set rs = nothing
application("CL_Date")=date()
End Sub
'以下是严格判断
Public Function blnfilter(str)
if FilterWordQq <> "" then
dim arrfilter,j
arrfilter = split(FilterWordQq,"|")
for j = 0 to ubound(arrfilter)
if StrComp(str,arrfilter(j),0) =0 then
blnfilter = true
Exit Function
end if
next
end if
blnfilter = false
End Function
Public Function blnfilter1(str)
if FilterWordText <> "" then
dim arrfilter,j
arrfilter = split(FilterWordText,"|")
for j = 0 to ubound(arrfilter)
if instr(str,arrfilter(j))>0 then
blnfilter1 = true
Exit Function
end if
next
end if
blnfilter1 = false
End Function
End class
Class Cls_Cache
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
%>
肯定是这个文件了
If DateDiff("d",rs("indate"),Date())<>0 then
rs("inj")=0
rs("outj")=0
End If
帮忙看看怎样把每天清零一次改为每周清零一次，
文件超过字节限制，删了一些没相关的代码。
还有一个我的网站放在美国的空间上，由于时区差关系，本来应该凌晨零点清零的数据，结果在中间变成了下午三点才清零了，有办法让它在中国的凌晨零点清零吗？
[
本帖最后由 唯入进来 于 2010-5-30 23:24 编辑 ]
