您的位置:建站学院首页 >> 文章 >> asp技术 >> 系统相关
老外写的Asp类代码

<%
' 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
%>

Google
 
Web www.cqxw.net