一个比较使用的ASP函数集合类
最近迷恋上作网站了,使用asp开发,发现asp有好多的漏洞,而且在一个网站中有好多的代码是重复使用的,所以就查询了一些资料发现在asp中可以使用类的思想,所以就写了这个类,写的不好,但是比较实用。
<meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <% Const Btn_First="<font face='webdings'>9</font>" '定义第一页按钮显示样式 Const Btn_Prev="<font face='webdings'>3</font>" '定义前一页按钮显示样式 Const Btn_Next="<font face='webdings'>4</font>" '定义下一页按钮显示样式 Const Btn_Last="<font face='webdings'>:</font>" '定义最后一页按钮显示样式
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="连接数据库错误,请检查您的查询代码是否正确。<br>基于安全的理由,只显示本信息,要查看详细的错误信息,请设置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¶m_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="¶m_dbUserID&";Password="¶m_dbPassword&"" Case 21: 'SQL Server (OLEDB) ConnStr="Provider=SQLOLEDB;Initial Catalog="¶m_DataBase&";Data Source="&p_sqlDataSource&";User ID="¶m_dbUserID&";Password="¶m_dbPassword&"" Case 12: 'Access Data Base(ODBC) ConnStr="Driver={Microsoft Access Driver (*.mdb)};DBQ="&dbPath&";User ID="¶m_dbUserID&";Password="¶m_dbPassword Case 22: 'SQL Server (ODBC) ConnStr="Driver={SQL Server};DataBase="¶m_DataBase&";Server="&p_sqlDataSource&";User ID="¶m_dbUserID&";Password="¶m_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="数据库连接时出现错误,请检查您的查询代码是否正确。<br>基于安全的理由,只显示本信息,要查看详细的错误信息,请设置dsj.Debug=True" cmd="Execute the command of :"¶m_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:<br><font color=red>" & logCmd & "</font><BR>" 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="查询数据的时候发现错误,请检查您的查询代码是否正确。<br>基于安全的理由,只显示本信息,要查看详细的错误信息,请设置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),"</p><p>") '转换成段落格式 fString=Replace(fString,Chr(10),"<BR> ") '转换为下一行 fString=Replace(fString,Chr(13),"<BR>") fString=Replace(fSting,vbCrlf,"<BR>") '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&"'><font color=red>"&i&"</font></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 %>
|
|
|
导航
统计
- 随笔: 115
- 文章: 1
- 评论: 86
- 引用: 0
常用链接
留言簿(5)
随笔档案(115)
网址
搜索
积分与排名
最新评论
阅读排行榜
评论排行榜
|
|