本文发布的是用Asp开发的可以用来做采集与分析html代码的类,大家有兴趣可以参考,可以在此基础上能做出好多东东呢!
<%
Dim mySpider,MyConn,IsConnection
IsConnection = False
Set mySpider = New ClsProcess
Class ClsProcess
Private CacheName, Reloadtime, LocalCacheName, Cache_Data
Private MaxFileSize, sAllowExtName
Public PathFileName, blnPassedTest
Public PictureExist
‘– 下载大小限制
Public Property Let MaxSize(ByVal NewValue)
MaxFileSize = NewValue * 1024
End Property
‘– 下载类型限制
Public Property Let AllowExt(ByVal NewValue)
sAllowExtName = NewValue
End Property
Public Property Get PictureEx()
PictureEx = PictureExist
End Property
Public Property Get AllFileName()
AllFileName = PathFileName
End Property
Private Sub Class_Initialize()
On Error Resume Next
Reloadtime = 28800
CacheName = “mySpider”
blnPassedTest = False
PictureExist = False
MaxFileSize = 0
sAllowExtName = “gif|jpg|jpge|png|bmp|swf|fla|psd”
End Sub
Private Sub Class_Terminate()
‘– Class_Terminate
End Sub
‘===================服务器缓存部分函数开始===================
Public Property Let Name(ByVal vNewValue)
LocalCacheName = LCase(vNewValue)
Cache_Data = Application(CacheName & “_” & LocalCacheName)
End Property
Public Property Let Value(ByVal vNewValue)
If LocalCacheName <> “” Then
ReDim Cache_Data(2)
Cache_Data(0) = vNewValue
Cache_Data(1) = Now()
Application.Lock
Application(CacheName & “_” & LocalCacheName) = Cache_Data
Application.UnLock
Else
Err.Raise vbObjectError + 1, “NewaspCacheServer”, ” please change the CacheName.”
End If
End Property
Public Property Get Value()
If LocalCacheName <> “” Then
If IsArray(Cache_Data) Then
Value = Cache_Data(0)
Else
‘Err.Raise vbObjectError + 1, “NewaspCacheServer”, ” The Cache_Data(“&LocalCacheName&”) Is Empty.”
End If
Else
Err.Raise vbObjectError + 1, “NewaspCacheServer”, ” please change the CacheName.”
End If
End Property
Public Function ObjIsEmpty()
ObjIsEmpty = True
If Not IsArray(Cache_Data) Then Exit Function
If Not IsDate(Cache_Data(1)) Then Exit Function
If DateDiff(“s”, CDate(Cache_Data(1)), Now()) < (60 * Reloadtime) Then ObjIsEmpty = False
End Function
Public Sub DelCahe(MyCaheName)
Application.Lock
Application.Contents.Remove (CacheName & “_” & MyCaheName)
Application.UnLock
End Sub
‘===================服务器缓存部分函数结束===================
Public Function ChkBoolean(ByVal Values)
If TypeName(Values) = “Boolean” Or IsNumeric(Values) Or LCase(Values) = “false” Or LCase(Values) = “true” Then
ChkBoolean = CBool(Values)
Else
ChkBoolean = False
End If
End Function
Public Function CheckNumeric(ByVal CHECK_ID)
If CHECK_ID <> “” And IsNumeric(CHECK_ID) Then _
CHECK_ID = CCur(CHECK_ID) _
Else _
CHECK_ID = 0
CheckNumeric = CHECK_ID
End Function
Public Function ChkNumeric(ByVal CHECK_ID)
If CHECK_ID <> “” And IsNumeric(CHECK_ID) Then
CHECK_ID = CLng(CHECK_ID)
Else
CHECK_ID = 0
End If
ChkNumeric = CHECK_ID
End Function
Public Function CheckNull(ByVal str)
If Not IsNull(str) And Trim(str) <> “” Then
CheckNull = True
Else
CheckNull = False
End If
End Function
Public Function CheckStr(ByVal str)
If IsNull(str) Then
CheckStr = “”
Exit Function
End If
str = Replace(str, Chr(0), “”)
CheckStr = Replace(str, “‘”, “””)
End Function
Public Function CheckNostr(ByVal str)
str = Trim(str)
If Len(str) = 0 Then
CheckNostr = “”
Exit Function
End If
str = Replace(str, Chr(0), vbNullString)
str = Replace(str, Chr(9), vbNullString)
str = Replace(str, Chr(10), vbNullString)
str = Replace(str, Chr(13), vbNullString)
str = Replace(str, Chr(34), vbNullString)
str = Replace(str, Chr(39), vbNullString)
str = Replace(str, Chr(255), vbNullString)
str = Replace(str, “%”, “%”)
CheckNostr = Trim(str)
End Function
Public Function CheckNullStr(ByVal str)
If Not IsNull(str) And Trim(str) <> “” And LCase(str) <> “http://” Then
CheckNullStr = Trim(Replace(Replace(Replace(Replace(str, vbNewLine, “”), Chr(9), “”), Chr(39), “”), Chr(34), “”))
Else
CheckNullStr = “”
End If
End Function
Public Function CheckMapPath(ByVal strPath)
On Error Resume Next
Dim fullPath
strPath = Replace(Replace(Trim(strPath), “//”, “/”), “\”, “”)
If strPath = “” Then strPath = “.”
If InStr(strPath, “:”) = 0 Then
strPath = Replace(Trim(strPath), “”, “/”)
fullPath = Server.MapPath(strPath)
Else
strPath = Replace(Trim(strPath), “/”, “”)
fullPath = Trim(strPath)
End If
If Right(fullPath, 1) <> “” Then fullPath = fullPath & “”
CheckMapPath = fullPath
End Function
Public Function ChkMapPath(ByVal strPath)
On Error Resume Next
Dim fullPath
strPath = Replace(Replace(Trim(strPath), “//”, “/”), “\”, “”)
If strPath = “” Then strPath = “.”
If InStr(strPath, “:”) = 0 Then
strPath = Replace(Trim(strPath), “”, “/”)
fullPath = Server.MapPath(strPath)
Else
strPath = Replace(Trim(strPath), “/”, “”)
fullPath = Trim(strPath)
End If
If Right(fullPath, 1) <> “” Then fullPath = fullPath & “”
fullPath = Left(fullPath, Len(fullPath) – 1)
ChkMapPath = fullPath
End Function