| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1240 人关注过本帖
标题:[求助]关于论坛
只看楼主 加入收藏
ziyan
Rank: 1
等 级:新手上路
帖 子:123
专家分:0
注 册:2005-6-29
收藏
得分:0 
我是不是很笨啊
我是开始用的
也不太会
还请楼上的不要嫌我笨

腰缠十万贯,骑鹤上扬州.玉树琼花,金粉之盛,远过秦淮.晓起凭栏,六代青山尽在眼,晚来把酒,二分明月正当头
2005-11-07 15:49
hxfly
Rank: 5Rank: 5
等 级:贵宾
威 望:17
帖 子:5810
专家分:118
注 册:2005-4-7
收藏
得分:0 
从它的login.asp文件

2005-11-07 15:50
ziyan
Rank: 1
等 级:新手上路
帖 子:123
专家分:0
注 册:2005-6-29
收藏
得分:0 
好的
我再找找
谢谢楼上的
不会了还要请教你

腰缠十万贯,骑鹤上扬州.玉树琼花,金粉之盛,远过秦淮.晓起凭栏,六代青山尽在眼,晚来把酒,二分明月正当头
2005-11-07 15:57
盖茨他爹
Rank: 6Rank: 6
等 级:贵宾
威 望:28
帖 子:5255
专家分:0
注 册:2005-5-3
收藏
得分:0 
动网的程序很不好控制,界面都是靠后台的模板来控制的
2005-11-07 16:40
hxfly
Rank: 5Rank: 5
等 级:贵宾
威 望:17
帖 子:5810
专家分:118
注 册:2005-4-7
收藏
得分:0 
那就找模板

我给我朋友做过远程登陆论坛的
他用的是6KBBS
那个我做过
不过动网的好象不可以按照我那样的方法做

一会写一个试试

2005-11-07 16:45
hxfly
Rank: 5Rank: 5
等 级:贵宾
威 望:17
帖 子:5810
专家分:118
注 册:2005-4-7
收藏
得分:0 
[CODE]
<TABLE cellSpacing=1 cellPadding=3 align=center>
<FORM action=http://www.bc-cn.net/bbs/login.asp?action=chk method=post>
<TBODY>
<TR>
<TH vAlign=center colSpan=2 height=25>请输入您的用户名、论坛密码登录</TH>
</TR>
<TR>
<TD vAlign=center>用户名:</TD>
<TD vAlign=center><INPUT name=username> &nbsp;</TD>
</TR>
<TR>
<TD vAlign=center>密 码:</TD>
<TD vAlign=center><INPUT type=password name=password>
&nbsp; </TD>
</TR>
<TR>
<TD vAlign=top width="30%">cookies</TD>
<TD vAlign=center><INPUT type=radio CHECKED value=0
name=CookieDate>
不保存,关闭浏览器就失效<BR>
<INPUT type=radio value=1
name=CookieDate>
保存一天<BR>
<INPUT type=radio value=2
name=CookieDate>
保存一月<BR>
<INPUT type=radio value=3
name=CookieDate>
保存一年<BR></TD>
</TR>
<INPUT type=hidden value=index.asp
name=comeurl>
<TR>
<TD vAlign=center align="center" colSpan=2><INPUT type=submit value="登 录" name=submit></TD>
</TR>
</FORM></TBODY>
</TABLE>


以上是这个论坛的入口
楼主把FORM的ACTION属性修改一下应该可以了
前提是把登陆的时候需要验证关闭[/CODE]

2005-11-07 16:56
ziyan
Rank: 1
等 级:新手上路
帖 子:123
专家分:0
注 册:2005-6-29
收藏
得分:0 

我真的找不到啊
我把他的login.asp文件贴上来
楼上的帮我找找
<!--#include file="Conn.asp"-->
<!--#include file="inc/const.asp"-->
<!--#include file="inc/dv_clsother.asp"-->
<!--#include file="inc/chan_const.asp"-->
<!--#include file="inc/chkinput.asp"-->
<!--#include file="inc/Email_Cls.asp"-->
<!--#include file="inc/md5.asp"-->
<%
Dim comeurl
Dim TruePassWord
session("flag")=empty
Dvbbs.LoadTemplates("login")
Dvbbs.stats=template.Strings(1)
Dvbbs.Nav()
Dvbbs.Head_var 0,0,template.Strings(0),"login.asp"
TruePassWord=Dvbbs.Createpass
Select Case request("action")
Case "chk"
Dvbbs_ChkLogin
Dvbbs.Showerr()
Case "redir"
redir
Dvbbs.Showerr()
Case "save_redir_reg"
call save_redir_reg()
Dvbbs.Showerr()
Case Else
Main
End Select
Dvbbs.ActiveOnline
Dvbbs.Footer()

Function Main()
Dim TempStr
TempStr = template.html(0)
If Dvbbs.forum_setting(79)="0" Then
TempStr = Replace(TempStr,"{$getcode}","")
Else
Template.html(23)=Replace(template.html(23),"{$codestr}",Dvbbs.GetCode())
TempStr = Replace(TempStr,"{$getcode}",template.html(23))
End If
TempStr = Replace(TempStr,"{$rayuserlogin}",template.html(1))
Dim Comeurl,tmpstr
If Request("f")<>"" Then
Comeurl=Request("f")
ElseIf Request.ServerVariables("HTTP_REFERER")<>"" Then
tmpstr=split(Request.ServerVariables("HTTP_REFERER"),"/")
Comeurl=tmpstr(UBound(tmpstr))
Else
Comeurl="index.asp"
End If
TempStr = Replace(TempStr,"{$comeurl}",Comeurl)
Response.Write TempStr
TempStr=""
End Function

