一个比较使用的asp 函数集合类

最近迷恋上作网站了，使用asp开发，发现asp有好多的漏洞，而且在一个网站中有好多的代码是重复使用的，所以就查询了一些资料发现在asp中可以使用类的思想，所以就写了这个类，写的不好，但是比较实用。

Class clsDSJ
Private p_Error,p_IpAdd,p_Debug,Errs
Private p_InvaildWords
Private tmpStr
Private objConnDivPage,rsDivPage,p_GetSQL,p_nPage
Private p_rsPageSize,p_intCurPage,p_strURL,p_intTotalPage,p_intTotalRecords
Private p_dbType,p_dbFolder,p_DataBase,dbPath,p_dbUserID,p_dbPassword,p_sqlDataSource
Private param_DataBase,param_dbUserID,param_dbPassword,param_dbType
'Property
Public objConn,ConnStr,SQLQueryNum
Public logDB,WebURL
Public SaveLog
Public ErrCodes,ErrCode,ErrMsg
Public ScriptFolder,ScriptName

Private Sub Class_Initialize
 p_Debug=True
 ClientConnected
 SaveLog=True
 ErrMsg=""
 p_Error=0
 SQLQueryNum=0
 Rem 数据库连接初始化
 dbType=12 '取1x——Access，2x——SQL;x1——OLEDB，x2——ODBC
 dbFolder="Data"
 DataBase="zhubizidatabase.MDB"
 dbUserID=""
 dbPassword=""
 sqlDataSource=""
 p_rsPageSize=10
 'p_nPage=2
 If request("page")="" Then
 p_intCurPage=1
 ElseIf NOT IsNumeric(request("page")) Then
 p_intCurPage=1
 ElseIf CInt(Trim(request("page")))<1 Then
 p_intCurPage=1
 Else
 p_intCurPage=CInt(Trim(request("page")))
 End If
 WebURL="http://blog.csdn.net/alonesword/"
 tmpStr=Request.ServerVariables("PATH_INFO")
 tmpStr=Split(tmpStr,"/",-1)
 ScriptName=Lcase(tmpStr(UBound(tmpStr)))
 ScriptFolder=LCase(tmpStr(UBound(tmpStr)-1)) & "/"
 p_InvaildWords="select|update|delete|insert|@|--|;|'|#|%|xp|cmd|shell"
End Sub

Private Sub Class_terminate()
 If IsObject(rsDivPage) Then rsDivPage.Close:Set rsDivPage=Nothing
 If IsObject(objConn) Then objConn.Close:Set objConn=Nothing
End Sub

Public Property Get Version
 Version="DSJ 1.1.0 Beta"
End Property

Public Property Get Error
 Error=p_Error
End Property

Public Property Get Debug
 Debug=p_Debug
End Property
Public Property Let Debug(BoolDebug)
 If BoolDebug Then
 p_Debug=True
 Else
 p_Debug=False
 End If
End Property

Public Property Get dbType
 dbType=p_dbType
End Property
Public Property Let dbType(lngdbType)
 If IsNumeric(lngdbType) Then
 p_dbType=lngdbType
 Else
 p_dbType=12
 End If
End Property

Public Property Get dbFolder
 dbFolder=p_dbFolder
End Property
Public Property Let dbFolder(strFolder)
 If Right(strFolder,1)="/" OR Right(strFolder,1)="/" Then
 p_dbFolder=strFolder
 Else
 If (NOT IsNull(strFolder)) OR (strFolder<>"") Then
 p_dbFolder=strFolder & "/"
 Else
 p_dbFoler=""
 End If
 End If
End Property

Public Property Get Database
 Database=p_dataBase
End Property
Public Property Let Database(strDataBase)
 p_dataBase=strDatabase
End Property

Public Property Get dbUserID
 dbUserID=p_dbUserID
End Property
Public Property Let dbUserID(strDataBaseUserID)
 p_dbUserID=strDataBaseUserID
End Property

Public Property Get dbPassword
 dbPassword=p_dbPassword
End Property
Public Property Let dbPassword(strDataBasePassword)
 p_dbPassword=strDataBasePassword
End Property

