本人写的整套创建静态文件类_静态文件类的博客-CSDN博客

本文链接：https://blog.csdn.net/suchenge/article/details/2952538
 
 
<%
'-------------------------------------------------------
' ☆☆ 2006-9-12 ☆☆
' ☆☆ 全国版中要使用的创建静态页面函数类 ☆☆
' ☆☆ 宿远 ☆☆
'---------------------------------------------------------
'
    Class clsCreateFile
        Private strUrl
        Private strAddress
        Private strTarget
        Private strAddressUrl
        Private CreateFile
        Private CreateFolder
        Public SourceUrl                '要抓取的来源页面的链接地址实例
        Public TargetAddress            '要将文件创建到的目标地址实例
        Public Directory                '要将文件创建到的目标地址的目录实例
        Private Sub Class_Initialize()    '类初始化
            Set SourceUrl = New clsSourceUrl
            Set TargetAddress = New clsTargetAddress
            Set Directory = New clsDirectory
        End Sub
        Private Sub Class_Terminate()        '类关闭
            Set SourceUrl = Nothing
            Set TargetAddress = Nothing
            Set Directory = Nothing
        End Sub
        Public Property Let Url(Value)
            strUrl = Value
        End Property
        Public Property Get Url()
            Url = strUrl
        End Property
        Public Property Let Address(Value)
            strAddress = Value
        End Property
        Public Property Get Address()
            Address = strAddress
        End Property
        Public Property Let Target(Value)
            strTarget = Value
        End Property
        Public Property Get Target()
            Target = strTarget
        End Property
        Public Property Let AddressURL(Value)
            strAddressURL = Value
        End Property
        Public Property Get AddressURL()
            AddressURL = strAddressURL
        End Property
        Public Sub Open(intCreateFile,intCreateFolder)
            CreateFile = intCreateFile
            CreateFolder = intCreateFolder
            SourceUrl.FileUrl = strUrl
            SourceUrl.FileAddress = strAddress
            SourceUrl.Visit()
            TargetAddress.Address = strTarget
            TargetAddress.AddressURL = strAddressUrl & TargetAddress.Name()
            Directory.Address = Replace(TargetAddress.Address,TargetAddress.Name,"")
        End Sub
        Public Function Err()
            Dim Discover
            IF cBool(SourceUrl.ExistsFiles()) = False Then
                strErr = "源文件不存在"
                Err = strErr
                Exit Function
                'strErrDepict = strErrDepict & IIF(strErrDepict = "","","<br/>") & strErr
            End IF
            IF cBool(SourceUrl.CanVisit) = False Then
                strErr = "源文件访问出错"
                Err = strErr
                Exit Function
                'strErrDepict = strErrDepict & IIF(strErrDepict = "","","<br/>") & strErr
            End IF
            IF cBool(CreateFolder) = False Then
                IF cBool(Directory.ExistsFolder()) = False Then
                    strErr = "写入目录不存在"
                    Err = strErr
                    Exit Function
                    'strErrDepict = strErrDepict & IIF(strErrDepict = "","","<br/>") & strErr
                End IF
            End IF
            IF cBool(CreateFile) = False Then
                IF cBool(TargetAddress.ExistsFiles()) = True Then
                    strErr = "目标文件已存在"
                    Err = strErr
                    Exit Function
                    'strErrDepict = strErrDepict & IIF(strErrDepict = "","","<br/>") & strErr
                End IF
            End IF
        End Function
        Public Sub Create()
            IF Err = "" Then
                IF cBool(CreateFolder)     = True Then
                    Directory.CreateFolder()
                End IF
                IF cBool(CreateFile) = True Then
                    TargetAddress.CreateFile SourceUrl.responseBody
                End IF
            End IF
        End Sub
    End Class
    Class clsSourceUrl
        Private strUrl
        Private strAddress
        Private FileService
        Public CanVisit
        Public ReadyState
        Public Status
        Public responseBody
        Private Sub Class_Initialize()    '类初始化
            CanVisit = False
            Set FileService = New clsFileService
        End Sub
        Private Sub Class_Terminate()        '类关闭
            Set FileService = Nothing
        End Sub
        Public Property Let FileUrl(Value)
            strUrl = Value
        End Property
        Public Property Get FileUrl
            FileUrl = strUrl
        End Property
        Public Property Let FileAddress(Value)
            strAddress = Value
        End Property
        Public Property Get FileAddress
            FileAddress = strAddress
        End Property
        Public Function Name()
            Name = FileService.FileName(strAddress,1)
        End Function
        Public Function ExistsFiles()
            Response.Write(strAddress & "<br/>")
            ExistsFiles = FileService.ExistsFiles(strAddress)
        End Function
        Public Sub Visit()
            FileService.VisitUrl strUrl,0
            ReadyState         = FileService.ReadyState
            Status             = FileService.Status
            responseBody     = FileService.responseBody
            IF ReadyState = 4 Then
                IF Status = 200 And Lenb(responseBody)>0 Then CanVisit = True
            End IF
        End Sub
        Public Function FileText()
            FileText = FileService.FileText(strAddress)
        End Function
    End Class
    Class clsTargetAddress
        Private strAddress
        Private strAddressUrl
        Private FileService
        Private Sub Class_Initialize()    '类初始化
            Set FileService = New clsFileService
        End Sub
        Private Sub Class_Terminate()        '类关闭
            Set FileService = Nothing
        End Sub
        Public Property Let Address(Value)
            strAddress = Value
        End Property
        Public Property Get Address()
            Address = strAddress
        End Property
        Public Property Let AddressURL(Value)
            strAddressUrl = Value
        End Property
        Public Property Get AddressURL()
            AddressURL = strAddressUrl
        End Property
        Public Function Name()
            Name = FileService.FileName(strAddress,1)
        End Function
        Public Function ExistsFiles()
            ExistsFiles = FileService.ExistsFiles(strAddress)
        End Function
        Public Sub CreateFile(htmlBody)
            FileService.CreateHtml htmlBody,Address
        End Sub
    End Class
    Class clsDirectory
        Private strAddress
        Private FileService
        Private Sub Class_Initialize()    '类初始化
            Set FileService = New clsFileService
        End Sub
        Private Sub Class_Terminate()        '类关闭
            Set FileService = Nothing
        End Sub
        Public Property Let Address(Value)
            strAddress = Value
        End Property
        Public Property Get Address()
            Address = strAddress
        End Property
        Public Function ExistsFolder()
            ExistsFolder = FileService.ExistsFolder(strAddress)
        End Function
        Public Function LostFolder()
            LostFolder = FileService.LostFolder(strAddress,0)
        End Function
        Public Sub CreateFolder()
            FileService.LostFolder strAddress,1
        End Sub
    End Class
    Class clsFileService
        Private objFso
        Private objXml
        Public Status
        Public responseBody
        Public ReadyState
        Public responseText
        Public Sub Class_Initialize()
            Set objFso = Server.CreateObject(OBJFSOID)
            Set objXml = Server.CreateObject("MSXML2.XMLHTTP.3.0")
        End Sub
        Public Sub Class_Terminate()
            Set objFso = Nothing
            Set objXml = Nothing
        End Sub
        Public Function FileName(strAddress,intPlace)        '通过链接地址或目标地址查询文件名
            IF strAddress <> "" Or Not isNULL(strAddress) Then
                strAddress = Replace(strAddress,"/","/")
                IF InStr(strAddress, "/") Then
                    arrAddress = Split(strAddress,"/")
                    FileName = arrAddress(UBound(arrAddress))
                    IF cBool(intPlace) = False Then FileName = Replace(strAddress,FileName,"")
                Else
                    FileName = strAddress
                    IF cBool(intPlace) = False Then FileName = ""
                End IF
            Else
                FileName = ""
            End IF
        End Function
        Public Function ExistsFiles(strPath)
            IF strPath <> "" Then
                IF objFso.FileExists(strPath) Then
                    ExistsFiles = True
                Else
                    ExistsFiles = False
                End IF
            Else
                 ExistsFiles = False
            End IF
        End Function
        Public Function ExistsFolder(strPath)
            IF strPath <> "" Then
                IF objFso.FolderExists(strPath) Then
                    ExistsFolder = True
                Else
                    ExistsFolder = False
                End IF
            Else
                 ExistsFolder = False
            End IF
        End Function
        Public Function LostFolder(strAddress,intCreateFolder)
            Dim arrAddress,strTmp
            IF strAddress <> "" Then
                strTmp = Replace(Replace(strAddress,SITEMAP,""),"/","/")
                arrAddress = Split(strTmp,"/")
                For i = 0 To UBound(arrAddress) - 1
                    strTmpPath = strTmpPath & arrAddress(i) & "/"
                    strPathTmp    = SITEMAP & strTmpPath
                    IF Not objFso.FolderExists(strPathTmp) Then
                        LostFolder = arrAddress(i)
                        IF cBool(intCreateFolder) = False Then
                            Exit Function
                        Else
                            objFso.CreateFolder(strPathTmp) ' 创建
                        End IF
                    End If
                Next
            Else
                LostFolder = ""
            End IF
        End Function
        Public Function bytes2BSTR(vIn)
            Dim strReturn
            Dim i,ThisCharCode,NextCharCode
            strReturn = ""
            For i = 1 To LenB(vIn)
                ThisCharCode = AscB(MidB(vIn,i,1))
                IF ThisCharCode < &H80 Then
                    strReturn = strReturn & Chr(ThisCharCode)
                Else
                    NextCharCode = AscB(MidB(vIn,i + 1,1))
                    strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
                    i = i + 1
                End IF
            Next
            bytes2BSTR = strReturn
        End Function
        Public Sub VisitUrl(strUrl,intResType)
            Dim oUrl,tmpPara
            tmpPara = "&m="
            IF InStr(strUrl,"?") = 0 Then tmpPara = "?m="
            Randomize()
            oUrl = strUrl & tmpPara & Rnd()
            objXml.Open "Get", oUrl ,False
            objXml.Send
            ReadyState = objXml.ReadyState
            Status = objXml.Status
            Select Case intResType
                case 0
                    responseBody = objXml.responseBody
                case 1
                    responseBody = objXml.responseText
                case 2
                    responseBody = objXml.responseXML
                case 3
                    responseBody = objXml.responseStream
            End Select
        End Sub
        Public Sub CreateHtml(xmlBody,FilePath)
            Dim objStream
            Set objStream = Server.CreateObject("Adodb.Stream")
            objStream.Type = 1
            objStream.Mode = 3
            objStream.Open()
            objStream.Write xmlBody
            objStream.Position = 0
            objStream.Type = 2
            objStream.Charset = "GB2312"
            objStream.SaveToFile FilePath,2
            objStream.Close()
            Set objStream = Nothing
        End Sub
        Public Function FileText(FilePath)
            IF ExistsFiles(FilePath) Then
                Set objFileOpen = objFso.OpenTextFile(FilePath,1)
                FileText = objFileOpen.ReadAll
                Set objFileOpen = Nothing
            Else
                FileText = ""
            End IF
        End Function
    End Class
    Dim objCreateFile
    Set objCreateFile = New clsCreateFile
        objCreateFile.Url         = "http://sh.studyget.com/Template/Column_List/GRE_Datum_1.asp?ThirdID=1281&TopNum=2"
        objCreateFile.Address     = "//192.168.1.254/www.studyget.com/Garrison/201226/Template/Column_List/GRE_Datum_1.asp"
        objCreateFile.Target     = "//192.168.1.254/www.studyget.com/00/01/00.html"
        objCreateFile.AddressUrl = "http://www.studyget.com/00/01/"
        objCreateFile.Open 1,1
            Response.Write("<br><br><------------------------------------------------------------><br>")
            Response.Write("<br>SourceUrl.FileUrl: " & objCreateFile.SourceUrl.FileUrl)
            Response.Write("<br>SourceUrl.FileAddress: " & objCreateFile.SourceUrl.FileAddress)
            Response.Write("<br>SourceUrl.Name(): " & objCreateFile.SourceUrl.Name())
            Response.Write("<br>SourceUrl.ExistsFiles(): " & objCreateFile.SourceUrl.ExistsFiles())
            Response.Write("<br><br><------------------------------------------------------------><br>")
            Response.Write("<br>TargetAddress.Address:  " & objCreateFile.TargetAddress.Address)
            Response.Write("<br>TargetAddress.AddressUrl:  " & objCreateFile.TargetAddress.AddressUrl)
            Response.Write("<br>TargetAddress.Name():  " & objCreateFile.TargetAddress.Name())
            Response.Write("<br>TargetAddress.ExistsFiles():  " & objCreateFile.TargetAddress.ExistsFiles())
            Response.Write("<br><br><------------------------------------------------------------><br>")
            Response.Write("<br>Directory.Address: " & objCreateFile.Directory.Address)
            Response.Write("<br>Directory.ExistsFolder: " & objCreateFile.Directory.ExistsFolder)
            Response.Write("<br>Directory.LostFolder: " & objCreateFile.Directory.LostFolder)
        IF objCreateFile.Err <> "" Then
            Response.Write(objCreateFile.Err)
        Else
            objCreateFile.Create()
        End IF
    Set objCreateFile = Nothing
%>
 