当前位置：首页 > news >正文

asp登录类

news 来源：原创 2024/4/28 0:20:24

受到面向对象编程的思想影响，在做asp的时候喜欢把常用的模块封装起来,不多说了，看代码.

1.login.asp Html代码

2.checklg.asp 检查登录页面

<% set lg=new myLogin lg.CheckLogin() set lg=nothing %>

3.loginClass.asp 登录类

<% '======================== '登录验证类 '======================== class myLogin private lusername private luserpwd private lyzm public property let setName(byval str) lusername=str end property public property get LName LName=lusername end property public property let setPwd(byval str) luserpwd=str end property public property get Pwd Pwd=luserpwd end property public property let SetYzm(byval str) lyzm=str end property public property get Yzm Yzm=lyzm end property '弹出对话框 public function Msg(str,ltype,url) if ltype=0 then response.Write("<mce:script type="text/javascript"></mce:script>") else response.Write("<mce:script type="text/javascript"></mce:script>") end if end function '拒绝夸站提交代码 public function postFormFrom() 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 call Msg("你提交的路径有误，禁止从站点外部提交数据请不要乱该参数！",0,"") response.end end if end function '================================== '=文件类型：函数 '=文件名：CheckStr '=功能：检查无效字符 '================================== public Function CheckStr(byVal ChkStr) Dim str:Str=ChkStr If IsNull(Str) Then CheckStr = "" Exit Function End If str=trim(str) Dim re Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern="(/r/n){3,}" Str=re.Replace(Str,"$1$1$1") Set re=Nothing Str = Replace(Str,"'","’") Str = Replace(Str, "select", "select") Str = Replace(Str, "join", "join") Str = Replace(Str, "union", "union") Str = Replace(Str, "where", "where") Str = Replace(Str, "insert", "insert") Str = Replace(Str, "delete", "delete") Str = Replace(Str, "update", "update") Str = Replace(Str, "like", "like") Str = Replace(Str, "drop", "drop") Str = Replace(Str, "create", "create") Str = Replace(Str, "modify", "modify") Str = Replace(Str, "rename", "rename") Str = Replace(Str, "alter", "alter") Str = Replace(Str, "cast", "cast") CheckStr=Str End Function public function getFormStr(str) getFormStr=checkstr(trim(request.Form(str))) end function '检查登录 public sub CheckLogin() call postFormFrom() dim u dim p dim y u=getFormStr("aname") p=getFormStr("apwd") y=getFormStr("CodeStr") setName=u setPwd=p SetYzm=y if LName="" then call Msg("账号不能为空！",0,"") response.end end if if Pwd="" then call Msg("密码不能为空！",0,"") response.end end if if Yzm="" then call Msg("验证码不能为空！",0,"") response.end end if '验证码验证 Dim CodeStr CodeStr =Yzm If CStr(Session("GetCode"))= CStr(CodeStr) And CodeStr <>"" Then 'Session("GetCode")=empty Else call Msg("验证码不正确！",0,"") response.end 'Session("GetCode")=empty End If set f1=new DbConstrol OpenConn() '打开连接 f1.DConn=conn set rs=f1.GetRs("select * from tbUser where a_name='"&LName&"'") if not rs.eof then if md5(Pwd)=rs("a_pwd") then '登录成功 session("admin_name")=rs("a_name") response.Redirect("index.asp") else call Msg("密码不正确！",0,"") CloseConn() set rs=nothing response.end end if else call Msg("该帐号不存在！",0,"") CloseConn() set rs=nothing response.end end if CloseConn() set rs=nothing end sub end class %>

4.conn.asp

