20CN网络安全小组论坛 - 网站建设 - 大家帮我看下这段代码，有没有病毒，如果有请指出怎么修改！

论坛: 网站建设标题: 大家帮我看下这段代码，有没有病毒，如果有请指出怎么修改！

作者: joy1984 [joy1984]

论坛用户

<%
Function GetPageContent(Url)
Dim HTTPObj
On Error Resume Next
Set HTTPObj = Server.CreateObject("Microsoft.XMLHTTP")
With HTTPObj
.Open "Get", Url, False, "", ""
.Send
End With
if HTTPObj.Readystate <> 4 then
Set HTTPObj = Nothing
GetPageContent = False
Exit Function
end if
GetPageContent = ResponseStrToStr(HTTPObj.ResponseBody)
Set HTTPObj = Nothing
End Function

Function ResponseStrToStr(BodyStr)
Dim ADOStreamObj
Set ADOStreamObj = Server.CreateObject("ADODB.Stream")
ADOStreamObj.Type = 1
ADOStreamObj.Mode = 3
ADOStreamObj.Open
ADOStreamObj.Write BodyStr
ADOStreamObj.Position = 0
ADOStreamObj.Type = 2
ADOStreamObj.Charset = "GB2312"
ResponseStrToStr = ADOStreamObj.ReadText
ADOStreamObj.Close
Set ADOStreamObj = Nothing
End Function

Function GetContent(Str,StartStr,LastStr,Flag)
Dim SearchIndex
On Error Resume Next
if Instr(LCase(Str),LCase(StartStr)) > 0 then
Select Case Flag
Case 0
GetContent = Right(Str,Len(Str) - Instr(LCase(Str),LCase(StartStr)) - Len(StartStr) + 1)
SearchIndex = Instr(LCase(GetContent),LCase(LastStr))
if SearchIndex <= 0 then
GetContent = ""
else
GetContent = Left(GetContent,SearchIndex - 1)
end if
Case 1
GetContent = Right(Str,Len(Str) - Instr(LCase(Str),LCase(StartStr)) + 1)
GetContent = Left(GetContent,Instr(LCase(GetContent),LCase(LastStr)) + Len(LastStr) - 1)
Case 2
GetContent = Right(Str,Len(Str) - Instr(lcase(Str),LCase(StartStr))-Len(StartStr) + 1)
Case else
GetContent = ""
End Select
else
GetContent = ""
end if
if Err.Number <> 0 then GetContent = ""
End Function

Function LoseHtml(ContentStr)
Dim ClsTempLoseStr,regEx
ClsTempLoseStr = Cstr(ContentStr)
Set regEx = New RegExp
regEx.Pattern = "<\/*[^<>]*>"
regEx.IgnoreCase = True
regEx.Global = True
ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"")
Set regEx = Nothing
LoseHtml = ClsTempLoseStr
End function

Function ReplaceRemoteUrl(NewsContent,SaveFilePath)
Dim re,RemoteFile,RemoteFileurl,SaveFileName,FileName,FileExtName
Set re = New RegExp
re.IgnoreCase = True
re.Global=True
're.Pattern = "<img\/*[^<>]*>"
re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(gif|jpg|png|bmp)))"
Set RemoteFile = re.Execute(NewsContent)
Set re = Nothing
For Each RemoteFileurl in RemoteFile
SaveFileName = Mid(RemoteFileurl,InstrRev(RemoteFileurl,"/")+1)
FileExtName = Mid(SaveFileName,InstrRev(SaveFileName,".")+1)
Call SaveRemoteFile(SaveImagePath & "/" & SaveFileName,RemoteFileurl)
NewsContent = Replace(NewsContent,RemoteFileurl,SaveImagePath & "/" & SaveFileName)
Next
ReplaceRemoteUrl = NewsContent
End Function

Sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
Dim StreamObj,Retrieval,GetRemoteData
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", RemoteFileUrl, False, "", ""
.Send
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
Set StreamObj = Server.CreateObject("Adodb.Stream")
With StreamObj
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile Server.MapPath(LocalFileName),2
.Cancel()
.Close()
End With
Set StreamObj = Nothing
End Sub

Function GetRandomID18()
Dim TempYear,TempMonth,TempDay,TempHour,TempMinute,TempSecond,RandomFigure
Dim TempStr,NowTime
NowTime = Now()
TempYear = Right(CStr(Year(NowTime)),2)
TempMonth = CStr(Month(NowTime))
if Len(TempMonth) = 1 then
TempHour = "0" & TempMonth
end if
TempDay = CStr(Day(NowTime))
if Len(TempDay) = 1 then
TempHour = "0" & TempDay
end if
TempSecond = CStr(Second(NowTime))
if Len(TempSecond) = 1 then
TempSecond = "0" & TempSecond
end if
Randomize
RandomFigure = CStr(Int((99999 * Rnd) + 1))
GetRandomID18 = TempYear & TempMonth & TempDay & TempHour & TempMinute & TempSecond & RandomFigure
End Function

Function FormatUrl(NewsLinkStr,SiteUrl)
NewsLinkStr = Replace(Replace(NewsLinkStr,"'",""),"""","")
if InStr(NewsLinkStr,"http://") = 0 then
if InStrRev(NewsLinkStr,"..") = 0 then
FormatUrl = SiteUrl & NewsLinkStr
else
FormatUrl = SiteUrl & Mid(NewsLinkStr,InStrRev(NewsLinkStr,"..")+2)
end if
else
FormatUrl = NewsLinkStr
end if
End Function
%>

地主发表时间: 06-02-08 17:16