XXX档案美女图片站适合给图片广告的站长下载使用

								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 									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 = ""
					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
					TempHour = CStr(Hour(NowTime))
					if Len(TempHour) = 1 then
						TempHour = "0" & TempHour
					end if
					TempMinute = CStr(Minute(NowTime))
					if Len(TempMinute) = 1 then
						TempMinute = "0" & TempMinute
					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
				%>