asp中的数据缓存

最新推荐文章于 2021-06-29 17:28:37 发布

puber

最新推荐文章于 2021-06-29 17:28:37 发布

阅读量1.4k

点赞数

分类专栏： asp总结文章标签： asp function path application class 测试

本文链接：https://blog.csdn.net/puber/article/details/6281879

版权

asp总结专栏收录该内容

3 篇文章 0 订阅

订阅专栏

<%

'声明，此文件现在可以直接拷贝测试，只是得自己包含一个md5文件。

'因为只是一个临时的想法,其中很多函数，类属于暂时拼凑的，不建议直接在自己的代码中直接使用，可以当一种思路

'在此感谢胡克毅同学，关于建议不直接缓存数组的建议，本代码全部改为缓存代码，不缓存数组

'文件操作类
'此类大部分方法改编自maxcms,在此感谢“石头 ”同学
class fso

    '初始化用的fso对象和steam对象
    public streamObj,fsoObj
    '编码和文本正文
    public charset,content

    '初始化编码
    Private Sub class_initialize()
        charset = "gbk"
    End Sub

    '初始化stream对象
    Function setstream()
        if not isobject(streamObj) then   Set streamObj=Server.CreateObject("adodb.stream")
    end function

    '初始化fso对象
    Function setfso()
        If not isobject(fsoObj) then set fsoObj=server.createobject("Scripting.FileSystemObject")
    End Function

    '查看文件是否存在
    Function exist(Byval path)
        call setfso()
        on error resume next
        If (fsoObj.FileExists(server.MapPath(path))) Then exist=True Else exist=False
        if err then err.clear:exist=False
    End Function

    '查看文件夹是否存在
    Function existFolder(Byval path)
        call setfso()
        on error resume next
        If fsoObj.FolderExists(server.MapPath(path)) Then existFolder=True Else existFolder=False
        if err then err.clear:existFolder=False
    End Function

    '读取文件
    Function load(ByVal filePath)
        call setstream()
        On Error Resume Next
        With streamObj
            .Type=2
            .Mode=3
            .Open
        .Charset=charset
            .LoadFromFile Server.MapPath(filePath)
            .Position=0
            load=.ReadText
            .Close
        End With
        if err then load = ""
    End Function

    '读取文件时间
    function time(Byval path)
        call setfso()
        dim f
        on error resume next
        If Exist(path)=True Then
            set f = Fsoobj.GetFile (server.mappath(path))
            time = f.DateCreated
            set f = nothing
        end if
    End function

    '建立文件夹
    Function createFolder(Byval path,Byval dirType)
        call setfso()
        dim subPathArray,lenSubPathArray, pathDeep, i
        on error resume next
        path=replace(path, "/", "/")
        path=replace(server.mappath(path), server.mappath("/"), "")
        subPathArray=split(path, "/")
        pathDeep=pathDeep&server.mappath("/")
        select case dirType
            case "file"
                lenSubPathArray=ubound(subPathArray) - 1
            case "folder"
                lenSubPathArray=ubound(subPathArray)
        end select
        for i=1 to lenSubPathArray
            pathDeep=pathDeep&"/"&subPathArray(i)
            if not fsoObj.FolderExists(pathDeep) then fsoObj.CreateFolder pathDeep
        next
        if Err Then createFolder=false:errid=err.number:errdes=err.description:Err.Clear:echoErr err_createFolder,errid,errdes else createFolder=true
    End Function

    '保存文件
    Function save(Byval path)
        on error resume next
        call fsosave(path)
        if err then call streamsave(path)
    End Function

    '通过fso保存文件
    Function fsosave(Byval path)
        call setfso()
        call createfolder(path,"file")
        dim fileobj
        set fileobj=fsoObj.CreateTextFile(server.mappath(path),True)
        fileobj.Write(content)
        set fileobj=nothing
    End Function

    '通过steam保存文件
    Function streamsave(Byval path)
        call setstream()
        With objStream
                .Charset=charset:.Type=2:.Mode=3:.Open:.Position=0
                .WriteText content:.SaveToFile Server.MapPath(fileDir), 2
                .Close
        End With
    End Function

    '删除文件
    Function del(Byval path)
        on error resume next
        If Exist(path)=True Then fsoObj.DeleteFile(server.mappath(path))
        if Err Then del=false else del=true
    End Function
