操作xml的类

操作xml的类2009-12-15
<%
"" Site validator 1.0.0
"" Very simple concept, run this script on your server, it records the file details to an
"" XML file which you download and store. Then, when you come back to make changes you can
"" run the XML file back through this script and it will tell you if any of the files have
"" been modified. Quite simple really.
"" Requires XML parser version 3 to work really. Also needs access to the FileSystemObject.
Dim objRequest, objFSO, sXML, objXML, objNode, objFile, lDifferences, sVersion, sDate

sVersion = "1.0.0"

Response.Expires = -1

Set objRequest = New ProxyRequest

if UCase（objRequest（"action"）） = "UPLOAD" then
Response.ContentType = "text/html"
%>
<HTML>
<HEAD>
<TITLE>ASPValidate, Site validator <%=sVersion%></TITLE>
</HEAD>
<BODY>
<h1>ASPValidate, Site validator <%=sVersion%></h1>
<h2>Author: Chris Read （<a href="mailtmrjolly@bigpond.net.au">Mail</a>, <a href="http://users.bigpond.net.au/mrjolly.">Web</a>）</h2>
<p>Validation results</p>
<%
Set objFSO = Server.CreateObject（"Scripting.FileSystemObject"）
Set objXML = Server.CreateObject（"MSXML2.DOMDocument"）
objXML.async = False

sXML = objRequest（"xmlupload"）

objXML.loadXML objRequest.ASCIIToUNICODE（sXML）

lDifferences = 0

"" Now we go through the XML entries and validate each one against that on the server
For Each objNode in objXML.documentElement.childNodes
 on error resume next
 Set objFile = objFSO.GetFile（objNode.getAttribute（"path"））
 if err.number <> 0 then
  "" Problem with the file
  Response.Write "<b>"
  Response.Write objNode.getAttribute（"path"） & "<br>"
  Response.Write "^^^^ FILE HAS BEEN REMOVED<br>"
  Response.Write "</b>"
 else
  if CStr（objFile.DateLastModified） <> objNode.getAttribute（"modified"） or CStr（objFile.Size） <> objNode.getAttribute（"size"） then
   Response.Write "<b>"
   Response.Write objNode.getAttribute（"path"） & "<br>^^^^ Changed, "
   Response.Write "original: " & objNode.getAttribute（"modified"） & " modified: " & objFile.DateLastModified & ", "
   Response.Write "was " & objNode.getAttribute（"size"） & " bytes - now " & CStr（objFile.Size） & " bytes<br>"
   Response.Write "</b>"
   lDifferences = lDifferences + 1
  elseif objRequest（"view"） <> "" then
   Response.Write objNode.getAttribute（"path"） & "- File has not changed<br>"
  end if
 end if
 on error goto 0
Next
if lDifferences = 0 then
 Response.Write "<p>The site matches the last update</p>"
else
 Response.Write "<p>" & lDifferences & " difference（s） detected in the above files</p>"
end if
%>
<a href="aspvalidate.asp">Back to the main page</a>
</BODY>
</HTML>
<%
Response.End
elseif UCase（objRequest.QueryString（"action"）） = "XML" then
Set objFSO = Server.CreateObject（"Scripting.FileSystemObject"）

sXML = "<？xml version=""1.0""？>" & vbCRLF
sXML = sXML & "<！-- Generated by Site Validator " & sVersion & " -->" & vbCRLF
sXML = sXML & "<！-- Author: Chris Read -->" & vbCRLF
sXML = sXML & "<site>" & vbCRLF

sXML = sXML & ProcessFolder（Server.MapPath（"/"））

sXML = sXML & "</site>" & vbCRLF

sDate = Year（Date（）） & "-" & Month（Date（）） & "-" & Day（Date（））

Response.ContentType = "text/xml"
Response.AddHeader "Content-Disposition","attachment; filename=site" & sDate & ".xml;"
Response.Write sXML
Response.End
else
Response.ContentType = "text/html"
%>
<HTML>
<HEAD>
<TITLE>ASPValidate, Site validator <%=sVersion%></TITLE>
</HEAD>
<BODY>
<h1>ASPValidate, Site validator <%=sVersion%></h1>
<h2>Author: Chris Read （<a href="mailtmrjolly@bigpond.net.au">Mail</a>, <a href="http://users.bigpond.net.au/mrjolly.">Web</a>）</h2>
<h3>It validates sites</h3>
<p>This script will scan your entire web site from the root folder, and record the file sizes and last modified dates for all ASP pages.
This is saved as XML. Then, at a later date, when you need to make adjustments or check anything, you can load the XML into
this script again and it""ll tell you which files have changed and when.</p>
Checksum all ASP files on this site and generate an XML checksum file<br>
<a href="aspvalidate.asp？action=xml&html=0">Right-click here and select "Save As" to download for ASP files only</a><br>
<a href="aspvalidate.asp？action=xml&html=1">Right-click here and select "Save As" to download for ASP and HTML files</a><br>
<form action="aspvalidate.asp" method="post" enctype="multipart/form-data" id=form1 name=form1>
<br>OR<br><br>
Upload XML File of checksums and validate it against this site<br>
File: <input type=file name=xmlupload><br>
Show all results: <input type=checkbox name=view><br>
<input type=submit name=action value="Upload">
</form>
</BODY>
</HTML>
<%
Response.End
end if

"" Bit of recursion to traverse the folder structure building XML
Function ProcessFolder（sFolder）
Dim objFolder, objRoot, objFile, sTemp, sLastModified, sSize

