Dim Url,List_PageCode,Array_ArticleID,i,ArticleID Dim Content_PageCode,Content_TempCode Dim Content_CategoryID,Content_CategoryName,BorderID,ClassID,BorderName,ClassName Dim ArticleTitle,ArticleAuthor,ArticleFrom,ArticleContent
Function getHTTPPage(url) IF(IsObjInstalled("Microsoft.XMLHTTP") = False)THEN Response.Write "<br><br>服务器不支持Microsoft.XMLHTTP组件" Err.Clear Response.End END IF On Error Resume Next Dim http SET http=Server.CreateObject("Msxml2.XMLHTTP") Http.open "GET",url,False Http.send() IF(Http.readystate<>4)THEN Exit Function END IF getHTTPPage=BytesToBSTR(Http.responseBody,"GB2312") SET http=NOTHING IF(Err.number<>0)THEN Response.Write "<br><br>获取文件内容出错" 'Response.End Err.Clear END IF End Function
Function BytesToBstr(CodeBody,CodeSet) Dim objStream SET objStream = Server.CreateObject("adodb.stream") objStream.Type = 1 objStream.Mode =3 objStream.Open objStream.Write CodeBody objStream.Position = 0 objStream.Type = 2 objStream.Charset = CodeSet BytesToBstr = objStream.ReadText objStream.Close SET objStream = NOTHING End Function
'================================================ '作 用:检查组件是否已经安装 '返回值:True ----已经安装 ' False ----没有安装 '================================================ Function IsObjInstalled(objName) On Error Resume Next IsObjInstalled = False Err = 0 Dim testObj SET testObj = Server.CreateObject(objName) IF(0 = Err)THEN IsObjInstalled = True SET testObj = NOTHING Err = 0 End Function
Function RegExpText(strng,strStart,strEnd,n) Dim regEx,Match,Matches,RetStr SET regEx = New RegExp regEx.Pattern = strStart&"([/s/S]*?)"&strEnd regEx.IgnoreCase = True regEx.Global = True SET Matches = regEx.Execute(strng) For Each Match in Matches IF(n=1)THEN RetStr = RetStr & regEx.Replace(Match.Value,"$1") & "," ELSE RetStr = RetStr & regEx.Replace(Match.Value,"$1") END IF Next RegExpText = RetStr SET regEx=NOTHING End Function