Function Dvbbs_ChkLogin
Dim UserIP
Dim username
Dim userclass
Dim password
Dim article
Dim usercookies
Dim mobile
Dim chrs,i
UserIP=Dvbbs.UserTrueIP
mobile=trim(Dvbbs.CheckStr(request("passport")))
'if mobile<>"" and request("username")="" then
' if len(mobile)>12 then
' Dvbbs.AddErrCode(9)
' end if
'end if
'if mobile<>"" then
' if len(mobile)>12 And Not IsNumeric(mobile) then mobile=""
'end if
If Request("t")="1" And Mobile = "" Then
Response.redirect "showerr.asp?ErrCodes=<li>请输入您的论坛通行证。&action=OtherErr"
End If
If Dvbbs.forum_setting(79)="1" Then
If mobile="" And Not Dvbbs.CodeIsTrue() Then
Response.redirect "showerr.asp?ErrCodes=<li>验证码校验失败,请返回刷新页面后再输入验证码。&action=OtherErr"
End If
End If
If Request("username")="" Then
If Request("passport")="" Then
Dvbbs.AddErrCode(10)
End If
Else
username=trim(Dvbbs.CheckStr(request("username")))
End If
If request("password")="" and mobile="" Then
Dvbbs.AddErrCode(11)
Else
password=md5(trim(Dvbbs.CheckStr(request("password"))),16)
If Request("password") = "" Then password = ""
End If
If Dvbbs.ErrCodes<>"" Then Exit Function
usercookies=request("CookieDate")
'判断更新cookies目录
Dim cookies_path_s,cookies_path_d,cookies_path
cookies_path_s=split(Request.ServerVariables("PATH_INFO"),"/")
cookies_path_d=ubound(cookies_path_s)
cookies_path="/"
For i=1 to cookies_path_d-1
If not (cookies_path_s(i)="upload" or cookies_path_s(i)="admin") Then cookies_path=cookies_path&cookies_path_s(i)&"/"
Next
If dvbbs.cookiepath<>cookies_path Then
cookies_path=replace(cookies_path,"'","")
Dvbbs.execute("update dv_setup set Forum_Cookiespath='"&cookies_path&"'")
Dim setupData
Dvbbs.CacheData(26,0)=cookies_path
Dvbbs.Name="setup"
Dvbbs.value=Dvbbs.CacheData
End If
If ChkUserLogin(username,password,mobile,usercookies,1)=false Then
'本地验证未通过,使用手机号登录的
If mobile<>"" Then
challenge_check mobile,password
Exit Function
'本地验证未通过,使用用户名登录的,并且是高级用户则继续主服务器验证流程
Else
set chrs=Dvbbs.Execute("select Passport,IsChallenge from [Dv_User] where username='"&username&"' and IsChallenge=1")
If chrs.eof and chrs.bof Then
Dvbbs.AddErrCode(12)
Exit Function
Else
challenge_check chrs("Passport"),password
Exit Function
End If
set chrs=nothing
End If
End If

Dim comeurlname
If instr(lcase(request("comeurl")),"reg.asp")>0 or instr(lcase(request("comeurl")),"login.asp")>0 or trim(request("comeurl"))="" Then
comeurlname=""
comeurl="index.asp"
Else
comeurl=request("comeurl")
comeurlname="<li><a href="&request("comeurl")&">"&request("comeurl")&"</a></li>"
End If

Dim TempStr
TempStr = template.html(2)
'If Dvbbs.Forum_ChanSetting(0)=1 And Dvbbs.Forum_ChanSetting(10)=1 And Dvbbs.Forum_ChanSetting(12)=1 Then
' TempStr = Replace(TempStr,"{$ray_logininfo}",template.html(3))
'Else
' TempStr = Replace(TempStr,"{$ray_logininfo}","")
'End If
TempStr = Replace(TempStr,"{$ray_logininfo}","")
TempStr = Replace(TempStr,"{$comeurl}",comeurl)
TempStr = Replace(TempStr,"{$comeurlinfo}",comeurlname)
TempStr = Replace(TempStr,"{$forumname}",Dvbbs.Forum_Info(0))
Response.Write TempStr
TempStr=""

End Function