Public Property Get SQLDataSource
 SQLDataSource=p_sqlDataSource
End Property
Public Property Let SQLDataSource(strSQLDataSource)
 If strsqlDataSource<>"" Then
 If Left(p_dbType,1)=2 Then
 p_sqlDataSource=strSQLDataSource
 Else
 AddErrorCode(110)
 p_sqlDataSource=""
 End If
 End If
End Property

Public Property Let PageSize(int_PageSize)
 If IsNumeric(Int_Pagesize) Then
 p_rsPageSize=CLng(int_PageSize)
 End If
End Property
Public Property Get PageSize
 If p_rsPageSize="" or NOT IsNumeric(p_rsPageSize) Then
 PageSize=8
 Else
 PageSize=p_rsPageSize
 End If
End Property

Public Property Get GetRs()
 If NOT Debug Then On Error Resume Next
 If NOT IsObject(objConn) Then ConnectionDataBase dbDataBase,dbUserID,dbPassword,dbType
 If NOT IsObject(rsDivPage) Then
 Set rsDivPage=Server.createobject("adodb.recordset")
 rsDivPage.Open GetSQL,objConn,1,1
 rsDivPage.PageSize=PageSize
 If not(rsDivPage.eof and rsDivPage.BOF) Then
 If p_intCurPage>rsDivPage.PageCount Then
 p_intCurPage=rsDivPage.PageCount
 End If
 rsDivPage.AbsolutePage=p_intCurPage
 End If
 If Err Then
 Err.Clear
 rsDivPage.Close
 Set rsDivPage=Nothing
 If SaveLog Then
 tmpMsg="连接数据库错误，请检查您的查询代码是否正确。 基于安全的理由，只显示本信息，要查看详细的错误信息，请设置dsj.Debug=True"
 Response.Write SaveSQLLog(cmd,tmpMsg)
 Else
 Response.Write "连接数据库错误，请检查您的查询代码是否正确。"
 End If
 Response.End()
 End If
 SQLQueryNum=SQLQueryNum+1
 Set GetRs=rsDivPage
 End If
End Property

Public Property Let GetSQL(str_sql)
 If str_sql<>"" Then
 p_GetSQL=str_sql
 Else
 AddErrorCode(111)
 If Debug Then ShowErrMsg()
 p_GetSQL="The Property of GetSQL is NULL."
 End If
End Property
Public Property Get GetSQl()
 GetSQL=p_GetSQL
End Property

'******************************
'名称: gotTopic
'参数:str,strlen
'返回值：被限制后的字符串
'创建时间:2005年3月3日
'作用:限制被限制的字符串
'******************************
Public Function GotToPic(str,strlen)
 Rem 限制字符串显示长度在一定的范围内
 Dim i,StringLen,CharSize,EchoCharType
 StringLen=len(str)
 CharSize=0
 For i=1 to StringLen
 EchoCharType=Abs(Asc(Mid(str,i,1)))
 If EchoCharType>255 Then
 CharSize=CharSize+2
 Else
 CharSize=CharSize+1
 End If
 If CharSize>strlen Then
 gotTopic=Left(str,i) & "..."
 Exit For
 Else
 gotTopic=str & ""
 End If
 Next
End Function

'******************************
'名称: ChkInvStr
'参数:Str
'返回值：True/False
'创建时间:2005年5月2日
'作用:检查参数是否有非法字符
'******************************
Public Function ChkInvStr(Str)
 Rem 定义需要过滤得非法字符
 Dim InvaildWord,inWords,i
 Str=CStr(Str)
 ChkInvStr=False
 If Len(Replace(p_InvaildWords,Chr(0),""))<1 Then
 AddErrorCode(103) 'invaildwords is null
 Exit Function
 Else
 If Instr(1,p_Invaildwords,"|")>0 Then
 InvaildWord=Split(p_InvaildWords,"|")
 inWords=LCase(Trim(Str))
 For i=LBound(InvaildWord) To UBound(InvaildWord)
 If Instr(inWords,InvaildWord(i))>0 Then
 p_Error=1982
 AddErrorCode(105)
 ChkInvStr=True
 Exit Function
 End If
 Next
 Else
 AddErrorCode(104) '"|" is requried.
 Exit Function
 End If
 End If
