开发日志：本人写的整套创建静态文件类

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