'全网认证
Function challenge_check(mobile,password)
'If Not(Dvbbs.Forum_ChanSetting(0)=1 And Dvbbs.Forum_ChanSetting(10)=1) Then
' Dvbbs.AddErrCode(13)
' Exit Function
'End If
Dim rs,iUserID
Dim MyForumID
Dim PostChanWord
'生成订单号:01+yyyyMMddhhmmss+六位随机数
'生成日期字串
Dim NowTimes,PayMonth,PayDay,PayHour,PayMin,PaySe,PayDayStr,RandomizeStr,num2
Dim PayCode,PayCodeEnCode
NowTimes = Now()
PayMonth = Month(NowTimes)
If Len(PayMonth)=1 Then PayMonth = "0" & PayMonth
PayDay = Day(NowTimes)
If Len(PayDay)=1 Then PayDay = "0" & PayDay
PayHour = Hour(NowTimes)
If Len(PayHour)=1 Then PayHour = "0" & PayHour
PayMin = Minute(NowTimes)
If Len(PayMin)=1 Then PayMin = "0" & PayMin
PaySe = Second(NowTimes)
If Len(PaySe)=1 Then PaySe = "0" & PaySe
PayDayStr = Year(NowTimes) & PayMonth & PayDay & PayHour & PayMin & PaySe
'生成随机字串
Randomize
Do While Len(RandomizeStr)<5
num2 = CStr(Chr((57-48)*rnd+48))
RandomizeStr = RandomizeStr & num2
Loop
PayCode = PayDayStr & RandomizeStr & Left(MD5(Dvbbs.Forum_ChanSetting(4)&Dvbbs.Forum_ChanSetting(6),32),8)
Dim FoundMobile,UserAnswer,UserJoinTime
Set Rs=Dvbbs.Execute("Select UserID,Passport,UserAnswer,JoinDate From Dv_User Where Passport = '"&Dvbbs.CheckStr(Mobile)&"'")
If Rs.Eof And Rs.Bof Then
FoundMobile = False
Rs.Close:Set Rs=Nothing
Set Rs=Dvbbs.Execute("Select Top 1 UserID,Passport,UserAnswer,JoinDate From Dv_User Order By UserID")
iUserID = "-" & Rs(0)
UserAnswer = Rs(2)
UserJoinTime = Rs(3)
Else
FoundMobile = True
iUserID = Rs(0)
UserAnswer = Rs(2)
UserJoinTime = Rs(3)
End If
Rs.Close
Set Rs=Nothing
Session("challengeWord_key") = MD5(PayCode & ":" & MD5(UserAnswer & ":" & FormatDateTime(UserJoinTime,2),32),32)
Session("challengeUserID") = iUserID

Dim TempStr,TempArray
TempArray = Split(template.html(19),"||")
TempStr = TempArray(0)
TempStr = Replace(TempStr,"{$Dvbbs_Server}","http://www.dvbbs.net/passport/login.asp")
TempStr = Replace(TempStr,"{$passport}",mobile)
TempStr = Replace(TempStr,"{$userid}",iUserID)
'TempStr = Replace(TempStr,"{$password}",password)
'TempStr = Replace(TempStr,"{$MyForumID}",MyForumID)
TempStr = Replace(TempStr,"{$serverurl}",Dvbbs.Get_ScriptNameUrl())
TempStr = Replace(TempStr,"{$PostChanWord}",PayCode)
TempStr = Replace(TempStr,"{$remobile}",mobile)
TempStr = Replace(TempStr,"{$usermobile}",mobile)
If FoundMobile Then
TempStr = Replace(TempStr,"{$ifpassnull}",",您正在进行论坛通行证用户<B>快速登录</B>。请点击下一步继续。")
TempStr = Replace(TempStr,"{$ifpassnull1}","如果您希望用此论坛通行证注册新用户,请登录论坛后修改当前用户绑定的论坛通行证为其它通行证帐号或取消通行证绑定。")
Else
TempStr = Replace(TempStr,"{$ifpassnull}",",您正在进行论坛通行证用户<B>快速注册</B>,请点击下一步继续。")
TempStr = Replace(TempStr,"{$ifpassnull1}","本操作将引导您在本论坛注册,并且同步您在论坛通行证服务器上的用户基本信息。")
End If
Response.Write TempStr
TempStr = ""
set rs=nothing
If not IsObject(Application(Dvbbs.CacheName & "_iplist")) Then
SendData()
ElseIf DateDiff("D",Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("@date").text,Date())<> 0 Then
SendData()
End If
'Response.Write Application(Dvbbs.CacheName & "_iplist").documentElement.selectSingleNode("@date").text
End Function

Function strAnsi2Unicode(asContents)
Dim len1,i,varchar,varasc
strAnsi2Unicode = ""
len1=LenB(asContents)
If len1=0 Then Exit Function
For i=1 to len1
varchar=MidB(asContents,i,1)
varasc=AscB(varchar)
If varasc > 127 Then
If MidB(asContents,i+1,1)<>"" Then
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
End If
i=i+1
Else
strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
End If
Next
End Function
Sub SendData()
Dim xmlhttp,xml,DataToSend,xmlserverurl
On Error Resume Next
Set xmlhttp = Server.CreateObject("MSXML2.ServerXMLHTTP"&MsxmlVersion)
xmlserverurl="http://server.dvbbs.net/dvbbs/iplist.asp"
xmlhttp.setTimeouts 65000, 65000, 65000, 65000
xmlhttp.Open "POST",xmlserverurl,false
xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.send
Set XML=Server.CreateObject("Msxml2.FreeThreadedDOMDocument"& MsxmlVersion)
If XML.loadxml(strAnsi2Unicode(xmlhttp.responseBody)) Then
Xml.documentElement.selectSingleNode("@date").text=Date()
Set Application(Dvbbs.CacheName & "_iplist")=Xml.cloneNode(true)
End If
Set xmlhttp = Nothing
End Sub

Function redir()

Dim ErrorCode,ErrorMsg
Dim remobile,rechallengeWord,retokerWord,reuserpassword
Dim resex,reqq,reemail,reusername
Dim challengeWord_key,rechallengeWord_key
Dim userclass
Dim rs,iUserID

ErrorCode=trim(request("ErrorCode"))
ErrorMsg=trim(request("ErrorMsg"))
remobile=trim(Dvbbs.CheckStr(request("passport")))
reuserpassword=trim(Dvbbs.CheckStr(request("password")))
rechallengeWord=trim(Dvbbs.CheckStr(request("seqno")))
retokerWord=trim(request("token"))
'reemail=trim(Dvbbs.CheckStr(request("email")))
'resex=trim(Dvbbs.CheckStr(request("sex")))
'If resex="F" Then
' resex=1
'Else
' resex=0
'End If
'reqq=trim(Dvbbs.CheckStr(request("qq")))
'reusername=trim(Dvbbs.CheckStr(request("username")))

