%
SendOK()
If Not IsObject(Application(Dvbbs.CacheName & "_TextAdservices")) Then
SendData()
End If
Function strAnsi2Unicode(asContents)
Dim len1,i,varchar,varasc
strAnsi2Unicode = ""
len1=LenB(asContents)
If len1=0 Then Exit Function
For i=1 to len1
varchar=MidB(asContents,i,1)
varasc=AscB(varchar)
If varasc > 127 Then
If MidB(asContents,i+1,1)<>"" Then
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
End If
i=i+1
Else
strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
End If
Next
End Function
Sub SendOK()
Response.Clear
Response.CharSet="gb2312"
Response.ContentType="text/xml"
Response.Write ""&vbNewLine
Response.Write "OK"
Response.Flush
End Sub
Sub SendData()
Dim xmlhttp,xml,DataToSend,xmlserverurl
xmlserverurl="http://server.dvbbs.net/dvbbs/Dv_xmlservices.asp"
On Error Resume Next
Set xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP"&MsxmlVersion)
xmlhttp.setTimeouts 65000, 65000, 65000, 65000
xmlhttp.Open "POST",xmlserverurl,false
xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.send
Set XML=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
If XML.loadxml(strAnsi2Unicode(xmlhttp.responseBody)) Then
If Not Xml.documentElement Is Nothing Then
Set Application(Dvbbs.CacheName & "_TextAdservices")=Xml.cloneNode(true)
End If
End If
If Err Then
Set Application(Dvbbs.CacheName & "_TextAdservices")=Server.CreateObject("Msxml2.FreeThreadedDOMDocument" & MsxmlVersion )
Application(Dvbbs.CacheName & "_TextAdservices").appendChild( Application(Dvbbs.CacheName & "_TextAdservices").createElement("xml"))
Application(Dvbbs.CacheName & "_TextAdservices").documentElement.appendChild( Application(Dvbbs.CacheName & "_TextAdservices").createNode(1,"text","")).text=""
End If
Set xmlhttp = Nothing
End Sub
%>