End Function

'******************************
'名称: GetIP
'参数:NULL
'返回值：NULL
'创建时间:2005年5月3日
'作用:得到用户的ip地址
'******************************
Public Function GetIP()
 p_IpAdd=Request.ServerVariables("HTTP_X_FORWARDED_FOR")
 If IsNull(p_IpAdd) OR p_IpAdd="" Then
 p_IpAdd=Request.ServerVariables("REMOTE_ADDR")
 End If
 GetIp=p_IpAdd
End Function

'******************************
'名称: IPAddress
'参数:sip
'返回值：County,City
'作用:对数据内容进行排版转换
'创建时间:2005年5月6日
'来源：动网
'******************************
Public Function IPAddress(sip)
 Dim IPConnStr,IPConn,IPAddressDB
 Dim str1,str2,str3,str4
 Dim num
 Dim country,city,address
 Dim IPRs,SQL
 address="未知"
 If IsNumeric(Left(sip,2)) Then
 If sip="127.0.0.1" Then sip="192.168.0.1"
 str1=Left(sip,InStr(sip,".")-1)
 sip=mid(sip,instr(sip,".")+1)
 str2=Left(sip,instr(sip,".")-1)
 sip=Mid(sip,InStr(sip,".")+1)
 str3=Left(sip,instr(sip,".")-1)
 str4=Mid(sip,instr(sip,".")+1)
 If isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 Then
 Else
 num=CLng(str1)*16777216+CLng(str2)*65536+CLng(str3)*256+CLng(str4)-1
 IPAddressDB = "DSJ_Ipaddress.mdb"
 IPConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(p_dbFolder & IPAddressDB)
 Set IPConn = Server.CreateObject("ADODB.Connection")
 IPConn.Open IpConnStr
 country="亚洲"
 city=""
 sql="select top 1 country,city from DSJ_IPAddress where ip1 <="&num&" and ip2 >="&num&""
 Set IPRs=IPConn.execute(sql)
 If Not(IPRs.EOF And IPRs.bof) Then
 country=IPRs(0)
 city=IPRs(1)
 End If
 IpRs.Close:Set IPRs=Nothing
 IPConn.CLose:Set IPConn = Nothing
 SqlQueryNum = SqlQueryNum+1
 End If
 IPAddress=country&city
 End If
End Function

'******************************
'名称: ClientConnected
'参数:NULL
'返回值：NULL
'创建时间:2005年5月5日
'作用:得到用户是否与服务器连接
'******************************
Public Sub ClientConnected()
 If Response.IsClientConnected then
 Response.Flush()
 Else
 Response.End()
 End If
End Sub

'******************************
'名称: ChkPost
'参数:NULL
'返回值：True/False
'创建时间:2005年5月5日
'作用:检查被提交的数据来源
'******************************
Public Function ChkPost()
 Dim Server_v1,Server_v2
 ChkPost=False
 Server_v1=CStr(Request.ServerVariables("HTTP_REFERER"))
 Server_v2=CStr(Request.ServerVariables("SERVER_NAME"))
 If Mid(Server_v1,8,Len(Server_v2))=Server_v2 Then ChkPost=True
End Function

'******************************
'名称: AddErrorCode
'参数:ErrCode
'返回值：ErrCodes
'创建时间:2005年5月3日
'作用:添加错误代码到ErrCodes中
'******************************
Public Sub AddErrorCode(ErrCode)
 If ErrCodes="" Then
 ErrCodes=ErrCode
 Else
 ErrCodes=ErrCodes & "," & ErrCode
 End If
End Sub

'******************************
'名称: ShowErrMsg
'参数:NULL
'返回值：NULL
'创建时间:2005年5月3日
'作用:显示详细的错误信息
'******************************
Public Function ShowErrMsg()
 If NOT p_Debug Then On Error Resume Next
 If ErrCodes<>"" Then
 iErrCodes=Split(ErrCodes,",",-1,Binary)
 For i=LBound(iErrCodes) To UBound(iErrCodes)
 tmpErrCode=CLng(iErrCodes(i))
 If IsNumeric(tmpErrCode) Then
 ErrMsg=ErrMsg & ErrDetails(tmpErrCode)
 End If
 Next
 End If
 ShowErrMsg=ErrMsg