end class

'数据库设置常量

const DBHOST = "localhost"
const DBUSER = "sa"
const DBPWD = "tengguohui"
const DBNAME = "ceshi"

'数据库操作类
'数据库在初始化会自动寻找设置的常量
Class MySql
    Dim serverpath,User,Pwd,Name,isReady,conn,isopen,rs,connstr
    public linktype

    '构造函数
    Private Sub class_initialize()
        '通过常量初始化数据库参数
        call init()
    End Sub

    '析构函数
    Private Sub class_terminate()
        '及时释放对象
        if isobject(conn) then set conn = nothing
    End Sub

    '通过常量初始化数据库参数
    Function init()
        on error resume next
        serverpath = DBHOST
        user = DBUSER
        Pwd = DBPWD
        Name = DBNAME
        if err then isReady = false else isReady = true : linktype = "const"
    End Function

    '通过外部参数，初始化类参数
    Function SetSource(ByVal dbhoststr,Byval dbuserstr,ByVal dbpwdstr,Byval dbnamestr)
        on error resume next
        serverpath = dbhoststr
        user = dbuserstr
        Pwd = dbpwdstr
        Name = dbnamestr
        if err then isReady = false else isReady = true : linktype = ""
    End Function

    '打开数据连接
    Function open()
        on error resume next
        if isReady = false then
            response.write "错误的参数设置"
            response.end
        else
            connstr = "Provider=Sqloledb;Data Source="&serverpath&";Initial Catalog="&Name&";User ID="&user&";Password="&Pwd&";"
            Set conn = server.createobject("adodb.connection")
            conn.open connstr
            isopen = true
        end if
        if err then
            if isobject(conn) then set conn =nothing
            isopen = false
            response.write "数据库连接失败！"
            response.end
        end if
    End Function

    '执行一个不返回结果的sql语句
    Function exec(Byval str)
        if isopen =false then call open()
        conn.execute str
    End Function

    Function execfile(Byval path)
        dim file
        set file = new fso
        if file.exist(path) then exec (file.load(path))
        set file = nothing
    End Function

    '返回一个记录集
    Function getrs(ByVal str)
        if isopen =false then call open()
        set getrs = server.createobject("adodb.recordset")
        getrs.open str,conn,3,3
    End Function


    '返回一个asp原生数组
    Function getrows(Byval str)
        if isopen =false then call open()
        set rs =conn.execute(str)
        getrows = rs.GetRows()
        rs.close
        set rs = nothing
    End Function

    '返回一个锯齿数组
    Function getArray(Byval str)
        getArray = FormatArray(getrows(str))
    End Function

    '使用缓存，得到数组
    Function getcache(Byval str ,Byval min)
        dim cacheobj
        dim key
        key = md5(str,16)
        set cacheobj = cachefactory(min)
        cacheobj.freetime = min
        dim myarray
        myarray = cacheobj.getcache(key)
        if not isarray(myarray) then
            getcache = getarray(str)
            cacheobj.setcache key,getcache
        else
            getcache = myarray
         end if
    End Function

End Class

'格式化数组，将二维数组转化为锯齿数组
function FormatArray(Byval a)
    dim b,c,i,j
    redim b(ubound(a,2))
    redim c(ubound(a,1))
    for i = 0 to ubound(a,2)
        for j=0 to ubound(a,1)
            c(j)=a(j,i)
        next
        b(i)=c
    next
    FormatArray = b
end function

'工厂函数，返回需要的缓存类
Function cachefactory(byval min)
    '缓存时间小于30分钟的，存在appaction中，长于30分钟的存在文本文件中
    if min<30 then
        '调试语句用来查看是否成功调用对象,测试完毕请及时注释
        '-----------------------------------------------
        response.write "<h1>成功调用内存缓存<h1>"
        '-----------------------------------------------
        set cachefactory = new memcache
    else
        '调试语句用来查看是否成功调用对象,测试完毕请及时注释
        '-----------------------------------------------
        response.write "<h1>成功调用硬盘缓存<h1>"
        '-----------------------------------------------
        set cachefactory = new filecache
    end if