Session("re_challenge_reg_temp")=checkreal(remobile) & "|||" & checkreal(remobile)
iUserID = Session("challengeUserID")
If iUserID = "" Or Not IsNumeric(iUserID) Then
Response.Redirect "index.asp"
Exit Function
End If
iUserID = cCur(iUserID)

If ErrorCode = "1" Then
challengeWord_key=Session("challengeWord_key")
If challengeWord_key=retokerWord Then
Set Rs=Dvbbs.Execute("Select Passport,IsChallenge,UserID,UserClass,UserName,UserPassword From [Dv_User] Where Passport='"&remobile&"'")
'用论坛通行证新用户注册或绑定用户
If Rs.Eof And Rs.Bof Then
redir_reg_1()
Exit Function
'已绑定通行证用户进行登录,此处仅设置用户为登录状态而不更新其帐号信息
Else
Dvbbs.UserID=Rs(2)
UserClass=Rs(5)
reUserName=Rs(4)
If Rs("IsChallenge")=0 Then Dvbbs.Execute("Update Dv_User Set IsChallenge = 1 Where UserID = " & Rs(2))
End If
Else
'Response.Write session("challengeWord")&"||"&rechallengeWord
'Response.End
Response.Redirect "showerr.asp?ErrCodes=<li>本地验证失败2,可能的原因有:网络超时、非法的提交请求。&action=OtherErr"
'challengeWord_key & "," & retokerWord & "," & md5(Session("challengeWord") & ":" & "raynetwork",32) & "<br>原始随机数:"&Session("challengeWord")&",返回随机数:"&rechallengeWord&""
Exit Function
End If
Else
Response.redirect "showerr.asp?ErrCodes=<li>"&ErrorMsg&"&action=OtherErr"
Exit Function
End If

Dim TempStr
TempStr = template.html(20)
If Dvbbs.Forum_ChanSetting(0)=1 And Dvbbs.Forum_ChanSetting(10)=1 And Dvbbs.Forum_ChanSetting(12)=1 Then
TempStr = Replace(TempStr,"{$ray_logininfo}",template.html(3))
Else
TempStr = Replace(TempStr,"{$ray_logininfo}","")
End If
TempStr = Replace(TempStr,"{$reuserpassword}",reuserpassword)
TempStr = Replace(TempStr,"{$forumname}",Dvbbs.Forum_Info(0))
Response.Write TempStr
TempStr=""
Dim StatUserID,UserSessionID
StatUserID = Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("StatUserID")))
If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
StatUserID = Replace(Dvbbs.UserTrueIP,".","")
UserSessionID = Replace(Startime,".","")
If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
End If
StatUserID = Ccur(StatUserID)
If ChkUserLogin(reusername,userclass,"",0,1) Then userclass=""
Session("challengeUserID") = Empty
Session("challengeWord_key") = Empty
Session("re_challenge_reg_temp") = Empty

End Function

Sub redir_reg_1()

If Session("re_challenge_reg_temp")="" Then
Dvbbs.AddErrCode(14)
exit sub
End If

Dim re_challenge_reg_temp
re_challenge_reg_temp=split(Session("re_challenge_reg_temp"),"|||")

Dim TempStr
TempStr = template.html(21)
TempStr = Replace(TempStr,"{$maxuserlength}",Dvbbs.Forum_Setting(41))
TempStr = Replace(TempStr,"{$minuserlength}",Dvbbs.Forum_Setting(40))
TempStr = Replace(TempStr,"{$reusername}",re_challenge_reg_temp(0))
TempStr = Replace(TempStr,"{$passport}",re_challenge_reg_temp(1))
TempStr = Replace(TempStr,"{$width}",Dvbbs.mainsetting(0))
Response.Write TempStr
End Sub

Sub save_redir_reg()
If Session("re_challenge_reg_temp")="" Then
Dvbbs.AddErrCode(14)
Exit Sub
End If

Dim username,sex,pass1,pass2,password,ErrCodes
Dim useremail,face,width,height
Dim oicq,sign,showRe,birthday
Dim mailbody,sendmsg,rndnum,num1
Dim quesion,answer,topic
Dim userinfo,usersetting
Dim userclass,UserIM
Dim re_challenge_reg_temp
Dim rs,sql,i,namebadword,SplitWords
Dim t
Dim StatUserID,UserSessionID
Dim TempStr
t = Request("t")
If t = "" Or Not IsNumeric(t) Then t = 1
t = Cint(t)
If t <> 1 And t <> 2 Then t = 1
re_challenge_reg_temp=split(Session("re_challenge_reg_temp"),"|||")

If Request("name")="" or strLength(Request("name"))>Cint(Dvbbs.Forum_Setting(41)) or strLength(Request("name"))<Cint(Dvbbs.Forum_Setting(40)) Then
Dvbbs.AddErrCode(17)
Else
username=Dvbbs.CheckStr(Trim(Request("name")))
End If

If Instr(username,"=")>0 or Instr(username,"%")>0 or Instr(username,chr(32))>0 or Instr(username,"?")>0 or Instr(username,"&")>0 or Instr(username,";")>0 or Instr(username,",")>0 or Instr(username,"'")>0 or Instr(username,",")>0 or Instr(username,chr(34))>0 or Instr(username,chr(9))>0 or Instr(username,"?")>0 or Instr(username,"$")>0 Then
Dvbbs.AddErrCode(19)
End If

