Name


	곽진석

Subject

사용 방법 VBS

Dim WSH
Set WSH = CreateObject("WScript.Shell")
Set inet = CreateObject("InetCtls.Inet")
inet.RequestTimeOut=10
Set UrlInfoxmlRs = New XMLTable
Call UrlInfoxmlRs.LoadURL("http://www.jskwak.pe.kr/URLInfo.xml")
URLInfo = "http://www.jskwak.pe.kr"

URLSeek (URLInfo)

Function URLSeek(URLInfo)
        On Error Resume Next
        UrlInfoxmlRs.MoveFirst
        WriteLn("START " & URLInfo )

        Do While Not UrlInfoxmlRs.EOF
                TargetURL = URLInfo & UrlInfoxmlRs.GetItem("URL")

                inet.Url = TargetURL
                str = " INIT "
                str = inet.OpenURL
                IF str = " INIT " Then
                        strText = "[FIND(DownLoad):"&URLInfo &"]" &TargetURL & " "&str
                        WriteFind(strText)
                        err.clear
                ELSE
                        ErrYN ="N"
                        IF len(str) < 100 Then ErrYN = "Y_100"
                        IF instr(str,"HTTP/1.1 404") > 0  Then ErrYN = "Y_404"
                        IF instr(str,"HTTP 404") > 0  Then ErrYN = "Y_404"
                        IF instr(str,"HTTP 오류 404") > 0  Then ErrYN = "Y_404"
                        IF instr(str,"406 Not Acceptable") > 0  Then ErrYN = "Y_406"
                        IF instr(str,"403 Forbidden") > 0  Then ErrYN = "Y_403"
                        IF instr(str,"The resource cannot be found") > 0  Then ErrYN = "Y_NotFound"
                        IF instr(str,"<html><head><title>Error</title></head><body>") > 0  Then ErrYN = "Y_Error"
                        IF instr(str,"<h1><font face=Verdana color=#ff3300>") > 0  Then ErrYN = "Y_apsx1"
                        IF instr(str,"Arial, Helvetica, Geneva, SunSans-Regular, sans-serif") > 0  Then ErrYN = "Y_apsx2"
                        IF instr(str,"error_nopage.gif") > 0  Then ErrYN = "Y_D1"
                        IF instr(str,"error_contact.gif") > 0  Then ErrYN = "Y_D3"
                        IF instr(str,"07playdb/th_notice_01.gif") > 0  Then ErrYN = "Y_D2"
                        IF instr(str,"Invalid Hostname") > 0  Then ErrYN = "Y_D4"

                        IF ErrYN ="N" Then
                                msgbox str
                                strText = "[FIND:"&URLInfo&"]" &TargetURL
                                WriteFind(strText)
                        End IF

                        IF err.Number <> 0 then
                                strText = "[ERROR:"&URLInfo&"]" &TargetURL & " "&str
                                WriteError(strText)
                                err.clear
                        End IF
                End IF
                UrlInfoxmlRs.MoveNext
        Loop
        WriteLn("END " & URLInfo)
End Function

WriteLn("END")

Function WriteError(strText)
        Dim fso, MyFile
        Set fso = CreateObject("Scripting.FileSystemObject")
        FileName = "Find_" & replace(date(),"-","")&".Log"
        Set MyFile = fso.OpenTextFile(FileName, 8, True)
        MyFile.WriteLine
End Function

Function WriteFind(strText)
        Dim fso, MyFile
        Set fso = CreateObject("Scripting.FileSystemObject")
        FileName = "Find_" & replace(date(),"-","")&".Log"
        Set MyFile = fso.OpenTextFile(FileName, 8, True)
        MyFile.WriteLine strText
End Function

Function WriteLn(strText)
        Dim fso, MyFile
        Set fso = CreateObject("Scripting.FileSystemObject")
        FileName = "URL_" & replace(date(),"-","")&".Log"
        Set MyFile = fso.OpenTextFile(FileName, 8, True)
        MyFile.WriteLine now() & " A:" &strText
End Function

