补丁2
找到 [CODE]sub messto(towho,sender,title,content)。。。。。。。。。。end sub '获得用户名字
[/CODE]全部替换成：
[CODE]sub messto(towho,sender,title,content)
'con.execute ("insert into leadbbs_infobox(touser,fromuser,title,content,ip,sendtime,readflag)values('"&towho&"','"&sender&"','"&title&"','"&content&"','"&GBL_IPAddress&"','"&GetTimeValue(now)&"','0')")
dim Sdm_FromUser,Sdm_ToUser,Sdm_Title,Sdm_Content
Sdm_ToUser = towho
Sdm_FromUser = sender
Sdm_Title=title
Sdm_Content=content
GBL_CHK_TempStr=""
If GBL_UserID < 0 Then GBL_UserID = 0
If GBL_UserID = 0 Then GBL_CHK_TempStr = GBL_CHK_TempStr & "你没有登录<br>" & VbCrLf
If GBL_CHK_Flag = 1 Then
CheckUserAnnounceLimit
If GBL_CHK_OnlineTime < DEF_NeedOnlineTime and DEF_NeedOnlineTime > 0 and CheckSupervisorUserName = 0 Then
GBL_CHK_TempStr = "论坛限制在线时间(" & DEF_PointsName(4) & ")" & Fix(DEF_NeedOnlineTime/60) & "分以上用户才能使用此功能。<br>" & VbCrLf
end if
If GBL_CHK_TempStr = "" Then
Response.Write "<br>"
SendNewMessage SdM_fromUser,SdM_ToUser,SdM_Title,SdM_Content,GBL_IPAddress
Else
Response.Write "<br> <font color=ff0000 class=RedFont>" & GBL_CHK_TempStr & "</font>" & VbCrLf
End If
end if
'con.execute ("insert into leadbbs_infobox(FromUser,ToUser,title,Content,IP,SendTime,ReadFlag,ExpiresDate)values('"&sender&"','"&towho&"','"&title&"','"&content&"','"&GBL_IPAddress&"','"&GetTimeValue(now)&"','0','" & CLng(Left(GetTimeValue(DateAdd("d",LMT_SendMsgExpiresDate,Now)),8)) & "')")
'con.execute("update leadbbs_user set MessageFlag=1 where username='"&towho&"'")
'CALL LDExeCute("Update LeadBBS_User Set MessageFlag=1 where UserName='" & ToUser & "' and MessageFlag=0",1)
'If GBL_CHK_User = ToUser Then UpdateSessionValue 6,1,0
'end if
end sub
'获得用户名字
[/CODE]
此补丁完美调用5.0版本的信息发送程序。。。。。。。。
不过原来的也比较完美。。。。