If Request.form("psw")="" or len(Request.form("psw"))>10 or len(Request.form("psw"))<6 Then
ErrCodes=ErrCodes+"<li>请输入您的密码,密码长度为6-10字节。"
Else
pass1=Request.form("psw")
End If
'绑定用户部分
If t = 2 Then
If ErrCodes<>"" Then Response.redirect "showerr.asp?ErrCodes="&ErrCodes&"&action=OtherErr"
password = MD5(pass1,16)
If Dvbbs.ErrCodes<>"" Then Exit Sub
If ChkUserLogin(username,password,"",0,1)=False Then
Dvbbs.AddErrCode(12)
End If
If Dvbbs.ErrCodes<>"" Then Exit Sub
Conn.Execute("Update Dv_User Set Passport = '"&re_challenge_reg_temp(0)&"',IsChallenge=1 Where UserName = '"&username&"'")
StatUserID = Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("StatUserID")))
If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
StatUserID = Replace(Dvbbs.UserTrueIP,".","")
UserSessionID = Replace(Startime,".","")
If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
End If
StatUserID = Ccur(StatUserID)
TempStr = template.html(22)
TempStr = Replace(TempStr,"{$ray_logininfo}","")
TempStr = Replace(TempStr,"{$reuserpassword}",re_challenge_reg_temp(1))
TempStr = Replace(TempStr,"{$sendmsg}","<li>论坛通行证绑定论坛用户成功!")
TempStr = Replace(TempStr,"{$forumname}",Dvbbs.Forum_Info(0))
Response.Write TempStr
Session("challengeUserID") = Empty
Session("challengeWord_key") = Empty
Session("re_challenge_reg_temp") = Empty
Exit Sub
End If
If Request.form("pswc")="" or strLength(Request.form("pswc"))>10 or len(Request.form("pswc"))<6 Then
ErrCodes=ErrCodes+"<li>"+template.Strings(13)
Else
pass2=Request.form("pswc")
End If
If pass1<>pass2 Then
ErrCodes=ErrCodes+"<li>"+template.Strings(29)
Else
password=md5(pass2,16)
End If

Dim RegSplitWords
If Trim(Dvbbs.cachedata(1,0))<>"" Then
RegSplitWords=split(Dvbbs.cachedata(1,0),"|||")(4)
RegSplitWords=split(RegSplitWords,",")
For i = 0 to ubound(RegSplitWords)
If Trim(RegSplitWords(i))<>"" Then
If instr(username,RegSplitWords(i))>0 Then
Dvbbs.AddErrCode(19)
Exit For
End If
End If
next
End If
sex=1
'password=md5(re_challenge_reg_temp(1),16)
useremail=re_challenge_reg_temp(0) & "@dvbbs.net"
showRe=1
face="images/userface/image1.gif"
width=32
height=32

If request.Form("birthyear")="" or request.form("birthmonth")="" or request.form("birthday")="" Then
birthday=""
Else
birthday=trim(Request.Form("birthyear"))&"-"&trim(Request.Form("birthmonth"))&"-"&trim(Request.Form("birthday"))
If not isdate(birthday) Then birthday=""
End If

userinfo=checkreal(request.Form("realname")) & "|||" & checkreal(request.Form("character")) & "|||" & checkreal(request.Form("personal")) & "|||" & checkreal(request.Form("country")) & "|||" & checkreal(request.Form("province")) & "|||" & checkreal(request.Form("city")) & "|||" & request.Form("shengxiao") & "|||" & request.Form("blood") & "|||" & request.Form("belief") & "|||" & request.Form("occupation") & "|||" & request.Form("marital") & "|||" & request.Form("education") & "|||" & checkreal(request.Form("college")) & "|||" & checkreal(request.Form("userphone")) & "|||" & checkreal(request.Form("address"))
usersetting=request.Form("setuserinfo") & "|||" & request.Form("setusertrue") & "|||" & showRe

If ErrCodes<>"" Then
Response.redirect "showerr.asp?ErrCodes="&ErrCodes&"&action=OtherErr"
Exit Sub
End If
If Dvbbs.ErrCodes<>"" Then Exit Sub
Dim titlepic,iUserGroupID
set rs=Dvbbs.Execute("select usertitle,grouppic,UserGroupID from Dv_UserGroups where ParentGID=3 order by minarticle")
userclass=rs(0)
titlepic=rs(1)
iUserGroupID=rs(2)
UserIM = "||||||||||||||||||"
set rs=server.createobject("adodb.recordset")
sql="select * from [Dv_User] where username='"&username&"' or Passport='"&re_challenge_reg_temp(0)&"'"
rs.open sql,conn,1,3
If not rs.eof and not rs.bof Then
Dvbbs.AddErrCode(21)
Exit Sub
Else
rs.addnew
rs("IsChallenge")=1
rs("username")=username
rs("userpassword")=password
rs("TruePassWord")=TruePassWord
rs("useremail")=useremail
rs("userclass")=userclass
rs("titlepic")=titlepic
rs("Passport")=re_challenge_reg_temp(0)
Rs("UserIM")=UserIM
Rs("UserPost")=0
Rs("usergroupid")=iUserGroupID
rs("lockuser")=0
Rs("Usersex")=sex
rs("JoinDate")=NOW()
rs("Userface")=replace(face,"'","")
rs("UserWidth")=width
rs("UserHeight")=height
rs("UserLogins")=1
Rs("lastlogin")=NOW()
rs("userWealth")=Dvbbs.Forum_user(0)
rs("userEP")=Dvbbs.Forum_user(5)
rs("usercP")=Dvbbs.Forum_user(10)
rs("userinfo")=userinfo
rs("usersetting")=usersetting
rs("UserFav")="陌生人,我的好友,黑名单"
rs.update
Dvbbs.Execute("update Dv_Setup set Forum_usernum=Forum_usernum+1,Forum_lastuser='"&username&"'")
End If
rs.close
set rs=Dvbbs.Execute("select top 1 userid from [Dv_User] order by userid desc")
dvbbs.userid=rs(0)
set rs=nothing
Dvbbs.ReloadSetupCache username,14
Dvbbs.ReloadSetupCache (CLng(Dvbbs.CacheData(10,0))+1),10