End Function

'******************************
'名称: ConnectionDataBase
'参数:DataBase,p_dbUserID,p_dbPassword,p_dbType
'返回值：NULL
'作用:连接到数据库
'创建时间:2005年5月6日
'******************************
Public Function ConnectionDataBase(param_DataBase,param_dbUserID,param_dbPassword,param_dbType)
 If Not p_Debug Then On Error Resume Next
 ClientConnected
 If IsNumeric(param_dbType) Then
 Set objConn=Server.CreateObject("ADODB.Connection")
 objConn.ConnectionTimeOut=10 '设置连接超时为10秒
 dbPath=Server.MapPath(p_dbFolder&param_DataBase)
 'Response.Write dbPath
 Select Case param_dbType
 Case 11: 'Access Data Base(OLEDB)
 ConnStr="Provider=Microsoft.Jet.Oledb.4.0;Data Source="&dbPath&";User ID="&param_dbUserID&";Password="&param_dbPassword&""
 Case 21: 'SQL Server (OLEDB)
 ConnStr="Provider=SQLOLEDB;Initial Catalog="&param_DataBase&";Data Source="&p_sqlDataSource&";User ID="&param_dbUserID&";Password="&param_dbPassword&""
 Case 12: 'Access Data Base(ODBC)
 ConnStr="Driver={Microsoft Access Driver (*.mdb)};DBQ="&dbPath&";User ID="&param_dbUserID&";Password="&param_dbPassword
 Case 22: 'SQL Server (ODBC)
 ConnStr="Driver={SQL Server};DataBase="&param_DataBase&";Server="&p_sqlDataSource&";User ID="&param_dbUserID&";Password="&param_dbPassword&""
 Case Else:
 AddErrorCode(100)
 If p_Debug Then Response.Write ShowErrMsg()
 'Exit Function
 End Select
 objConn.ConnectionString=ConnStr
 objConn.Open
 Set ConnectionDataBase=objConn
 If Err Then
 Err.Clear

 If SaveLog Then
 tmpMsg="数据库连接时出现错误，请检查您的查询代码是否正确。 基于安全的理由，只显示本信息，要查看详细的错误信息，请设置dsj.Debug=True"
 cmd="Execute the command of :"&param_dbtype
 Response.Write SaveSQLLog(cmd,tmpMsg)
 Else
 Response.Write "数据库连接时出现错误，请检查您的查询代码是否正确。"
 End If
 AddErrorCode(101)
 Set objConn=Nothing
 Response.End()
 End If
 End If
End Function

'******************************
'名称: SaveSQLLog
'参数:sCommand,Msg
'返回值：msg
'作用:存储日志
'创建时间:2005年5月6日
'******************************
Public Function SaveSQLLog(sCommand,Msg)
 If Not p_Debug Then On Error Resume Next
 logDB="DSJ_SQLLog.mdb"
 'ConnectionDataBase logDB,p_dbUserID,p_dbPassword,12
 logConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(p_dbFolder & logDB)
 Set logConn = Server.CreateObject("ADODB.Connection")
 logConn.Open logConnStr
 If SaveLog Then
 Dim logCmd
 logCmd="INSERT INTO DSJ_SQL_Log (Command,ScriptName,logUser,IP) VALUES "
 logCmd=logCmd & "('" & Replace(Left(sCommand,255),"'","''") &"','" & (ScriptFolder & ScriptName) &"','" & Session("User") & "','"& GetIP & "')"
 'Response.Write "Need to execute command is: " & logCmd & " "
 logConn.Execute(logCmd)
 End If
 logConn.Close
 Set logConn=Nothing
 SaveSQLLog=msg
 SQLQueryNum=SQLQueryNum+1
End Function

