缓存类及打开数据库连接函数

懒人的作品，我连长一点点的代码，都写成函数了。。。

用起来，可以偷懒，哈哈。。。


<%‘’@ LANGUAGE = VBScript CodePage = 936

Dim jz
Set jz=New jz_clsmain
jz.Cache_count=0
jz.web_name="华人中小企业资源网"

Class jz_clsmain

Public rs,conn,sql,db
Public web_name,t,t_s,t_h,cache
public i_0,i_1
public Reloadtime,CacheName,LocalCacheName,Cache_Data,Cache_count

Private Sub Class_Initialize()
ReDim db(4),conn(4),rs(4),sql(4)
ReDim t(20,4),t_s(20,3)
Reloadtime=14400*60
‘’CacheNameCacheName=Replace(Replace(Replace(Server.MapPath("/"),"/",""),":",""),"\","")
CacheName=request.servervariables("url")
CacheName=left(CacheName,instrRev(CacheName,"/"))&"jz"
Cache_count=1000
web_name="匠族"
end sub


Private Sub class_terminate()
i_1=LBound(db)
for i_0=0 to i_1
On Error Resume Next
‘’Response.Write(i_0&"<br/><br/>")
if isobject(rs(i_0)) then rs(i_0).close:set rs(i_0)=nothing
If IsObject(Conn(i_0)) Then Conn(i_0).Close:Set Conn(i_0) = Nothing
next
End Sub

Public Function tree_00(str_0)
dim i,Jz_temp(1)
for i=0 to str_0
Jz_temp(0)=Jz_temp(0)&Jz_temp(1)
Jz_temp(1)="../"
next
tree_00=Jz_temp(0)
end Function

public function conn_00(str_0,str_1)
str_1=tree_00(str_1)
db(str_0)="Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(str_1&"data/data_"&str_0&".mdb")
‘’Response.Write(db(str_0))
end function

‘’str0=0-4<定义选择的DB(str0),并定义conn(str0)及rs(str0)>;str1=true,false<是否创建数据库连接>;str2=true,false<是否创建rs对象>;
Public Function c_r_s(str0,str1,str2)
On Error Resume Next
if str1 then
Set Conn(str0) = Server.CreateObject("ADODB.Connection")
conn(str0).open db(str0)
end if
if str2 then
set Rs(str0) = Server.CreateObject( "ADODB.Recordset" )
end if
End Function

Public Function c_r_o(str0,str1,str2)
Rs(str0).Open sql(str0), Conn(str0), str1, str2
If Err Then
err.Clear
Set conn(str0) = Nothing
Response.Write "数据库连接出错，请检查连接字串。"‘’注释，需要把这几个字翻译成英文。
Response.End
End If
End Function


Public Function c_r_e(str0,str1,str2)
On Error Resume Next
if str2 then
rs(str0).close
set rs(str0)=nothing
end if
if str1 then
conn(str0).close
set conn(str0)=nothing
end if
End Function

Public Property Let Name(ByVal vNewValue)
LocalCacheName = LCase(vNewValue)
End Property
Public Property Let Value(ByVal vNewValue)
If LocalCacheName<>"" Then
ReDim Cache_Data(2)
Cache_Data(0)=vNewValue
Cache_Data(1)=Now()
Cache_Data(2)=Reloadtime
Application.Lock
Application(CacheName & "_" & LocalCacheName) = Cache_Data
Application.unLock
Else
Err.Raise vbObjectError + 1, "jzCacheServer", " please change the CacheName."
End If
End Property
Public Property Get Value()
If LocalCacheName<>"" Then
Cache_Data=Application(CacheName & "_" & LocalCacheName)
If IsArray(Cache_Data) Then
Value=Cache_Data(0)
Else
Err.Raise vbObjectError + 1, "jzCacheServer", " The Cache_Data("&LocalCacheName&") Is Empty."
End If
Else
Err.Raise vbObjectError + 1, "jzCacheServer", " please change the CacheName."
End If
End Property

Public Function ObjIsEmpty()
app_count()
ObjIsEmpty=True
Cache_Data=Application(CacheName & "_" & LocalCacheName)
If Not IsArray(Cache_Data) Then Exit Function
If Not IsDate(Cache_Data(1)) Then Exit Function
If IsEmpty(Cache_Data(2)) Then Exit Function
If DateDiff("s",CDate(Cache_Data(1)),Now()) < (Cache_Data(2)) Then ObjIsEmpty=False

End Function

Public Sub DelCahe(MyCaheName)
Application.Lock
Application.Contents.Remove(CacheName&"_"&MyCaheName)
Application.unLock
End Sub

public sub app_count()
if Application.Contents.Count>Cache_count then
Application.Lock
Application.Contents.RemoveAll()
Application.unLock
end if
end sub

function fso_000(str0)
dim jz_cache,jz_fso,jz_path,jz_file
set jz_fso = Server.Createobject("Scripting.FileSystemObject")
jz_path = server.mappath(str0)
‘’Response.Write(jz_path)
set jz_file = jz_fso.opentextfile(jz_path, 1)
do until jz_file.AtEndOfStream
jz_cache=jz_cache&jz_file.ReadLine&vbCrlf
loop
fso_000=jz_cache
jz_file.close
set jz_file = nothing
set jz_fso = nothing
end function

sub replace_000(str0)
t_h=replace(t_h,str0,cache&"")
t_empty()
end sub

sub t_empty()
for i_0=0 to 20:for i_1=0 to 4

t(i_0,i_1)=empty

next:next
i_0=empty
i_1=empty
cache=empty
end sub

Public Function target(jz_target)
Select Case jz_target
case 0
jz_target=""
case 1
jz_target="target=""new"""
end select
target=jz_target
end function


End Class
%>

原文转自：http://www.ltesting.net