If Dvbbs.Forum_Setting(47)=1 and Cint(Dvbbs.Forum_Setting(2))>0 Then
'on error resume next
'发送注册邮件
Dim getpass
topic=Replace(template.Strings(35),"{$Forumname}",Dvbbs.Forum_Info(0))
mailbody = template.html(17)
mailbody = Replace(mailbody,"{$username}",Dvbbs.HtmlEncode(username))
mailbody = Replace(mailbody,"{$password}",password)
mailbody = Replace(mailbody,"{$copyright}",Dvbbs.Forum_Copyright)
mailbody = Replace(mailbody,"{$version}",Dvbbs.Forum_Version)
Dim DvEmail
Set DvEmail = New Dv_SendMail
DvEmail.SendObject = Cint(Dvbbs.Forum_Setting(2)) '设置选取组件 1=Jmail,2=Cdonts,3=Aspemail
DvEmail.ServerLoginName = Dvbbs.Forum_info(12) '您的邮件服务器登录名
DvEmail.ServerLoginPass = Dvbbs.Forum_info(13) '登录密码
DvEmail.SendSMTP = Dvbbs.Forum_info(4) 'SMTP地址
DvEmail.SendFromEmail = Dvbbs.Forum_info(5) '发送来源地址
DvEmail.SendFromName = Dvbbs.Forum_info(0) '发送人信息
If DvEmail.ErrCode = 0 Then
DvEmail.SendMail useremail,topic,mailbody '执行发送邮件
If DvEmail.Count>0 Then
If Cint(Dvbbs.Forum_Setting(23))=1 Then
sendmsg=template.Strings(38)
Else
sendmsg=template.Strings(39)
End If
Else
sendmsg=template.Strings(37)
End If
Else
sendmsg=template.Strings(37)
End If
Set DvEmail = Nothing
Dvbbs.ErrCodes=""
Else
sendmsg = template.Strings(36)
End If

If Dvbbs.Forum_Setting(46)=1 Then
'发送注册短信
Dim sender,title,body,UserMsg,MsgID
sender=Dvbbs.Forum_info(0)
title=Dvbbs.Forum_info(0)&"欢迎您的到来"

body = template.html(18)
body = Replace(body,"{$Forumname}",Dvbbs.Forum_Info(0))
'response.write body
sql="insert into dv_message(incept,sender,title,content,sendtime,flag,issend) values('"&username&"','"&sender&"','"&title&"','"&body&"',"&SqlNowString&",0,1)"
Dvbbs.Execute(sql)
Set rs=Dvbbs.execute("select top 1 ID from [Dv_message] order by ID desc")
MsgID=rs(0)
Rs.close:Set Rs=Nothing
UserMsg="1||"& MsgID &"||"& sender
Dvbbs.execute("UPDATE [Dv_User] Set UserMsg='"&Dvbbs.CheckStr(UserMsg)&"' WHERE UserID="&Dvbbs.userid)
End If

If cint(Dvbbs.Forum_Setting(25))=1 Then

Else
Response.Cookies(Dvbbs.Forum_sn).path=dvbbs.cookiepath
Response.Cookies(Dvbbs.Forum_sn)("username")=""
Response.Cookies(Dvbbs.Forum_sn)("password")=""
Response.Cookies(Dvbbs.Forum_sn)("userclass")=""
Response.Cookies(Dvbbs.Forum_sn)("userid")=""
Response.Cookies(Dvbbs.Forum_sn)("userhidden")=""
Response.Cookies(Dvbbs.Forum_sn)("usercookies")=""

StatUserID = Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("StatUserID")))
If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
StatUserID = Replace(Dvbbs.UserTrueIP,".","")
UserSessionID = Replace(Startime,".","")
If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
End If
StatUserID = Ccur(StatUserID)
Response.Cookies(Dvbbs.Forum_sn).path=Dvbbs.cookiepath
Response.Cookies(Dvbbs.Forum_sn)("StatUserID") = StatUserID
Response.Cookies(Dvbbs.Forum_sn)("usercookies") = "0"
Response.Cookies(Dvbbs.Forum_sn)("username") = username
Response.Cookies(Dvbbs.Forum_sn)("password") = TruePassWord
Response.Cookies(Dvbbs.Forum_sn)("userclass") = userclass
Response.Cookies(Dvbbs.Forum_sn)("userid") = dvbbs.userid
Response.Cookies(Dvbbs.Forum_sn)("userhidden") = 2
Dvbbs.Execute("delete from dv_online where username='"&dvbbs.membername&"' Or id="&StatUserID&"")
End If
If ChkUserLogin(username,password,"",0,1) Then password=""

