www.gusucode.com > 淘乐网源码 2.0源码程序 > funcc.asp
<% function Geturl(url) dim Http set Http=server.createobject("MSXML2.XMLHTTP") 'set Http=server.createobject("Microsoft.Xmlhttp") Http.open "GET",url,false Http.send() if Http.readystate<>4 then exit function end if Geturl=bytesToBSTR(Http.responseBody,"GB2312") set http=nothing if err.number<>0 then err.Clear end Function Function BytesToBstr(body,Cset) dim objstream s="stream" set objstream = Server.CreateObject("adodb."&s) objstream.Type = 1 objstream.Mode =3 objstream.Open objstream.Write body objstream.Position = 0 objstream.Type = 2 objstream.Charset = Cset BytesToBstr = objstream.ReadText objstream.Close set objstream = nothing End Function Function ReplaceTrim(ByVal strContent) On Error Resume Next Dim re Set re = New RegExp re.IgnoreCase = True re.Global = True re.Pattern = "(" & Chr(8) & "|" & Chr(9) & "|" & Chr(10) & "|" & Chr(13) & ")" strContent = re.Replace(strContent, vbNullString) Set re = Nothing ReplaceTrim = strContent Exit Function End Function Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR) If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True Or OverStr="" or IsNull(OverStr)=True Then GetBody="$False$" Exit Function End If Dim ConStrTemp Dim Start,Over ConStrTemp=Lcase(ConStr) StartStr=Lcase(StartStr) OverStr=Lcase(OverStr) Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare) If Start<=0 then GetBody="$False$" Exit Function Else If IncluL=False Then Start=Start+LenB(StartStr) End If End If Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare) If Over<=0 Or Over<=Start then GetBody="$False$" Exit Function Else If IncluR=True Then Over=Over+LenB(OverStr) End If End If GetBody=MidB(ConStr,Start,Over-Start) End Function %>