<%
Rem-XML-Cache-Klasse
'------------------------------------------------ - -------------------
„Bitte bewahren Sie beim Nachdruck die Copyright-Informationen auf.“
'Autor: ╰⑥月の雨╮
'Version: ver1.0
„Diese Klasse basiert teilweise auf der Walkmanxml-Datencache-Klasse, die bequemer zu verwenden ist, um zu kommunizieren und Fortschritte zu erzielen.“
'------------------------------------------------ - -------------------
Klasse XmlCacheCls
Private m_DataConn 'Datenquelle, muss geöffnet sein
Private m_CacheTime 'Cache-Zeit, in Sekunden, Standard ist 10 Minuten
Private m_XmlFile 'xml-Pfad, absolute Adresse verwenden, keine Erweiterung erforderlich
Private m_Sql 'SQL-Anweisung
Privates m_SQLArr '(schreibgeschützt) zurückgegebenes Datenarray
Private m_ReadOn '(Schreibgeschützt) Gibt
die Eigenschaften des Lesemodus 1-Datenbank 2-XML zur Erkennung zurück =========================== ==============
'Datenquelle
Öffentliches Eigentumsset Conn(v)
Setze m_DataConn = v
End-Eigenschaft
Öffentliches Eigentum Get Conn
Conn = m_DataConn
End-Eigenschaft
'Cache-Zeit
Öffentliche Eigenschaft Let CacheTime(v)
m_CacheTime = v
End-Eigenschaft
Öffentliches Eigentum CacheTime abrufen
CacheTime = m_CacheTime
End Property
'XML-Pfad, absolute Adresse verwenden
Öffentliche Eigenschaft Let XmlFile(v)
m_XmlFile = v
End-Eigenschaft
Öffentliche Eigenschaft GetXmlFile
XmlFile = m_XmlFile
End Property
'SQL-Anweisung
Öffentliches Eigentum Let Sql(v)
m_Sql = v
End-Eigenschaft
Öffentliches Eigentum Get Sql
SQL = m_SQL
End-Eigenschaft
'Record-Array zurückgeben
Öffentliche Eigenschaft SQLArr abrufen
SQLArr = m_SQLArr
End-Eigenschaft
'Zurück zum Lesemodus
Öffentliches Eigentum Lesen Sie weiter
ReadOn = m_ReadOn
End-Eigenschaft
'Zerstörung der Klasse=========================================
Private Sub Class_Initialize() 'Klasse initialisieren
m_CacheTime=60*10 'Die Standard-Cache-Zeit beträgt 10 Minuten
End Sub
Private Sub Class_Terminate() 'Klasse freigeben
End Sub
'Öffentliche Methode der Klasse ================================ ========
Rem liest Daten
Öffentliche Funktion ReadData
If FSOExistsFile(m_XmlFile) Then 'Xml-Cache vorhanden, direkt aus XML lesen
ReadDataFromXml
m_ReadOn=2
Anders
ReadDataFromDB
m_ReadOn=1
Ende wenn
End Function
Rem schreibt XML-Daten
Öffentliche Funktion WriteDataToXml
If FSOExistsFile(m_XmlFile) Then 'Direkt beenden, wenn XML nicht abgelaufen ist.'
Wenn nicht, isXmlCacheExpired(m_XmlFile,m_CacheTime) dann Funktion beenden
Ende wenn
Dimrs
Dimxmlcontent
Dim k
xmlcontent = ""
xmlcontent = xmlcontent & "<?xml version=""1.0"" binding=""gb2312""?>" & vbnewline
xmlcontent = xmlcontent & " <root>" & vbnewline
k=0
Setze Rs = Server.CreateObject("Adodb.Recordset")
Rs.open m_sql,m_DataConn,1
Während nicht rs.eof
xmlcontent = xmlcontent & " <item "
Für jedes Feld in rs.Fields
xmlcontent = xmlcontent & field.name & "=""" & XMLStringEnCode(field.value) & """ "
Nächste
rs.movenext
k=k+1
xmlcontent = xmlcontent & "></item>" & vbnewline
Wend
rs.close
Setrs=Nichts
xmlcontent = xmlcontent & " </root>" & vbnewline
Ordnerpfad dimmen
Ordnerpfad = Trim(left(m_XmlFile,InstrRev(m_XmlFile,"")-1))
Rufen Sie CreateDIR(folderpath&"") 'Ordner erstellen' auf
WriteStringToXMLFile m_XmlFile,xmlcontent
End Function
'Private Methode der Klasse=========================================
Rem aus der XML-Datei, die Daten liest
Private Funktion ReadDataFromXml
Dim SQLARR() 'Array
Dim XmlDoc 'XmlDoc-Objekt
Dim objNode 'untergeordneter Knoten
Dim ItemsLength 'Die Länge des untergeordneten Knotens
Dim AttributesLength 'Die Länge der Attribute des untergeordneten Knotens
Setze XmlDoc=Server.CreateObject("Microsoft.XMLDOM")
XmlDoc.Async=False
XmlDoc.Load(m_XmlFile)
Set objNode=XmlDoc.documentElement 'Den Wurzelknoten abrufen
ItemsLength=objNode.ChildNodes.length 'Ermitteln Sie die Länge der untergeordneten Knoten
Für items_i=0 bis ItemsLength-1
AttributesLength=objNode.childNodes(items_i).Attributes.length 'Ermitteln Sie die Länge der Attribute des untergeordneten Knotens
Für Attributes_i=0 bis AttributesLength-1
ReDim Preserve SQLARR(AttributesLength-1,items_i)
SQLArr(Attributes_i,items_i) = objNode.childNodes(items_i).Attributes(Attributes_i).Nodevalue
Nächste
Nächste
Legen Sie XmlDoc = Nothing fest
m_SQLArr = SQLARR
End Function
Rem liest Daten aus der Datenbank
Private Funktion ReadDataFromDB
Dimrs
DimSQLARR()
Dim k
k=0
Setze Rs = Server.CreateObject("Adodb.Recordset")
Rs.open m_sql,m_DataConn,1
Wenn nicht (rs.eof und rs.bof) Dann
Während nicht rs.eof
Dunkle Feldlänge
fieldlegth = rs.Fields.count
ReDim Preserve SQLARR(fieldlegth,k)
Dim Fieldi
Für fieldi = 0 bis fieldlegth-1
SQLArr(fieldi,k) = rs.Fields(fieldi).value
Nächste
rs.movenext
k=k+1
Wend
Ende wenn
rs.close
Setrs=Nichts
m_SQLArr = SQLArr
End Function
'Private Hilfsmethode der Klasse======================================= ==
Rem XML-Datei schreiben
Private Sub WriteStringToXMLFile(filename,str)
Dim fs,ts
Setze fs= createobject("scripting.filesystemobject")
Wenn nicht IsObject(fs), dann Sub beenden
Setze ts=fs.OpenTextFile(filename,2,True)
ts.writeline(str)
ts.close
Setze ts=Nothing
Setze fs=Nothing
End Sub
Rem ermittelt, ob der XML-Cache abgelaufen ist
Private Funktion isXmlCacheExpired(file,seconds)
Datei letztes Mal dimmen
filelasttime = FSOGetFileLastModifiedTime(file)
Wenn DateAdd("s",seconds,filelasttime) < Now Then
isXmlCacheExpired = True
Anders
isXmlCacheExpired = Falsch
Ende wenn
End Function
Rem ruft die letzte Änderungszeit der Datei ab
Private Funktion FSOGetFileLastModifiedTime(file)
Dim fso,f,s
Setze fso=CreateObject("Scripting.FileSystemObject")
Setze f=fso.GetFile(file)
FSOGetFileLastModifiedTime = f.DateLastModified
Setze f = Nichts
Setze fso = Nichts
die End Function
Rem-Datei?
Öffentliche Funktion FSOExistsFile(file)
Dim fso
Setze fso = Server.CreateObject("Scripting.FileSystemObject")
Wenn fso.FileExists(file) Dann
FSOExistsFile = true
Anders
FSOExistsFile = false
Ende wenn
Setze fso = nichts
End Function
Rem XML-Escape-Zeichen
Private Funktion XMLStringEnCode(str)
If str&"" = "" Then XMLStringEnCode="":Exit Function
str = Ersetzen(str,"<","<")
str = Ersetzen(str,">",">")
str = Ersetzen(str,"'","'")
str = Ersetzen(str,"""",""")
str = Ersetzen(str,"&","&")
XMLStringEnCode = str
End Function
Rem Ordner erstellen
Private Funktion CreateDIR(byval LocalPath)
Bei Fehler Weiter fortsetzen
Dim i,FileObject,patharr,path_level,pathtmp,cpath
LocalPath = Ersetzen(LocalPath,"","/")
Set FileObject = server.createobject("Scripting.FileSystemObject")
patharr = Split(LocalPath,"/")
path_level = UBound(patharr)
Für i = 0 bis path_level
Wenn i=0, dann
pathtmp=patharr(0) & "/"
Anders
pathtmp = pathtmp & patharr(i) & "/"
Ende wenn
cpath = left(pathtmp,len(pathtmp)-1)
Wenn nicht FileObject.FolderExists(cpath) Dann
'Response.write cpath
FileObject.CreateFolder cpath
Ende wenn
Nächste
Setzen Sie FileObject = Nothing
Wenn err.number<>0 Dann
CreateDIR = Falsch
ähm.Klar
Anders
CreateDIR = True
Ende wenn
Funktion beenden
Unterricht beenden
'Cache festlegen
Funktion SetCache(xmlFilePath,CacheTime,Conn,Sql)
set cache=new XmlCacheCls
Cache.Conn=Conn festlegen
Cache.XmlFile=xmlFilePath
Cache.Sql=SQL
Cache.CacheTime=CacheTime
Cache.WriteDataToXml
Cache festlegen = Nichts
Funktion beenden
'Cache lesen
Funktion ReadCache(xmlFilePath,Conn,Sql,ByRef ReadOn)
set cache=new XmlCacheCls
Legen Sie „cache.Conn=conn“ fest
Cache.XmlFile=xmlFilePath
Cache.Sql=SQL
Cache.ReadData
ReadCache=cache.SQLArr
ReadOn=cache.ReadOn
Funktion beenden
%>
Verwendung:
1 Daten in XML zwischenspeichern
Code:
Programmcode
<!--#include file="Conn.asp"-->
<!--#include file="Xml.asp"-->
<%
set cache=new XmlCacheCls
Legen Sie „cache.Conn=conn“ fest
Cache.XmlFile=Server.Mappath("xmlcache/index/Top.xml")
Cache.Sql="Wählen Sie die 15 besten Produkte prod_id,prod_name,prod_uptime aus tblProduction aus"
Cache.WriteDataToXml
%>
2 Code zum Lesen zwischengespeicherter Daten
:
Programmcode
<!--#include file="Conn.asp"-->
<!--#include file="Xml.asp"-->
<%
set cache=new XmlCacheCls
Legen Sie „cache.Conn=conn“ fest
Cache.XmlFile=Server.Mappath("xmlcache/index/Top.xml")
Cache.Sql="Wählen Sie die Top 15 prod_id,prod_name,prod_uptime aus tblProduction order by prod_id asc aus"
Cache.ReadData
rsArray=cache.SQLArr
if isArray(rsArray) dann
für i=0 bis ubound(rsArray,2)
für j=0 bis ubound(rsArray,1)
Antwort.Write(rsArray(j,i)&"<br><br>")
nächste
nächste
Ende wenn
%>
Cache-Zeit, die Standardeinheit ist 10 Minuten in Sekunden; Sie können Cache.CacheTime=60*30 auch selbst auf 30 Minuten festlegen