TempStr = template.html(22)
TempStr = Replace(TempStr,"{$ray_logininfo}","")
TempStr = Replace(TempStr,"{$reuserpassword}",re_challenge_reg_temp(1))
TempStr = Replace(TempStr,"{$sendmsg}","<li>论坛通行证快速注册论坛用户成功!")
TempStr = Replace(TempStr,"{$forumname}",Dvbbs.Forum_Info(0))
Response.Write TempStr
TempStr=""
Session("re_challenge_reg_temp")=""
Session("challengeUserID") = Empty
Session("challengeWord_key") = Empty
End Sub

Function checkreal(v)
Dim w
If not isnull(v) Then
w=replace(v,"|||","§§§")
checkreal=w
End If
End Function


Rem ==========论坛登录函数=========
Rem 判断用户登录
Function ChkUserLogin(username,password,mobile,usercookies,ctype)

Dim rsUser,article,userclass,titlepic
Dim userhidden,lastip,UserLastLogin
Dim GroupID,ClassSql,FoundGrade
Dim regname,iMyUserInfo
Dim sql,sqlstr,OLDuserhidden

FoundGrade=False
lastip=Dvbbs.UserTrueIP
userhidden=request.form("userhidden")
If userhidden <> "1" Then userhidden=2
ChkUserLogin=false
If mobile<>"" Then
sqlstr=" Passport='"&mobile&"'"
Else
sqlstr=" UserName='"&username&"'"
End If
Sql="Select UserID,UserName,UserPassword,UserEmail,UserPost,UserTopic,UserSex,UserFace,UserWidth,UserHeight,JoinDate,LastLogin,lastlogin as cometime , LastLogin as activetime,UserLogins,Lockuser,Userclass,UserGroupID,UserGroup,userWealth,userEP,userCP,UserPower,UserBirthday,UserLastIP,UserDel,UserIsBest,UserHidden,UserMsg,IsChallenge,UserMobile,TitlePic,UserTitle,TruePassWord,UserToday,UserMoney,UserTicket,FollowMsgID,Vip_StarTime,Vip_EndTime,userid as boardid"
Sql=Sql & " From [Dv_User] Where "&sqlstr&""
set rsUser=Dvbbs.Execute(sql)
If rsUser.eof and rsUser.bof Then
ChkUserLogin=False
Exit Function
Else
If rsUser("Lockuser") =1 Or rsUser("UserGroupID") =5 Then
ChkUserLogin=False
Exit Function
Else
If Trim(password)=Trim(rsUser("UserPassword")) Then
ChkUserLogin=True
Dvbbs.UserID=RsUser("UserID")
RegName = RsUser("UserName")
Article= RsUser("UserPost")
UserLastLogin = RsUser("cometime")
UserClass = RsUser("Userclass")
GroupID = RsUser("userGroupID")
OLDuserhidden=RsUser("UserHidden")
TitlePic = RsUser("UserTitle")
If Article < 0 Then Article=0
Set Dvbbs.UserSession=Dvbbs.RecordsetToxml(rsUser,"userinfo","xml")
Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@cometime").text=Now()
Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@activetime").text=DateAdd("s",-3600,Now())
Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@boardid").text=0
Dvbbs.UserSession.documentElement.selectSingleNode("userinfo").attributes.setNamedItem(Dvbbs.UserSession.createNode(2,"isuserpermissionall","")).text=Dvbbs.FoundUserPermission_All()
If OLDuserhidden <> CLng(userhidden) Then
Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userhidden").text=userhidden
Dvbbs.Execute("update Dv_user set userhidden="&userhidden&" where UserId=" & Dvbbs.UserID)
End If
Dim BS
Set Bs=Dvbbs.GetBrowser()
Dvbbs.UserSession.documentElement.appendChild(Bs.documentElement)
If EnabledSession Then Session(Dvbbs.CacheName & "UserID")=Dvbbs.UserSession.xml
Else
ChkUserLogin=False
Exit Function
End If
End If
End If
If ChkUserLogin Then
REM 判断用户组(等级)资料,当用户级别为跟随文章数增长则自动更新用户组(等级)
REM 自动更新用户数据
REM 如果属于系统或特殊或多属性组
Set rsUser=Dvbbs.Execute("Select MinArticle,IsSetting,ParentGID,UserTitle,GroupPic From Dv_UserGroups Where UserGroupID="&GroupID)
If Not (rsUser.Eof And rsUser.Bof) Then
If rsUser(2)=1 Or rsUser(2)=2 Or rsUser(2)=4 Or rsUser(2)=5 Then
'用户等级不按照文章升级,用户为系统或特殊或多属性组
UserClass=rsUser(3)
TitlePic=rsUser(4)
FoundGrade=True
End If
End If
If Not FoundGrade Then
'如果不属于系统或特殊或多属性组,则将该用户属于注册用户组且按照其文章数自动更新其用户组(等级)
Set rsUser=Dvbbs.Execute("Select Top 1 usertitle,GroupPic,UserGroupID From Dv_UserGroups Where ParentGID=3 And Minarticle<="&Article&" Order By MinArticle Desc,UserGroupID")
If Not (rsUser.Eof And rsUser.Bof) Then
UserClass=rsUser(0)
TitlePic=rsUser(1)
GroupID=rsUser(2)
FoundGrade=True
End If
End If
Set rsUser=nothing
If Not FoundGrade Then Response.Redirect "showerr.asp?ErrCodes=<li>系统没有找到您的注册用户组资料,请联系管理员进行修正。&action=OtherErr"
select case ctype
case 1
If Datediff("d",UserLastLogin,Now())=0 Then
sql="update [Dv_User] set LastLogin="&SqlNowString&",UserLogins=UserLogins+1,UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
Else
sql="update [Dv_User] set userWealth=userWealth+"&Dvbbs.Forum_user(4)&",userEP=userEP+"&Dvbbs.Forum_user(9)&",userCP=userCP+"&Dvbbs.Forum_user(14)&",LastLogin="&SqlNowString&",UserLogins=UserLogins+1,UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
End If
case 2
sql="update [Dv_User] set UserPost=UserPost+1,UserTopic=UserTopic+1,userWealth=userWealth+"&Dvbbs.Forum_user(1)&",userEP=userEP+"&Dvbbs.Forum_user(6)&",userCP=userCP+"&Dvbbs.Forum_user(11)&",LastLogin="&SqlNowString&",UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
case 3
sql="update [Dv_User] set UserPost=UserPost+1,userWealth=userWealth+"&Dvbbs.Forum_user(2)&",userEP=userEP+"&Dvbbs.Forum_user(7)&",userCP=userCP+"&Dvbbs.Forum_user(12)&",LastLogin="&SqlNowString&",UserLastIP='"&lastip&"',userclass='"&userclass&"',titlepic='"&titlepic&"',UserGroupID="&GroupID&",TruePassWord='"&TruePassWord&"' where userid="&dvbbs.UserID
end select
Dvbbs.Execute(sql)
Dim StatUserID,UserSessionID
StatUserID = Dvbbs.checkStr(Trim(Request.Cookies(Dvbbs.Forum_sn)("StatUserID")))
If IsNumeric(StatUserID) = 0 or StatUserID = "" Then
StatUserID = Replace(Dvbbs.UserTrueIP,".","")
UserSessionID = Replace(Startime,".","")
If IsNumeric(StatUserID) = 0 or StatUserID = "" Then StatUserID = 0
StatUserID = Ccur(StatUserID) + Ccur(UserSessionID)
End If
StatUserID = Ccur(StatUserID)
Dvbbs.Execute("delete from dv_online where id="&StatUserID&"")
If trim(username)<>trim(Dvbbs.membername) Then
Response.Cookies(Dvbbs.Forum_sn)("username")=""
Response.Cookies(Dvbbs.Forum_sn)("password")=""
Response.Cookies(Dvbbs.Forum_sn)("userclass")=""
Response.Cookies(Dvbbs.Forum_sn)("userid")=""
Response.Cookies(Dvbbs.Forum_sn)("userhidden")=""
Response.Cookies(Dvbbs.Forum_sn)("usercookies")=""
Dvbbs.Execute("delete from dv_online where username='"&Dvbbs.membername&"'")
End If
If isnull(usercookies) or usercookies="" Then usercookies="0"
select case usercookies
case "0"
Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
case 1
Response.Cookies(Dvbbs.Forum_sn).Expires=Date+1
Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
case 2
Response.Cookies(Dvbbs.Forum_sn).Expires=Date+31
Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
case 3
Response.Cookies(Dvbbs.Forum_sn).Expires=Date+365
Response.Cookies(Dvbbs.Forum_sn)("usercookies") = usercookies
end select
Response.Cookies(Dvbbs.Forum_sn).path = Dvbbs.cookiepath
Response.Cookies(Dvbbs.Forum_sn)("username") = regname
Response.Cookies(Dvbbs.Forum_sn)("userid") = Dvbbs.UserID
Response.Cookies(Dvbbs.Forum_sn)("password") = TruePassWord
Response.Cookies(Dvbbs.Forum_sn)("userclass") = userclass
Response.Cookies(Dvbbs.Forum_sn)("userhidden") = userhidden
rem 清除图片上传数的限制
Response.Cookies("upNum")=0