Class XMLTable
        Private xmlDoc_
        Private xmlList_
        Private nRecCount_
        Private nIndex_

        Public Sub Class_Initialize()
                Release
        End Sub

        Public Sub Class_Terminate()
                Release
        End Sub

        Public Sub Release()
                nRecCount_ = 0
                nIndex_ = 0
                Set xmlList_ = Nothing
                Set xmlDoc_ = Nothing
        End Sub

        Public Function Load(strFliePath)
                const SELECT_PATH = "/NewDataSet/Table"
                Load = LoadEx(strFliePath, SELECT_PATH)
        End Function

        Public Function LoadUrl(strFliePath)
                const SELECT_PATH = "/NewDataSet/Table"
                LoadUrl = LoadUrlEx(strFliePath, SELECT_PATH)
        End Function

        Public Function LoadXML(strXml)
                const SELECT_PATH = "/NewDataSet/Table"
                LoadXML = LoadXMLEx(strXml, SELECT_PATH)
        End Function

        Public Function LoadXMLEx(strXml, strXPath)
                Set xmlDoc_ = CreateObject("MSXML2.DOMDocument.3.0")
                xmlDoc_.async = False
                LoadXMLEx = xmlDoc_.loadXML(strXml)
                If Not LoadXMLEx Then Exit Function

                Set xmlList_ = xmlDoc_.selectNodes(strXPath)

                nRecCount_ = xmlList_.length
                nIndex_ = 0

                LoadXMLEx = True
        End Function

        Public Function LoadEx(strFliePath, strXPath)
                Set xmlDoc_ = CreateObject("MSXML2.DOMDocument.3.0")
                xmlDoc_.async = False

                LoadEx = xmlDoc_.load(strFliePath)
                If Not LoadEx Then Exit Function

                Set xmlList_ = xmlDoc_.selectNodes(strXPath)

                nRecCount_ = xmlList_.length
                nIndex_ = 0

                LoadEx = True
        End Function


        Public Function LoadUrlEx(strFliePath, strXPath)
                Dim strXml
                Set xmlDoc_ = CreateObject("MSXML2.DOMDocument.3.0")
                xmlDoc_.async = False

                strXml = GetXML(strFliePath)
                If strXml = "" Then
                        LoadUrlEx = False
                        Exit Function
                End If

                LoadUrlEx = xmlDoc_.loadXML(strXml)
                If Not LoadUrlEx Then Exit Function

                Set xmlList_ = xmlDoc_.selectNodes(strXPath)

                nRecCount_ = xmlList_.length
                nIndex_ = 0

                LoadUrlEx = True
        End Function

        Public Sub SetXPath(strXPath)
                Set xmlList_ = xmlDoc_.selectNodes(strXPath)

                nRecCount_ = xmlList_.length
                nIndex_ = 0
        End Sub

        Public Function GetXML(strURL)
                Dim xmlHttp
                Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP.3.0")

                xmlHttp.open "GET", strURL, false
                xmlHttp.send

                If xmlHttp.status = "200" Then
                        GetXML = xmlHttp.responseText
                Else
                        GetXML = ""
                End If

                Set xmlHttp = Nothing
        End Function

        Public Function GetItem(strName)
                If xmlList_(nIndex_).selectSingleNode(strName) Is Nothing Then
                        GetItem = ""
                        Exit Function
                End If
                GetItem = xmlList_(nIndex_).selectSingleNode(strName).text
        End Function

        Public Function GetItemNode(strName)
                Set GetItemNode = xmlList_(nIndex_).selectSingleNode(strName)
        End Function

        Public Function GetCurrRowNode()
                Set GetCurrRowNode = xmlList_(nIndex_)
        End Function

        Public Sub Save(stream)
                xmlDoc_.save stream
        End Sub

        Public Function RecordCount()
                RecordCount = nRecCount_
        End Function

        Public Sub MoveFirst()
                nIndex_ = 0
        End Sub

        Public Sub MoveLast()
                nIndex_ = nRecCount_
        End Sub

        Public Sub MoveNext()
                nIndex_ = nIndex_ + 1
        End Sub

        Public Function EOF()
                If nRecCount_ <= nIndex_ Then
                        EOF = True
                        Exit Function
                End If
                EOF = False
        End Function

        Public Function GetPos()
                GetPos = nIndex_
        End Function

        Public Function SetPos(nIndex)
                nIndex_ = nIndex
        End Function

        Public Sub Sort(strColumns, strType, strOrder)
                Dim strXsl
                Dim xmlXsl

                Set xmlXsl = CreateObject("MSXML2.DOMDocument.3.0")
                Call xmlXsl.loadXml(GetSortXSL(strColumns, strType, strOrder))

                Call xmlDoc_.transformnodetoObject(xmlXsl, xmlDoc_)

                Set xmlList_ = xmlDoc_.selectNodes("/NewDataSet/Table")
                Call MoveFirst()

                Set xmlXsl = Nothing
        End Sub

        Private Function GetSortXSL(strColumn, strType, strOrder)
                GetSortXSL = _
                        "<xsl:stylesheet version='1.0' xmlns:xsl='http://www.w3.org/1999/XSL/Transform'>" & _
                        "<xsl:output method='xml' indent='yes' omit-xml-declaration='yes'/>" & _
                        "<xsl:template match='/NewDataSet'>" & _
                        "<xsl:copy>" & _
                        "    <xsl:apply-templates select='*'>" & _
                        "         <xsl:sort select='" & strColumn & "' data-type='" & strType & "' order='" & strOrder & "' />" & _
                        "    </xsl:apply-templates>" & _
                        "</xsl:copy>" & _
                        "</xsl:template>" & _
                        "<xsl:template match='*'>" & _
                        "<xsl:copy>" & _
                        "     <xsl:copy-of select='*'/>" & _
                        "</xsl:copy>" & _
                        "</xsl:template>" & _
                        "</xsl:stylesheet>"
        End Function

End Class