Set objRoot = objFSO.GetFolder（sFolder）

sTemp = ""

For Each objFile in objRoot.Files
 if （Right（objFile.Name,4） = ".asp" or （（Right（objFile.Name,5） = ".html" or Right（objFile.Name,4） = ".htm"） and Request（"html"） = 1）） and instr（sFolder & "" & objFile.Name,"_vti_cnf"） = 0 then
  sLastModified = objFile.DateLastModified
  sSize = objFile.Size
  sTemp = sTemp & "<file path=""" & sFolder & "" & objFile.Name & """ modified=""" & sLastModified & """ size=""" & sSize & """/>" & vbCRLF
 end if
Next

For Each objFolder in objRoot.SubFolders
 sTemp = sTemp & ProcessFolder（sFolder & "" & objFolder.Name）
Next

Set objFolder = Nothing

ProcessFolder = sTemp
End Function

"" Reques object proxy for uploads.
Class ProxyRequest
Public ClientCertificate
Public Cookies
Public Form
Public QueryString
Public ServerVariables
Public TotalBytes

Private m_Item

Public Default Property Get Item（sIndex）
 Item = m_Item（sIndex）
End Property

Private sBinaryText

Public Function BinaryRead（lTotalBytes）
 BinaryRead = LeftB（sBinaryText,lTotalBytes）
End Function

Private Sub ParseRequest（）
 Dim sDelimeter
 Dim lKeyLength
 Dim lBlockEnd
 Dim sBlock
 Dim sTemp
 Dim sField
 Dim lStart
 Dim lLength
 Dim sFilename
 Dim sContentType
 Dim sContent

 sBlock = sBinaryText
 lKeyLength = InstrB（1,sBlock,ChrB（&H0D）） - 1
 if lKeyLength > 0 then
  sDelimeter = LeftB（sBlock,lKeyLength）
  lBlockEnd = 0
  while lBlockEnd >= 0
   "" Chop off the key, including the CR/LF pair
   sBlock = RightB（sBlock,LenB（sBlock） - （lBlockEnd + lKeyLength + 2））
   lBlockEnd = InStrB（1,sBlock,sDelimeter） - 1
   if lBlockEnd >= 0 then
    sTemp = LeftB（sBlock,lBlockEnd - 2）
    lStart = InStrB（1,sTemp,UNICODEToASCII（"name="）） + 6
    lLength = InStrB（lStart,sTemp,ChrB（34）） - lStart
    sField = MidB（sTemp,lStart,lLength）
    lStart = InStrB（1,sTemp,UNICODEToASCII（"filename="）） + 10
    lLength = InStrB（lStart,sTemp,ChrB（34）） - lStart
    if lStart > 10 then
     sFilename = MidB（sTemp,lStart,lLength）
     lStart = InStrB（1,sTemp,UNICODEToASCII（"Content-Type:"）） + 14
     lLength = InStrB（lStart,sTemp,ChrB（&H0D）） - lStart
     sContentType = MidB（sTemp,lStart,lLength）
    else
     sFilename = ""
     sContentType = ""
    end if
    lStart = InStrB（1,sTemp,UNICODEToASCII（vbCRLF & vbCRLF）） + 4
    lLength = LenB（sTemp） - lStart + 1
    sContent = MidB（sTemp,lStart,lLength）

    if ASCIIToUNICODE（sFilename） <> "" then
     m_Item.Add ASCIIToUNICODE（sField）,sContent
     m_Item.Add ASCIIToUNICODE（sField） & "_filename",ASCIIToUNICODe（sFilename）
     m_Item.Add ASCIIToUNICODE（sField） & "_contenttype",ASCIIToUNICODE（sContentType）
    else
     m_Item.Add ASCIIToUNICODE（sField）,ASCIIToUNICODE（sContent）
    end if
   end if
  wend
 end if
End Sub

Public Function UNICODEToASCII（sText）
 Dim lTemp
 Dim objStream

 Set objStream = Server.CreateObject（"ADODB.Stream"）

 objStream.Open

 For lTemp = 1 To Len（sText）
  objStream.WriteText ChrB（Asc（Mid（sText,lTemp,1）））
 Next

 objStream.Position = 0

 UNICODEToASCII = objStream.ReadText

End Function

Public Function ASCIIToUNICODE（sText）
 "" Do this with the stream, avoiding VBScript string concatenation, which is slow to say the least
 Dim lTemp
 Dim objStream

 Set objStream = Server.CreateObject（"ADODB.Stream"）

 objStream.Open

 For lTemp = 1 To LenB（sText）
  objStream.WriteText MidB（sText, lTemp, 1） & ChrB（0）, 0
 Next

 objStream.Position = 0

 ASCIIToUNICODE = objStream.ReadText
End Function

Private Sub Class_Initialize（）
 Set m_Item = Server.CreateObject（"Scripting.Dictionary"）
 Set ClientCertificate = Request.ClientCertificate
 Set Cookies = Request.Cookies
 Set Form = Request.Form
 Set QueryString = Request.QueryString
 Set ServerVariables = Request.ServerVariables
 TotalBytes = Request.TotalBytes
 sBinaryText = Request.BinaryRead（Request.TotalBytes）
 ParseRequest
End Sub

Private Sub Class_Terminate（）
 Set ClientCertificate = Nothing
 Set Cookies = Nothing
 Set Form = Nothing
 Set QueryString = Nothing
 Set ServerVariables = Nothing
End Sub
End Class
%>