<% '返回数据库连接字符串 '==================================================================================== 'dbType数据库类型 strDb数据库路径或者名称 strServer服务器名称 strUid帐号 strPwd密码 '==================================================================================== function CreateConn(byval dbType,byval strDb,byval strServer,byval strUid,byval strPwd) dim tmp select case dbType case "0": 'Access dim tDb if instr(strDb,":")>0 then tDb=strDb else tDb=server.MapPath(strDb) end if tmp="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&tDb&";Jet OLEDB:Database Password="&strPwd&";" case "1": 'Sql tmp="driver={sql server};server="&strServer&";uid="&strUid&";pwd="&strPwd&";database="&strDb end select CreateConn=tmp end function '打开数据库连接 '==================================================================================== 'Connstr数据库连接字符串 '==================================================================================== function Oc(byval Connstr) 'on error resume next dim obj set obj=server.CreateObject("adodb.connection") obj.open Connstr if err.number<>0 then Response.Write("<div id=""DBError"">数据库服务器端连接错误，请与网站管理员联系。</div>") 'response.Write("错误信息："&err.description) obj.close set obj=nothing response.End() end if set Oc=obj end function '关闭数据库连接 '==================================================================================== 'obj数据库连接 '==================================================================================== sub Co(obj) 'on error resume next if IsObject(obj) then obj.close set obj=nothing end if end sub '得到最终的连接,和关闭连接 dim ConnectionStr ConnectionStr=CreateConn(dbtype,dbpath,dbserver,dbuid,dbpwd) dim conn 'OpenConn() '加载时建立默认的连接Conn sub OpenConn() set conn=Oc(ConnectionStr) end sub sub CloseConn() Co(conn) end sub class DbConstrol private debug private dbconn private dberr private sub Class_initialize() debug=true '调试模式是否开启 if IsObject(conn) then set dbconn=conn end if dberr="出现错误：" end sub private sub Class_Terminate() set dbconn=nothing if debug and dberr<>"出现错误：" then response.Write(dberr) end if end sub public property let DConn(pconn) if IsObject(pconn) then set dbconn=pconn else set dbconn=conn end if end property public property get DErr() DErr=dberr end property '返回rs public function GetRs(byval sql) dim rs set rs=server.CreateObject("adodb.recordset") with rs .ActiveConnection=dbconn .CursorType=3 .LockType=3 .Source=sql .Open if err.number<>0 then DErr=DErr&"无效的查询条件!<br>" if debug then DErr=DErr&"错误信息："&err.description end if .Close set rs=nothing response.End() exit function end if end with set GetRs=rs end function '执行sql语句 public function DoExecute(byval sql) dim cmd set cmd=server.CreateObject("adodb.Command") with cmd .ActiveConnection=dbconn .commandText=sql .execute end with set cmd=nothing end function '查询记录返回记录条数 ' public function Getnum(byval sql) ' dim rs ' dim n ' set rs=server.CreateObject("adodb.recordset") ' with rs ' .ActiveConnection=dbconn ' .CursorType=3 ' .LockType=3 ' .Source=sql ' .Open ' if err.number<>0 then ' DErr=DErr&"无效的查询条件!<br>" ' if debug then ' DErr=DErr&"错误信息："&err.description ' end if ' .Close ' set rs=nothing ' response.End() ' exit function ' end if ' end with ' n=rs.recordcount ' Getnum=n ' rs.close ' set rs=nothing ' end function end class %>

5.md5.asp

