Asp开发的可以用来做采集与分析html代码的类
本文发布的是用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)=0Then
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,":")=0Then
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,":")=0Then
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