<% Function OpenURL(url) on error resume next Dim obj, BytesStream Set obj = Server.CreateObject("Msxml2.ServerXMLHTTP") Call obj.Open("GET", url, False) Call obj.send Set BytesStream = Server.CreateObject("ADODB.Stream") BytesStream.Type = 2 BytesStream.Open BytesStream.WriteText obj.ResponseBody BytesStream.Position = 0 BytesStream.Charset = "GB2312" BytesStream.Position = 2 OpenURL = BytesStream.ReadText BytesStream.Close Set BytesStream = Nothing Set obj = Nothing If Err.Number<>0 Then OpenURL = "err:"&Err.Description Err.Clear Set Err = Nothing End If End Function Function PostURL(url, SendData) on error resume next Dim obj, BytesStream Set obj = CreateObject("Msxml2.ServerXMLHTTP") obj.Open "POST", url, False obj.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" obj.setRequestHeader "Content-Length", Len(SendData) obj.send(URLEncoding(SendData)) Set BytesStream = CreateObject("ADODB.Stream") BytesStream.Type = 2 BytesStream.Open BytesStream.WriteText obj.ResponseBody BytesStream.Position = 0 BytesStream.Charset = "GB2312" BytesStream.Position = 2 PostURL = BytesStream.ReadText BytesStream.Close Set BytesStream = Nothing Set obj = Nothing If Err.Number<>0 Then PostURL = "err:"&Err.Description Err.Clear Set Err = Nothing End If End Function 'GB编码转换 Function URLEncoding(vstrIn) strReturn = "" For i = 1 To Len(vstrIn) ThisChr = Mid(vStrIn, i, 1) If Abs(Asc(ThisChr)) < &HFF Then strReturn = strReturn & ThisChr Else innerCode = Asc(ThisChr) If innerCode < 0 Then innerCode = innerCode + &H10000 End If Hight8 = (innerCode And &HFF00) / &HFF Low8 = innerCode And &HFF strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8) End If Next URLEncoding = strReturn End Function %>