腰缠十万贯,骑鹤上扬州.玉树琼花,金粉之盛,远过秦淮.晓起凭栏,六代青山尽在眼,晚来把酒,二分明月正当头
2005-11-07 16:57
hxfly
Rank: 5Rank: 5
等 级:贵宾
威 望:17
帖 子:5810
专家分:118
注 册:2005-4-7
收藏
得分:0 

楼主看看这里
http://www.bc-cn.net/bbs/dispbbs.asp?boardID=15&ID=32970&page=1


把你论坛的网址给我


2005-11-07 17:01
ziyan
Rank: 1
等 级:新手上路
帖 子:123
专家分:0
注 册:2005-6-29
收藏
得分:0 

16楼的
谢谢了
是可以了
但是不同的是还有个验证码
别的都好了
验证码的代码在哪
我把代码贴在上面了


腰缠十万贯,骑鹤上扬州.玉树琼花,金粉之盛,远过秦淮.晓起凭栏,六代青山尽在眼,晚来把酒,二分明月正当头
2005-11-07 17:09
ziyan
Rank: 1
等 级:新手上路
帖 子:123
专家分:0
注 册:2005-6-29
收藏
得分:0 

我的论坛还没传到网上
我是在http://www.dvbbs.net/download.asp下载的7.0.1版的
然后安装到本地
那个action搞好了
就是action=Dvbbs7.1.0_Ac/login.asp?action=chk
就可以的
但是没有验证码
我输入用户名和密码本来是正确的用户名和密码
会出现验证码错误


腰缠十万贯,骑鹤上扬州.玉树琼花,金粉之盛,远过秦淮.晓起凭栏,六代青山尽在眼,晚来把酒,二分明月正当头
2005-11-07 17:18
快速回复:[求助]关于论坛
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.020853 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved