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

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

Const Btn_First="9" '定义第一页按钮显示样式

Const Btn_Prev="3" '定义前一页按钮显示样式

Const Btn_Next="4" '定义下一页按钮显示样式

Const Btn_Last=":" '定义最后一页按钮显示样式

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 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 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

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

Else

AddErrorCode(104) '"|" is requried.

Exit Function

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

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 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

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

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

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