'***函数名  : BaiduPing
'***函数说明: Baidu自动Ping
'***参数    : sArticleURL:    文章页地址
'***返回值  : 是否Ping成功(0-成功;1-不成功)
Public Function BaiduPing(sArticleURL)
    Dim sXMLContent
    Dim Http
    Dim sPostURL
    Dim sResponseValue
    Dim iBeginPlace, iEndPlace

    sXMLContent = "<?xml version=""1.0"" encoding=""" & sAppCharSet & """?>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "<methodCall>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "<methodName>weblogUpdates.extendedPing</methodName>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "    <params>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "        <param>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "            <value><string>天天开开心心吧</string></value>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "        </param>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "        <param>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "            <value><string>http://www.ttkkxx8.com/</string></value>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "        </param>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "        <param>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "            <value><string>http://www.ttkkxx8.com/html/140943.shtml</string></value>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "        </param>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "        <param>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "            <value><string>http://www.ttkkxx8.com/rss.xml</string></value>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "        </param>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "    </params>" & Chr(13) & Chr(10)
    sXMLContent = sXMLContent & "</methodCall>" & Chr(13) & Chr(10)

    Set Http = Server.CreateObject("Microsoft.XMLHTTP")
    If Err Then
        Set Http = Server.CreateObject("Msxml2.XMLHTTP")
        Err.Clear()
    End If

    sPostURL = "http://ping.baidu.com/ping/RPC2"
    sPostURL = sPostURL & "?t=" & Now()

    Http.Open "POST", sPostURL, False
    Http.setRequestHeader "Content-Type", "text/xml; charset=" & sAppCharSet
    Http.Send(sXMLContent)
    sResponseValue = BytesToBstr(Http.ResponseBody)
    Set Http = Nothing

    iBeginPlace = InStr(sResponseValue, "<int>")
    iEndPlace = InStr(sResponseValue, "</int>")
    sResponseValue = Mid(sResponseValue, iBeginPlace+5, iEndPlace-iBeginPlace-5)

    BaiduPing = sResponseValue
End Function



'***函数名  : BytesToBstr
'***函数说明: 编码格式处理
'***参数    : sBody:        需处理的内容
'***返回值  : 编码格式处理后的内容
Public Function BytesToBstr(sBody)
    Dim objStream
    Set objStream = Server.CreateObject("ADODB.Stream")
    objStream.Type = 1        '二进制模式
    objStream.Mode = 3
    objStream.Open
    objStream.Write sBody
    objStream.Position = 0
    objStream.Type = 2
    objStream.Charset = sAppCharset
    BytesToBstr = objStream.ReadText
    objStream.Close
    Set objStream = Nothing
End Function