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 + -
显示快捷键?