End Function

'内存缓存类
class memcache
    '过期时间
    public freetime
    '初始化过期时间
    Private Sub class_initialize()
        freetime = 30
    End Sub
    '建立缓存
    '在apaction中同时存储变量的内容和时间
    function setcache(Byval key,Byval value)
        Application.Lock
        '此处做了改变，不在直接存储数组，转而存储数组代码
        Application( key) = arr2code(value)
        Application( key&"_time") = now()
        Application.UnLock

        '测试是否成功建立内存缓存，测试完毕，请及时注释
        '-------------------------------------------------
        response.write "<h2>成功建立缓存</h2>"
        '-------------------------------------------------
    End Function
    '读取缓存
    '读取时间，如果过期清空，未过期，读取数据
    Function getcache(Byval key)
        on error resume next
        dim cachetime
        cachetime = Application( key&"_time")
        if datediff("n",cachetime,now())>freetime then
            Application.Lock
            set Application( key) = nothing
            set Application( key&"_time") = nothing
            Application.UnLock
        else
            execute Application( key)
            getcache = a
        end if
        '测试是否成功读取内存缓存，测试完毕，请及时注释
        '-------------------------------------------------
        response.write "<h2>成功读取缓存</h2>"
        '-------------------------------------------------
        if err then getcache = ""
    End Function
end class

'文件缓存类
class filecache
    '文件操作类(自定义)，过期时间
    public file    ,freetime

    '初始化过期时间换个文本操作对象
    Private Sub class_initialize()
        set file = new fso
        freetime = 60
    End Sub

    '建立缓存
    '将数组转化为code,并存入cache文件夹下
    function setcache(Byval key,Byval value)
        file.content = arr2code(value)
        file.save "/cache/"&key&".cache"
        '测试是否成功建立硬盘缓存，测试完毕，请及时注释
        '-------------------------------------------------
        response.write "<h2>成功建立缓存</h2>"
        '-------------------------------------------------
    end function

    '读取缓存
    function getcache(Byval key)
        dim cachetime
        '未找到文件则没有数据
        if not file.exist("/cache/"&key&".cache") then getcache="" : exit function
        cachetime = file.time("/cache/"&key&".cache")
        '查看过期时间
        if datediff("n",cachetime,now())>freetime then
            getcache =""
            file.del("/cache/"&key&".cache")
        else
            '执行读取到的文本文件
            execute   file.load("/cache/"&key&".cache")
            getcache =a
        '测试是否成功读取硬盘缓存，测试完毕，请及时注释
        '-------------------------------------------------
        response.write "<h2>成功读取缓存</h2>"
        '-------------------------------------------------
        end if
    End function
end class

'将数组转化为定义数组的字符串，数组名称暂定为a
Function arr2code(byval arr)
    if not isarray(arr) then exit function
    dim mystr
    mystr = "dim a("&ubound(arr)&") :"
    dim i
    for i = 0 to ubound(arr)
        mystr = mystr& "a("&i&") = array("""&join(arr(1),""",""")&""") :"
    next

    arr2code = mystr
End function

dim db : set db = new mysql

'call ceshi1
'调用一次 ceshi2 , 输出成功设置缓存，成功读取缓存，刷新一下页面输出成功读取缓存
call ceshi3

'不使用缓存，直接使用getarray得到锯齿数组，并循环输出书名
sub ceshi1
    dim a : a = db.getarray("select bookid,bookname from book")
    if isarray(a) then
        for i = 0 to ubound(a)
        response.write "书名："&a(i)(1)&"<br/>"
        next
    end if
end sub

'将分钟设置在10，使用appliaction 作为缓存
sub ceshi2
    dim a : a = db.getcache("select bookid,bookname from book",10)
    if isarray(a) then
        for i = 0 to ubound(a)
        response.write "书名："&a(i)(1)&"<br/>"
        next
    end if
end sub

'将分钟设置在40，使用硬盘作为缓存
sub ceshi3
    dim a : a = db.getcache("select bookid,bookname from book",40)
    if isarray(a) then
        for i = 0 to ubound(a)
        response.write "书名："&a(i)(1)&"<br/>"
        next
    end if
end sub