'******************************
'名称: ExecuteCmd
'参数:cmd
'返回值：RecordSet
'作用:返回由cmd创建的记录集
'创建时间:2005年5月6日
'******************************
Public Function ExecuteCmd(cmd)
 If NOT IsObject(objConn) Then ConnectionDataBase p_DataBase,p_dbUserID,p_dbPassword,p_dbType
 If NOT p_Debug Then On Error Resume Next
 ClientConnected
 Set ExecuteCmd=objConn.Execute(cmd)
 If Err Then
 Err.Clear
 objConn.Close
 Set objConn=Nothing
 If SaveLog Then
 tmpMsg="查询数据的时候发现错误，请检查您的查询代码是否正确。 基于安全的理由，只显示本信息，要查看详细的错误信息，请设置dsj.Debug=True"
 Response.Write SaveSQLLog(cmd,tmpMsg)
 Else
 Response.Write "查询数据的时候发现错误，请检查您的查询代码是否正确。"
 End If
 Response.End()
 End If
 SQLQueryNum=SQLQueryNum+1
End Function

'******************************
'名称: HTMLEncode
'参数:fString
'返回值：HTMLEncode
'作用:对数据内容进行排版转换
'创建时间:2005年5月6日
'******************************
Public Function HTMLEncode(fString)
 If Not IsNull(fString) Or fString<>"" Then
 fString=Replace(fString,"<","<")
 fString=Replace(fString,">",">")
 fString=Replace(fString,Chr(9)," ") '倾斜字体
 fString=Replace(fString,Chr(13),"")
 fString=Replace(fString,Chr(32)," ") '转换空格
 fString=Replace(fString,Chr(34),""") '转换双引号
 fString=Replace(fString,Chr(39),"'") '转换单引号
 fString=Replace(fString,Chr(10),"") '转换成段落格式
 fString=Replace(fString,Chr(10),"     ") '转换为下一行
 fString=Replace(fString,Chr(13)," ")
 fString=Replace(fSting,vbCrlf," ")
 'fString=LinkFriend(fString)
 'fString=ChkBadWords(fString)
 HTMLEncode=fString
 End If
End Function

'******************************
'名称: LinkFriend
'参数:fContent
'返回值：LinkFriend
'作用:进行友情连接替换
'创建时间:2005年5月6日
'******************************
Public Function LinkFriend(fContent)
 If NOT p_Debug Then On Error Resume Next
 If NOT IsObject(objConn) Then ConnectionDataBase DataBase,dbUserID,dbPassword,dbType
 Set rsFriend=ExecuteCmd("Select Title,URL From dsj_FriendLink")
 If rsFriend.Eof And rsFriend.Bof Then
 Else
 Do While NOT rsFriend.Eof
 strTitle=rsFriend.Fields.Item("Title")
 URl=rsFriend.Fields.Item("URL")
 If LCase(Left(URL,1))<>"h" Then URL=Replace(URl,Left(URL,1),"")
 strLink="<a target='_blank' title='" & strTitle &"' href='" & URL & "'>"
 strLink=strLink&strTitle&"</a>"
 If Instr(fContent,strTitle)>0 Then fContent=Replace(fContent,strTitle,strLink)
 rsFriend.MoveNext
 Loop
 LinkFriend=fContent
 End If
 rsFriend.Close
 Set rsFriend=Nothing
 SQLQueryNum=SQLQueryNum+1
End Function

'******************************************************************************************
'名称: ShowPage
'参数:NULL
'返回值：NULL
'作用:显示经过分页后的记录导航
'说明：
' 原作：zykj2000 网站：http://bbs.513soft.net
' 修改：孤剑 网站：http://blog.csdn.net/alonesword/
'时间:2005年5月7日
'******************************************************************************************
Public Sub ShowPage()
 Dim str_tmp
 p_intTotalRecords=rsDivPage.RecordCount
 If p_intTotalRecords<=0 Then
 p_Error=p_Error & "总记录数为零，请输入数据"
 Call ShowError()
 End If
 If p_intTotalRecords <=PageSize THen
 p_intTotalPage=1
 Else
 If p_intTotalRecords mod PageSize =0 Then
 p_intTotalPage = CLng(p_intTotalRecords / PageSize * -1)*-1
 Else
 p_intTotalPage = CLng(p_intTotalRecords / PageSize * -1)*-1+1
 End If
 End If
 If p_intCurPage>p_intTotalPage Then
 p_intCurPage=p_intTotalPage
 End If
 Response.Write ShowFirstPrv
 showNumBtn
 Response.Write ShowNextLast&" "
 Response.Write ShowPageInfo
 response.write str_tmp
End Sub

Private Function ShowFirstPrv()
 Dim Str_tmp,int_prvpage
 int_prvpage=p_intCurPage-1
 If int_prvpage<1 Then int_prvpage=1
 Btn_FirstLink="<a title='第1页' href='"&AddnPageURL&"1'>"&Btn_First
 Btn_PrevLink="<a title='第"&int_prvpage&"页' href='"&AddnPageURL&p_intCurPage-1&"'>"&Btn_Prev
 If p_intCurPage=1 Then
 str_tmp=Btn_FirstLink&"</a> "&Btn_PrevLink&"</a> "
 Else
 int_prvpage=p_intCurPage-1
 str_tmp=""&Btn_FirstLink&"</a> "& Btn_PrevLink&"</a> "
 End If
 ShowFirstPrv=str_tmp
End Function

Private Function ShowNextLast()
 Dim str_tmp,int_Nextpage
 int_NextPage=p_intCurPage+1
 If p_intCurPage+1>p_intTotalPage Then int_NextPage=p_intTotalPage
 Btn_NextLink="<a title='第"&int_NextPage&"页' href='"&AddnPageURL&p_intCurPage+1&"'>"&Btn_Next
 Btn_LastLink="<a title='第"&p_intTotalPage&"页' href='"&AddnPageURL&p_intTotalPage&"'>"&Btn_Last
 If p_intCurPage>=p_intTotalPage Then
 str_tmp=Btn_NextLink & "</a> " & Btn_LastLink&"</a>"
 Else
 Int_NextPage=p_intCurPage+1
 str_tmp=""&Btn_NextLink&"</a> "& Btn_LastLink&"</a>"
 End If
 ShowNextLast=str_tmp
End Function

Private Function showNumBtn()
 Dim i,str_tmp
 Dim PageLink
 str_tmp=""
 For i=1 to p_intTotalPage Step 1
 PageLink=" <a title='第"&i&"页' href='"&AddnPageURL&i&"'>"&i&"</a> "
 If i=p_intCurPage Then PageLink=" <a title='第"&i&"页' href='"&AddnPageURL&i&"'>"&i&"</a> "
 Response.Write PageLink
 Next
 showNumBtn=str_tmp
End Function

Private Function ShowPageInfo()
  Dim str_tmp
  str_tmp="页次:"&p_intCurPage&"/"&p_intTotalPage&"页共"&p_intTotalRecords&"条记录 "&p_rsPageSize&"条/每页"
  ShowPageInfo=str_tmp
End Function

Private Function AddnPageURL()
  Dim i,j,search_str,result_url
  search_str="page="
  str_params=Request.ServerVariables("QUERY_STRING")
  If str_params="" Then
   result_url=ScriptName & "?page="
  Else
   If InstrRev(str_params,search_str)=0 Then
    result_url=ScriptName & "?" & str_params &"&page="
   Else
    j=InstrRev(str_params,search_str)-2
    If j=-1 Then
     result_url=ScriptName & "?page="
    Else
     str_params=Left(str_params,j)
     result_url=ScriptName & "?" & str_params &"&page="
    End If
   End If
  End If
  AddnPageURL=result_url
End Function
'******************************************************************************************

Public Function GetName(Options)
  Dim tmpName
  tmpName=Request.ServerVariables("PATH_INFO")
  arrTmpName=Split(tmpName,"/")
  If Options=0 Then GetName=Server.Mappath(".")&GetName(1)
  If Options=1 Then GetName=LCase(arrTmpName(UBound(arrTmpName)))
  If Options=2 Then GetName=LCase(arrTmpName(UBound(arrTmpName)-1))&"/"
End Function

End Class
%>

posted on 2005-07-01 20:31 孤剑阅读(346) 评论(0) 编辑收藏举报