check.aspx.vb
来自「本程序修改自飞天BBS 7.0 将原来的ASP语法迁移为ASP.NET并封装成」· VB 代码 · 共 753 行 · 第 1/3 页
VB
753 行
If AspToAspX_CheckDBNull ( clearnulllen ( nlstr ) ) < 5 Or AspToAspX_CheckDBNull ( menu ) = EmptyString.Value Then '87
ftbbs_msg ( "内容不能为空且最少为5个字!" , refbhturl ) '88
End If '89
If AspToAspX_Len ( title ) < = 0 Then '90
ftbbs_msg ( "标题不能为空!" , refbhturl ) '91
End If '92
If AspToAspX_CheckDBNull ( bbsuser_cookie ) = EmptyString.Value Then '93
AspToAspX_Response_Redirect ( "fbht.aspx?layer_1=" & BoardID_1 & "&BoardID_2=" & BoardID_2 ) '94
End If '95
Sql_arrest = "select * from " & ft & "BBS_arrest where kind='IP' order by id asc" '97
rs_arrest = New ADODB.Recordset ( ) '98
rs_arrest.Open ( sql_arrest , conn , 1 , 1 ) '99
Do While Not rs_arrest.EOF '100
If AspToAspX_CheckDBNull ( AspToAspX_CheckDBNull(rs_arrest.Fields ( "content" ) .Value) ) = ip Then '101
ftbbs_msg ( "对不起,你无权发表话题!" , returnurl ) '102
End If '103
rs_arrest.MoveNext ( ) '104
Loop '105
rs_arrest.Close ( ) '106
Sql_arrest = "select * from " & ft & "BBS_arrest where kind='Keyword' order by id asc" '108
rs_arrest.Open ( sql_arrest , conn , 1 , 1 ) '109
Do While Not rs_arrest.EOF '110
If ( AspToAspX_CheckDBNull ( InStr ( menu , AspToAspX_CheckDBNull(rs_arrest.Fields ( "content" ) .Value) ) ) < > 0 Or AspToAspX_CheckDBNull ( InStr ( title , AspToAspX_CheckDBNull(rs_arrest.Fields ( "content" ) .Value) ) ) < > 0 ) Then '111
title = replace ( title , AspToAspX_CheckDBNull(rs_arrest.Fields ( "content" ) .Value) , "*****" ) '112
menu = replace ( menu , AspToAspX_CheckDBNull(rs_arrest.Fields ( "content" ) .Value) , "*****" ) '113
End If '114
rs_arrest.MoveNext ( ) '115
Loop '116
rs_arrest.Close ( ) '117
rs_arrest = Nothing '118
If AspToAspX_CheckDBNull ( Application ( "FTBBSMB" ) ( 7 , 0 ) ) = "M" Then '119
inFolder = Year ( ToDay ( ) ) & Month ( ToDay ( ) ) '120
Else '121
inFolder = Year ( ToDay ( ) ) & Month ( ToDay ( ) ) & Day ( ToDay ( ) ) '122
End If '123
myFolder = inFolder '124
myFolder = Server.MapPath ( myFolder ) '125
fileStreamObj = New Scripting.FileSystemObject ( ) '126
If AspToAspX_CheckDBNull ( fileStreamObj.FolderExists ( myFolder ) ) = False Then '127
fileStreamObj.CreateFolder ( myFolder ) '128
End If '129
rsql = "update " & ft & "clubuser set jingyuan=jingyuan+" & postget & ",postnum=postnum+1 where clubuser_name='" & name_cookie & "'" '131
conn.Execute ( rsql ) '132
AspToAspX_Str = "select * from " & ft & "clubuser where clubuser_name='" & name_cookie & "'" '134
rs = New ADODB.Recordset ( ) '135
rs.Open ( AspToAspX_Str , conn , 3 , 1 ) '136
If Not rs.EOF Then '138
clubuser_id = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_id" ) .Value) '139
jingyuan = AspToAspX_CheckDBNull(rs.Fields ( "jingyuan" ) .Value) '140
tili = AspToAspX_CheckDBNull(rs.Fields ( "tili" ) .Value) '141
clubuser_money = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_money" ) .Value) '142
img = AspToAspX_CheckDBNull(rs.Fields ( "userimg" ) .Value) '143
clubuser_reg_date = formatdatetime ( AspToAspX_CheckDBNull(rs.Fields ( "clubuser_reg_date" ) .Value) , 2 ) '144
If AspToAspX_CheckDBNull ( AspToAspX_CheckDBNull(rs.Fields ( "signname" ) .Value) ) < > EmptyString.Value Then '145
signname = ftbbsubbcode ( AspToAspX_CheckDBNull(rs.Fields ( "signname" ) .Value) ) '146
Else '147
signname = "<a href=../moduserinfo.aspx?postuser=" & name_cookie & "><FONT color=#568ac2>个人签名档还未设置,请点击这里进行设置</font></a>" '148
End If '149
bz = AspToAspX_CheckDBNull(rs.Fields ( "bbsmanager" ) .Value) '150
procity = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_province" ) .Value) & AspToAspX_CheckDBNull(rs.Fields ( "clubuser_city" ) .Value) '151
clubuser_zip = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_zip" ) .Value) '152
xzstr = "" '153
If AspToAspX_CheckDBNull ( clubuser_zip ) < > EmptyString.Value Then '154
If AspToAspX_CheckDBNull ( InStr ( clubuser_zip , "," ) ) > 0 Then '155
xzarr = AspToAspX_Split ( clubuser_zip , "," ) '156
For i = 0 To Val ( UBound ( xzarr ) ) '157
ar = xzarr ( i ) '158
br = AspToAspX_Split ( ar , "|" ) '159
xzimg = br ( 0 ) '160
xzms = br ( 1 ) '161
xzstr = xzstr & "<img src=../images/" & xzimg & " width=20 height=35 alt=" & xzms & "> " '162
Next '163
Else '164
xzarr = AspToAspX_Split ( clubuser_zip , "|" ) '165
xzimg = xzarr ( 0 ) '166
xzms = xzarr ( 1 ) '167
xzstr = xzstr & "<img src=../images/" & xzimg & " width=20 height=35 alt=" & xzms & ">" '168
End If '169
Else '170
xzstr = "" '171
End If '172
Else '173
jingyuan = 0 '174
tili = 100 '175
img = "cache5.gif" '176
signname = "<a href=../moduserinfo.aspx?postuser=" & name_cookie & "><FONT color=#568ac2>个人签名档还未设置,请点击这里进行设置</font></a>" '177
bz = 0 '178
procity = "福建厦门" '179
End If '180
If AspToAspX_CheckDBNull ( AspToAspX_CheckExpression ( jingyuan ) - AspToAspX_CheckExpression ( xsjf ) ) < = 0 Then '182
ftbbs_msg ( "对不起,你的积分太少!" , refbhturl ) '183
End If '184
touxian = touxianvalue ( jingyuan , ft ) '185
jibie = jibievalue ( jingyuan , ft ) '186
menu = htmlencode2 ( menu ) '188
menu = fthtmlcode ( menu ) '189
menu = ubbcode ( menu ) '190
menu = RegExReplace ( menu , "\b(script)\b" , " $1 " ) '192
menu = RegExReplace ( menu , "\b(iframe)\b" , " $1 " ) '193
indate = DateAndTime.Now '195
hhmm = FormatDateTime ( indate , 4 ) '197
If AspToAspX_CheckDBNull ( hhmm ) > postbegintime And AspToAspX_CheckDBNull ( hhmm ) < postendtime And AspToAspX_CheckDBNull ( shoff ) = 0 And AspToAspX_CheckDBNull ( postbegintime ) < > "0" And AspToAspX_CheckDBNull ( postendtime ) < > "0" Then '198
deletedvalue = 1 '199
Else '200
deletedvalue = shoff '201
End If '202
htmfilename = inFolder & "/" & FileName '204
sql = "select * from " & ft & "bbstitle where (id is null)" '205
rsr = New ADODB.Recordset ( ) '206
rsr.Open ( sql , conn , 1 , 3 ) '207
rsr.addnew ( ) '208
rsr.Fields ( "name" ) .Value = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_name" ) .Value) '209
rsr.Fields ( "user_id" ) .Value = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_nickname" ) .Value) '210
rsr.Fields ( "BoardID_1" ) .Value = BoardID_1 '211
rsr.Fields ( "BoardID_2" ) .Value = BoardID_2 '212
rsr.Fields ( "mail" ) .Value = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_email" ) .Value) '213
rsr.Fields ( "title" ) .Value = title '214
rsr.Fields ( "zhiye" ) .Value = zhiye '215
rsr.Fields ( "menu" ) .Value = menu '216
rsr.Fields ( "ip" ) .Value = ip '218
rsr.Fields ( "dateh" ) .Value = indate '219
rsr.Fields ( "deleted" ) .Value = deletedvalue '220
rsr.Fields ( "hit" ) .Value = 0 '221
rsr.Fields ( "rep" ) .Value = 0 '222
rsr.Fields ( "redate" ) .Value = indate '223
If AspToAspX_CheckDBNull ( bbs_img_display ) < > EmptyString.Value Then '224
rsr.Fields ( "bbs_img" ) .Value = bbs_img '225
rsr.Fields ( "bbs_img_display" ) .Value = bbs_img_display '226
End If '227
If AspToAspX_CheckDBNull ( bbs_img_text ) < > EmptyString.Value Then '228
rsr.Fields ( "bbs_img_text" ) .Value = bbs_img_text '229
End If '230
If AspToAspX_CheckDBNull ( img_url ) < > EmptyString.Value Then '231
rsr.Fields ( "img_url" ) .Value = img_url '232
End If '233
If AspToAspX_CheckDBNull ( img_url_text ) < > EmptyString.Value Then '234
rsr.Fields ( "img_url_text" ) .Value = img_url_text '235
End If '236
rsr.Fields ( "img_url_display" ) .Value = 0 '237
If AspToAspX_CheckDBNull ( ticon ) < > EmptyString.Value Then '238
rsr.Fields ( "picture" ) .Value = ticon '239
End If '240
rsr.Fields ( "htmfilename" ) .Value = htmfilename '241
If AspToAspX_CheckDBNull ( titlecolor ) < > EmptyString.Value Then '242
rsr.Fields ( "titlecolor" ) .Value = titlecolor '243
End If '244
If AspToAspX_CheckDBNull ( fd ) = "Y" Then '245
rsr.Fields ( "flag" ) .Value = 2 '246
ElseIf AspToAspX_CheckDBNull ( fd ) = "5"Then '247
rsr.Fields ( "xsdaynum" ) .Value = xsdaynum '248
rsr.Fields ( "xsjf" ) .Value = xsjf '249
rsr.Fields ( "flag" ) .Value = 5 '250
Else '251
rsr.Fields ( "flag" ) .Value = flag '252
End If '253
rsr.Update ( ) '254
rsr.Close ( ) '255
rsr = Nothing '256
sql = "select top 1 id,dateh from " & ft & "bbstitle order by id desc" '258
rsr = New ADODB.Recordset ( ) '259
rsr.Open ( sql , conn , 1 , 3 ) '260
TitleID = AspToAspX_CheckDBNull(rsr.Fields ( "id" ) .Value) '261
rsr.Close ( ) '262
rsr = Nothing '263
strsql = "update " & ft & "BBS_Cate set BBS_Cate_Topic=BBS_Cate_Topic+1 where BBS_Cate_ID='" & BoardID_1 & "'" '266
conn.Execute ( strsql ) '267
If AspToAspX_CheckDBNull ( BoardID_2 ) < > EmptyString.Value Then '268
strsql = "update " & ft & "BBS_Cate set BBS_Cate_Topic=BBS_Cate_Topic+1 where BBS_Cate_ID='" & BoardID_2 & "'" '269
conn.Execute ( strsql ) '270
End If '271
page = 1 '273
If AspToAspX_CheckDBNull ( Application ( "FTBBSMB" ) ( 8 , 0 ) ) = 1 Then '274
home = "default_list.aspx" '275
mainbbscate = "main.aspx" '276
bbsfbht = "fbht.aspx" '277
bbspoll = "bbspoll.aspx" '278
End If '279
postmb = replace ( replace ( Application ( "FTBBSMB" ) ( 1 , 0 ) , "$PostID$" , TitleID ) , "$pagenav$" , page ) '281
postmb = replace ( postmb , "$page$" , 1 ) '282
postmb = replace ( postmb , "$home$" , home ) '284
postmb = replace ( postmb , "$main$" , mainbbscate ) '285
postmb = replace ( postmb , "$fbht$" , bbsfbht ) '286
postmb = replace ( postmb , "$bbspoll$" , bbspoll ) '287
postmb = replace ( postmb , "$TitleID$" , TitleID ) '289
postmb = replace ( postmb , "$title$" , title ) '290
postmb = replace ( postmb , "$BoardID_1$" , BoardID_1 ) '291
postmb = replace ( postmb , "$BoardID_2$" , BoardID_2 ) '292
postmb = replace ( postmb , "$BBS_Cate_Name1$" , BBS_Cate_Name1 ) '293
postmb = replace ( postmb , "$BBS_Cate_Name2$" , BBS_Cate_Name2 ) '294
postmb = replace ( postmb , "$BBS_Cate_Manager_Name$" , BBS_Cate_Manager_Name ) '295
postmb = replace ( postmb , "$user_id$" , bbsuser_cookie ) '296
postmb = replace ( postmb , "$userid$" , clubuser_id ) '297
postmb = replace ( postmb , "$clubuser_money$" , clubuser_money ) '298
postmb = replace ( postmb , "$touxian$" , touxian ) '299
postmb = replace ( postmb , "$jibie$" , jibie ) '300
postmb = replace ( postmb , "$tili$" , tili ) '301
postmb = replace ( postmb , "$jingyuan$" , jingyuan ) '302
postmb = replace ( postmb , "$procity$" , procity ) '303
postmb = replace ( postmb , "$clubuser_reg_date$" , clubuser_reg_date ) '304
postmb = replace ( postmb , "$clubuser_zip$" , xzstr ) '305
postmb = replace ( postmb , "$name$" , name_cookie ) '306
If AspToAspX_CheckDBNull ( flag ) = 3 Or AspToAspX_CheckDBNull ( flag ) = 4 Or AspToAspX_CheckDBNull ( flag ) = 5 Then '307
postmb = replace ( postmb , "$menu$" , "<span id=""loadnl"" name=""loadnl""><img src=""../images/load.gif"" /></span>" ) '308
Else '309
postmb = replace ( postmb , "$menu$" , menu ) '310
End If '311
If AspToAspX_CheckDBNull ( BBS_Cate_QS2 ) = EmptyString.Value Then
BBS_Cate_QS2 = 0
End If
'313
postmb = replace ( postmb , "{qs}" , BBS_Cate_QS2 ) '314
postmb = replace ( postmb , "$htmfilename$" , htmfilename ) '315
postmb = replace ( postmb , "$url$" , url ) '316
postmb = replace ( postmb , "$zhiye$" , zhiye ) '317
postmb = replace ( postmb , "$signname$" , signname ) '318
postmb = replace ( postmb , "$img$" , img ) '319
postmb = replace ( postmb , "$date$" , indate ) '320
postmb = replace ( postmb , "$YN$" , YN ) '321
postmb = replace ( postmb , "$img_url$" , "" ) '322
If AspToAspX_CheckDBNull ( fd ) = "Y" Then '324
postmb = replace ( postmb , "$upfile$" , "<SCRIPT src=../bmform.aspx?titleid=" & TitleID & "></SCRIPT>" ) '325
Else '326
postmb = replace ( postmb , "$upfile$" , "" ) '327
End If '328
repostformmb = replace ( replace ( Application ( "FTBBSMB" ) ( 3 , 0 ) , "$PostID$" , TitleID ) , "$pagenav$" , page ) '329
If AspToAspX_CheckDBNull ( flag ) = 0 Or AspToAspX_CheckDBNull ( flag ) = 1 Or AspToAspX_CheckDBNull ( flag ) = 2 Then '330
repostformmb = replace ( repostformmb , "<script type=""text/javascript"" src=""../ftbbsdtnl.aspx?titleid=$TitleID$""></script>" , "" ) '331
End If '332
repostformmb = replace ( repostformmb , "$TitleID$" , TitleID ) '333
repostformmb = replace ( repostformmb , "$title$" , title ) '334
repostformmb = replace ( repostformmb , "$upfiletype$" , upfiletype ) '335
repostformmb = replace ( repostformmb , "$BoardID_1$" , BoardID_1 ) '336
repostformmb = replace ( repostformmb , "$BoardID_2$" , BoardID_2 ) '337
repostformmb = replace ( repostformmb , "$name$" , name_cookie ) '338
repostformmb = replace ( repostformmb , "$filename$" , htmfilename ) '340
HtmlNLA = postmb & repostformmb '341
mktohtm ( htmfilename , HtmlNLA ) '342
If AspToAspX_CheckIsNothing ( Request.Form ( "addblog" ) ) = "Y" Then '344
userip = AspToAspX_GetRequestServerVariables ( "remote_addr" ) '345
sql = "select * from " & ft & "ftblog_type where blogtype='默认分类' and userid=" & clubuser_id_cookie & " and blogphoto=0 order by id desc" '346
rs = New ADODB.Recordset ( ) '347
rs.Open ( sql , conn , 1 , 3 ) '348
If rs.EOF Then '349
rs.addnew ( ) '350
rs.Fields ( "userid" ) .Value = clubuser_id_cookie '351
rs.Fields ( "blogtype" ) .Value = "默认分类" '352
rs.Fields ( "blogphoto" ) .Value = 0 '353
rs.Fields ( "qs" ) .Value = 0 '354
rs.Fields ( "userip" ) .Value = userip '355
rs.Update ( ) '356
rs.Close ( ) '357
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?