<% Private Const BITS_TO_A_BYTE = 8 Private Const BYTES_TO_A_WORD = 4 Private Const BITS_TO_A_WORD = 32 Private m_lOnBits(30) Private m_l2Power(30) Private Function LShift(lValue, iShiftBits) If iShiftBits = 0 Then LShift = lValue Exit Function ElseIf iShiftBits = 31 Then If lValue And 1 Then LShift = &H80000000 Else LShift = 0 End If Exit Function ElseIf iShiftBits < 0 Or iShiftBits > 31 Then Err.Raise 6 End If If (lValue And m_l2Power(31 - iShiftBits)) Then LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000 Else LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits)) End If End Function Private Function RShift(lValue, iShiftBits) If iShiftBits = 0 Then RShift = lValue Exit Function ElseIf iShiftBits = 31 Then If lValue And &H80000000 Then RShift = 1 Else RShift = 0 End If Exit Function ElseIf iShiftBits < 0 Or iShiftBits > 31 Then Err.Raise 6 End If RShift = (lValue And &H7FFFFFFE) / m_l2Power(iShiftBits) If (lValue And &H80000000) Then RShift = (RShift Or (&H40000000 / m_l2Power(iShiftBits - 1))) End If End Function Private Function RotateLeft(lValue, iShiftBits) RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits)) End Function Private Function AddUnsigned(lX, lY) Dim lX4 Dim lY4 Dim lX8 Dim lY8 Dim lResult lX8 = lX And &H80000000 lY8 = lY And &H80000000 lX4 = lX And &H40000000 lY4 = lY And &H40000000 lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF) If lX4 And lY4 Then lResult = lResult Xor &H80000000 Xor lX8 Xor lY8 ElseIf lX4 Or lY4 Then If lResult And &H40000000 Then lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8 Else lResult = lResult Xor &H40000000 Xor lX8 Xor lY8 End If Else lResult = lResult Xor lX8 Xor lY8 End If AddUnsigned = lResult End Function Private Function md5_F(x, y, z) md5_F = (x And y) Or ((Not x) And z) End Function Private Function md5_G(x, y, z) md5_G = (x And z) Or (y And (Not z)) End Function Private Function md5_H(x, y, z) md5_H = (x Xor y Xor z) End Function Private Function md5_I(x, y, z) md5_I = (y Xor (x Or (Not z))) End Function Private Sub md5_FF(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub Private Sub md5_GG(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub Private Sub md5_HH(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub Private Sub md5_II(a, b, c, d, x, s, ac) a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac)) a = RotateLeft(a, s) a = AddUnsigned(a, b) End Sub Private Function ConvertToWordArray(sMessage) Dim lMessageLength Dim lNumberOfWords Dim lWordArray() Dim lBytePosition Dim lByteCount Dim lWordCount Const MODULUS_BITS = 512 Const CONGRUENT_BITS = 448 lMessageLength = Len(sMessage) lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) / BITS_TO_A_BYTE)) / (MODULUS_BITS / BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS / BITS_TO_A_WORD) ReDim lWordArray(lNumberOfWords - 1) lBytePosition = 0 lByteCount = 0 Do Until lByteCount >= lMessageLength lWordCount = lByteCount / BYTES_TO_A_WORD lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition) lByteCount = lByteCount + 1 Loop lWordCount = lByteCount / BYTES_TO_A_WORD lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition) lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3) lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29) ConvertToWordArray = lWordArray End Function Private Function WordToHex(lValue) Dim lByte Dim lCount For lCount = 0 To 3 lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1) WordToHex = WordToHex & Right("0" & Hex(lByte), 2) Next End Function Public Function MD5(sMessage) m_lOnBits(0) = CLng(1) m_lOnBits(1) = CLng(3) m_lOnBits(2) = CLng(7) m_lOnBits(3) = CLng(15) m_lOnBits(4) = CLng(31) m_lOnBits(5) = CLng(63) m_lOnBits(6) = CLng(127) m_lOnBits(7) = CLng(255) m_lOnBits(8) = CLng(511) m_lOnBits(9) = CLng(1023) m_lOnBits(10) = CLng(2047) m_lOnBits(11) = CLng(4095) m_lOnBits(12) = CLng(8191) m_lOnBits(13) = CLng(16383) m_lOnBits(14) = CLng(32767) m_lOnBits(15) = CLng(65535) m_lOnBits(16) = CLng(131071) m_lOnBits(17) = CLng(262143) m_lOnBits(18) = CLng(524287) m_lOnBits(19) = CLng(1048575) m_lOnBits(20) = CLng(2097151) m_lOnBits(21) = CLng(4194303) m_lOnBits(22) = CLng(8388607) m_lOnBits(23) = CLng(16777215) m_lOnBits(24) = CLng(33554431) m_lOnBits(25) = CLng(67108863) m_lOnBits(26) = CLng(134217727) m_lOnBits(27) = CLng(268435455) m_lOnBits(28) = CLng(536870911) m_lOnBits(29) = CLng(1073741823) m_lOnBits(30) = CLng(2147483647) m_l2Power(0) = CLng(1) m_l2Power(1) = CLng(2) m_l2Power(2) = CLng(4) m_l2Power(3) = CLng(8) m_l2Power(4) = CLng(16) m_l2Power(5) = CLng(32) m_l2Power(6) = CLng(64) m_l2Power(7) = CLng(128) m_l2Power(8) = CLng(256) m_l2Power(9) = CLng(512) m_l2Power(10) = CLng(1024) m_l2Power(11) = CLng(2048) m_l2Power(12) = CLng(4096) m_l2Power(13) = CLng(8192) m_l2Power(14) = CLng(16384) m_l2Power(15) = CLng(32768) m_l2Power(16) = CLng(65536) m_l2Power(17) = CLng(131072) m_l2Power(18) = CLng(262144) m_l2Power(19) = CLng(524288) m_l2Power(20) = CLng(1048576) m_l2Power(21) = CLng(2097152) m_l2Power(22) = CLng(4194304) m_l2Power(23) = CLng(8388608) m_l2Power(24) = CLng(16777216) m_l2Power(25) = CLng(33554432) m_l2Power(26) = CLng(67108864) m_l2Power(27) = CLng(134217728) m_l2Power(28) = CLng(268435456) m_l2Power(29) = CLng(536870912) m_l2Power(30) = CLng(1073741824) Dim x Dim k Dim AA Dim BB Dim CC Dim DD Dim a Dim b Dim c Dim d Const S11 = 7 Const S12 = 12 Const S13 = 17 Const S14 = 22 Const S21 = 5 Const S22 = 9 Const S23 = 14 Const S24 = 20 Const S31 = 4 Const S32 = 11 Const S33 = 16 Const S34 = 23 Const S41 = 6 Const S42 = 10 Const S43 = 15 Const S44 = 21 x = ConvertToWordArray(sMessage) a = &H67452301 b = &HEFCDAB89 c = &H98BADCFE d = &H10325476 For k = 0 To UBound(x) Step 16 AA = a BB = b CC = c DD = d md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478 md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756 md5_FF c, d, a, b, x(k + 2), S13, &H242070DB md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A md5_FF c, d, a, b, x(k + 6), S13, &HA8304613 md5_FF b, c, d, a, x(k + 7), S14, &HFD469501 md5_FF a, b, c, d, x(k + 8), S11, &H698098D8 md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1 md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE md5_FF a, b, c, d, x(k + 12), S11, &H6B901122 md5_FF d, a, b, c, x(k + 13), S12, &HFD987193 md5_FF c, d, a, b, x(k + 14), S13, &HA679438E md5_FF b, c, d, a, x(k + 15), S14, &H49B40821 md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562 md5_GG d, a, b, c, x(k + 6), S22, &HC040B340 md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51 md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D md5_GG d, a, b, c, x(k + 10), S22, &H2441453 md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681 md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8 md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6 md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6 md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87 md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905 md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8 md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9 md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942 md5_HH d, a, b, c, x(k + 8), S32, &H8771F681 md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122 md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44 md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9 md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60 md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70 md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6 md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085 md5_HH b, c, d, a, x(k + 6), S34, &H4881D05 md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039 md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5 md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8 md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665 md5_II a, b, c, d, x(k + 0), S41, &HF4292244 md5_II d, a, b, c, x(k + 7), S42, &H432AFF97 md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7 md5_II b, c, d, a, x(k + 5), S44, &HFC93A039 md5_II a, b, c, d, x(k + 12), S41, &H655B59C3 md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92 md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D md5_II b, c, d, a, x(k + 1), S44, &H85845DD1 md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0 md5_II c, d, a, b, x(k + 6), S43, &HA3014314 md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1 md5_II a, b, c, d, x(k + 4), S41, &HF7537E82 md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235 md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB md5_II b, c, d, a, x(k + 9), S44, &HEB86D391 a = AddUnsigned(a, AA) b = AddUnsigned(b, BB) c = AddUnsigned(c, CC) d = AddUnsigned(d, DD) Next 'MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d)) MD5=LCase(WordToHex(b) & WordToHex(c)) 'I crop this to fit 16byte database password :D End Function %>

6.config.asp

<% const dbtype=0 '连接数据库类型 Access const dbpath="database/#admin.mdb" '数据库路径 const dbserver="" '数据库服务器 const dbuid="" '数据库帐号 const dbpwd="" 'Access密码 '数据库备份，恢复用 Const SysRootDir = "../" Const SiteDataPath = "Database/#admin.mdb" '要备份的数据库 Const SiteDataBakPath = "DatabaseBk/#admin_bak.mdb" '要还原的数据库 %>

呵呵，本人水平有限，代码只供参考,学了.net有1年了，很想转行去做.net,但是现在国内做asp的还很多,我就当积累下经验吧,顺便学习下新知识，毕竟自己刚出来的，没什么经验!