bbspollact.aspx.vb

本程序修改自飞天BBS 7.0 将原来的ASP语法迁移为ASP.NET并封装成DLL ASP.NET相对ASP有更快的执行效率以及更高的并发访问量 基于ASP.NET的DLL可以运行在支持ASP

' ***************************************************
' *        本程序由AspToAspX风火轮0.99转换生成      *
' *        http://Www.AspToAspX.Cn                  *
' *        Q Q :  139227536                         *
' *        QQ群:  17152722                          *
' *        MSN :  [e-mail]        *
' *        EMail  [e-mail]              *
' ***************************************************
Imports Microsoft.VisualBasic
Imports System.Web
Imports System.Math
Imports System.Web.SessionState


Public Class _BBSPOLLACT
    Inherits System.Web.UI.Page
    Implements IHttpHandler, AspToAspX_Interface

    Public AspToAspX_Host_Class_Object As Object

Public formElement
Public i
Public k
Public clubuser_id_cookie
Public name_cookie
Public bbsuser_cookie
Public payuser_cookie
Public url
Public upfiletype
Public upfilesize
Public getcodeoff
Public htm_ext
Public shoff
Public postbegintime
Public postendtime
Public postget
Public ip
Public BoardID_1
Public BoardID_2
Public returnurl
Public refbhturl
Public codestr
Public codename
Public BBS_Cate_Name1
Public BBS_Cate_Name2
Public BBS_Cate_Manager_Name
Public BBS_Cate_QS2
Public tptype
Public title
Public menu
Public ticon
Public daynum
Public FileName
Public allpoll
Public Sql_arrest
Public rs_arrest
Public inFolder
Public myFolder
Public fileStreamObj
Public rsql
Public AspToAspX_Str
Public rs As ADODB.Recordset
Public clubuser_id
Public jingyuan
Public tili
Public clubuser_money
Public img
Public clubuser_reg_date
Public signname
Public bz
Public procity
Public clubuser_zip
Public xzstr
Public xzarr
Public ar
Public br
Public xzimg
Public xzms
Public touxian
Public jibie
Public indate
Public htmfilename
Public sql
Public rsr
Public TitleID
Public adddate
Public pollarr
Public strsql
Public page
Public home
Public mainbbscate
Public bbsfbht
Public bbspoll
Public postmb
Public repostformmb
Public HtmlNLA
Public linkdb
Public ft
Public ku
Public ckiesdomain
Public conndb
Public ConnectionString
Public FTBBS
Public zhiye
Public YN
    Public ASPX_CONN As _CONN
    Public ASPX_BBSUSER As _BBSUSER
    Public ASPX_INC_HTMLENCODE2 As _INC_HTMLENCODE2
    Public ASPX_INC_UBBCODE As _INC_UBBCODE
    Public ASPX_TOUXIANFUN As _TOUXIANFUN
#Region "..."
    Public Sub AspToAspX_InitIncludeFiles()
        ASPX_CONN = New _CONN()
        ASPX_CONN.AspToAspX_Host_Class_Object = AspToAspX_Host_Class_Object
        ASPX_CONN.AspToAspX_InitIncludeFiles()
        ASPX_BBSUSER = New _BBSUSER()
        ASPX_BBSUSER.AspToAspX_Host_Class_Object = AspToAspX_Host_Class_Object
        ASPX_BBSUSER.AspToAspX_InitIncludeFiles()
        ASPX_INC_HTMLENCODE2 = New _INC_HTMLENCODE2()
        ASPX_INC_HTMLENCODE2.AspToAspX_Host_Class_Object = AspToAspX_Host_Class_Object
        ASPX_INC_HTMLENCODE2.AspToAspX_InitIncludeFiles()
        ASPX_INC_UBBCODE = New _INC_UBBCODE()
        ASPX_INC_UBBCODE.AspToAspX_Host_Class_Object = AspToAspX_Host_Class_Object
        ASPX_INC_UBBCODE.AspToAspX_InitIncludeFiles()
        ASPX_TOUXIANFUN = New _TOUXIANFUN()
        ASPX_TOUXIANFUN.AspToAspX_Host_Class_Object = AspToAspX_Host_Class_Object
        ASPX_TOUXIANFUN.AspToAspX_InitIncludeFiles()
    End Sub

    Public Sub AspToAspX_UnloadIncludeFiles()
        ASPX_CONN.AspToAspX_UnloadIncludeFiles()
        ASPX_CONN = Nothing
        ASPX_BBSUSER.AspToAspX_UnloadIncludeFiles()
        ASPX_BBSUSER = Nothing
        ASPX_INC_HTMLENCODE2.AspToAspX_UnloadIncludeFiles()
        ASPX_INC_HTMLENCODE2 = Nothing
        ASPX_INC_UBBCODE.AspToAspX_UnloadIncludeFiles()
        ASPX_INC_UBBCODE = Nothing
        ASPX_TOUXIANFUN.AspToAspX_UnloadIncludeFiles()
        ASPX_TOUXIANFUN = Nothing
    End Sub

#End Region
    Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs)
        AspToAspXGlobal.Application = Application
        AspToAspXGlobal.Server = Server
        AspToAspXGlobal.Response = Response
        AspToAspXGlobal.Request = Request
        AspToAspXGlobal.Session = Session
        AspToAspX_Host_Class_Object = Me
        AspToAspX_InitIncludeFiles()
        AspToAspX_Page_Init()
        End Sub
    Public Sub AspToAspX_Page_Init()
    On Error GoTo _AspToAspX_Err
    ASPX_CONN.AspToAspX_Page_Init ( )
    ASPX_BBSUSER.AspToAspX_Page_Init ( )
    ASPX_INC_HTMLENCODE2.AspToAspX_Page_Init ( )
    ASPX_INC_UBBCODE.AspToAspX_Page_Init ( )
    ASPX_TOUXIANFUN.AspToAspX_Page_Init ( )
    clubuser_id_cookie = getcookie ( "clubuser_id" ) '7
    name_cookie = Checkstr ( getcookie ( "name" ) ) '8
    bbsuser_cookie = Checkstr ( getcookie ( "bbsuser" ) ) '9
    payuser_cookie = getcookie ( "payuser" ) '10
    If Not AspToAspX_CheckIsNumeric ( clubuser_id_cookie ) Then '11
        Response.Write ( "用户ID错误" ) '12
        Response.End ( ) '13
    End If '14
    FTBBS_HTML_MB ( ft ) '15
    url = Application ( "FTBBSMB" ) ( 10 , 0 ) '16
    upfiletype = Application ( "FTBBSMB" ) ( 12 , 0 ) '17
    upfilesize = Application ( "FTBBSMB" ) ( 13 , 0 ) '18
    getcodeoff = Application ( "FTBBSMB" ) ( 30 , 0 ) '19
    htm_ext = Application ( "FTBBSMB" ) ( 32 , 0 ) '20
    shoff = Application ( "FTBBSMB" ) ( 38 , 0 ) '21
    postbegintime = Application ( "FTBBSMB" ) ( 42 , 0 ) '22
    postendtime = Application ( "FTBBSMB" ) ( 43 , 0 ) '23
    postget = Application ( "FTBBSMB" ) ( 48 , 0 ) '24
    ip = AspToAspX_GetRequestServerVariables ( "remote_addr" ) '26
    BoardID_1 = AspToAspX_CheckIsNothing ( Request.Form ( "BoardID_1" ) ) '27
    BoardID_2 = AspToAspX_CheckIsNothing ( Request.Form ( "BoardID_2" ) ) '28
    returnurl = "main.aspx?layer_1=" & BoardID_1 & "&layer_2=" & BoardID_2 '29
    refbhturl = "bbspoll.aspx?layer_1=" & BoardID_1 & "&layer_2=" & BoardID_2 '30
    If AspToAspX_CheckDBNull ( payuser_cookie ) = 3 Then '31
        ftbbs_msg ( "你的用户名被管理员封锁,请联系管理员！" , returnurl ) '32
    End If '33
    If AspToAspX_CheckDBNull ( Session ( FTBBS & "LastPostTime" ) ) = EmptyString.Value Then '34
        Session ( FTBBS & "LastPostTime" ) = DateAndTime.Now '35
    Else '36
        If AspToAspX_DateDiff ( "s" , Session ( FTBBS & "LastPostTime" ) , DateAndTime.Now ) < = Application ( "FTBBSMB" ) ( 18 , 0 ) Then '37
            ftbbs_msg ( "连续发帖间隔时间不能少于" & Application ( "FTBBSMB" ) ( 18 , 0 ) & "秒!" , refbhturl ) '38
        Else '39
            Session ( FTBBS & "LastPostTime" ) = DateAndTime.Now '40
        End If '41
    End If '42
    If AspToAspX_CheckDBNull ( getcodeoff ) = 1 Then '44
        codestr = Trim ( AspToAspX_CheckIsNothing ( Request.Form ( "codestr" ) ) ) '45
        codename = Trim ( AspToAspX_CheckIsNothing ( Request.Form ( "codename" ) ) ) '46
        If AspToAspX_CStr ( Session ( "GetCode" & codename ) ) < > AspToAspX_CStr ( codestr ) Then '47
            ftbbs_msg ( "验证码错误，请重新输入！" , refbhturl ) '48
        End If '49
    End If '50
    FTBBS_BZ_NAME ( BoardID_1 , ft ) '52
    BBS_Cate_Name1 = Application ( "BBS_Cate_Name1" ) '53
    FTBBS_BZ_NAME2 ( BoardID_1 , BoardID_2 , ft ) '54
    BBS_Cate_Name2 = Application ( "BBS_Cate_Name2" ) '55
    BBS_Cate_Manager_Name = Application ( "BBS_Cate_Manager_Name" ) '56
    BBS_Cate_QS2 = Application ( "BBS_Cate_QS2" ) '57
    tptype = AspToAspX_CheckIsNothing ( Request.Form ( "tptype" ) ) '59
    title = trim ( AspToAspX_CheckIsNothing ( Request.Form ( "title" ) ) ) '61
    title = htmlencode2 ( title ) '62
    title = Checkstr ( title ) '63
    menu = trim ( AspToAspX_CheckIsNothing ( Request.Form ( "menu" ) ) ) '64
    ticon = trim ( AspToAspX_CheckIsNothing ( Request.Form ( "ticon" ) ) ) '65
    daynum = trim ( AspToAspX_CheckIsNothing ( Request.Form ( "daynum" ) ) ) '67
    FileName = Session ( "filename" ) '68
    For Each formElement In Request.Form '69
        If AspToAspX_CheckDBNull ( InStr ( formElement , "tpnl" ) ) > 0 Then '70
            If AspToAspX_CheckDBNull ( trim ( AspToAspX_CheckIsNothing ( Request.Form ( "" & formElement & "" ) ) ) ) < > EmptyString.Value Then '71
                allpoll = allpoll & Checkstr ( AspToAspX_CheckIsNothing ( Request.Form ( "" & formElement & "" ) ) ) & "|" '72
            End If '73
        End If '74
    Next '75
    allpoll = left ( allpoll , AspToAspX_Len ( allpoll ) - 1 ) '76
    Sql_arrest = "select * from " & ft & "BBS_arrest where kind='IP' order by id asc" '77
    rs_arrest = New ADODB.Recordset ( ) '78
    rs_arrest.Open ( sql_arrest , conn , 1 , 1 ) '79
    Do While Not rs_arrest.EOF '80
        If AspToAspX_CheckDBNull ( AspToAspX_CheckDBNull(rs_arrest.Fields ( "content" ) .Value) ) = ip Then '81
            ftbbs_msg ( "对不起，你无权发表话题!" , returnurl ) '82
        End If '83
        rs_arrest.MoveNext ( ) '84
    Loop '85
    rs_arrest.Close ( ) '86
    Sql_arrest = "select * from " & ft & "BBS_arrest where kind='Keyword' order by id asc" '88
    rs_arrest.Open ( sql_arrest , conn , 1 , 1 ) '89
    Do While Not rs_arrest.EOF '90
        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 '91
        title = replace ( title , AspToAspX_CheckDBNull(rs_arrest.Fields ( "content" ) .Value) , "*****" ) '92
        menu = replace ( menu , AspToAspX_CheckDBNull(rs_arrest.Fields ( "content" ) .Value) , "*****" ) '93
    End If '94
    rs_arrest.MoveNext ( ) '95
    Loop '96
    rs_arrest.Close ( ) '97
    rs_arrest = Nothing '98
    If AspToAspX_CheckDBNull ( Application ( "FTBBSMB" ) ( 7 , 0 ) ) = "M" Then '100
        inFolder = Year ( ToDay ( ) ) & Month ( ToDay ( ) ) '101
    Else '102
        inFolder = Year ( ToDay ( ) ) & Month ( ToDay ( ) ) & Day ( ToDay ( ) ) '103
    End If '104
    myFolder = inFolder '105
    myFolder = Server.MapPath ( myFolder ) '106
    fileStreamObj = New Scripting.FileSystemObject ( ) '107
    If AspToAspX_CheckDBNull ( fileStreamObj.FolderExists ( myFolder ) ) = False Then '108
        fileStreamObj.CreateFolder ( myFolder ) '109
    End If '110
    rsql = "update " & ft & "clubuser set jingyuan=jingyuan+" & postget & ",postnum=postnum+1 where clubuser_name='" & name_cookie & "'" '112
    conn.Execute ( rsql ) '113
    AspToAspX_Str = "select * from " & ft & "clubuser where clubuser_name='" & name_cookie & "'" '114
    rs = New ADODB.Recordset ( ) '115
    rs.Open ( AspToAspX_Str , conn , 3 , 1 ) '116
    If Not rs.EOF Then '118
        clubuser_id = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_id" ) .Value) '119
        jingyuan = AspToAspX_CheckDBNull(rs.Fields ( "jingyuan" ) .Value) '120
        tili = AspToAspX_CheckDBNull(rs.Fields ( "tili" ) .Value) '121
        clubuser_money = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_money" ) .Value) '122
        img = AspToAspX_CheckDBNull(rs.Fields ( "userimg" ) .Value) '123
        clubuser_reg_date = formatdatetime ( AspToAspX_CheckDBNull(rs.Fields ( "clubuser_reg_date" ) .Value) , 2 ) '124
        If AspToAspX_CheckDBNull ( AspToAspX_CheckDBNull(rs.Fields ( "signname" ) .Value) ) < > EmptyString.Value Then '125
            signname = ftbbsubbcode ( AspToAspX_CheckDBNull(rs.Fields ( "signname" ) .Value) ) '126
        Else '127
            signname = "还没有签名" '128
        End If '129
        bz = AspToAspX_CheckDBNull(rs.Fields ( "bbsmanager" ) .Value) '130
        procity = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_province" ) .Value) & AspToAspX_CheckDBNull(rs.Fields ( "clubuser_city" ) .Value) '131
        clubuser_zip = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_zip" ) .Value) '132
        xzstr = "" '133
        If AspToAspX_CheckDBNull ( clubuser_zip ) < > EmptyString.Value Then '134
            If AspToAspX_CheckDBNull ( InStr ( clubuser_zip , "," ) ) > 0 Then '135
                xzarr = AspToAspX_Split ( clubuser_zip , "," ) '136
                For i = 0 To Val ( UBound ( xzarr ) ) '137
                    ar = xzarr ( i ) '138
                    br = AspToAspX_Split ( ar , "|" ) '139
                    xzimg = br ( 0 ) '140
                    xzms = br ( 1 ) '141
                    xzstr = xzstr & "<img src=../images/" & xzimg & " width=20 height=35 alt=" & xzms & "> " '142
                Next '143
            Else '144
                xzarr = AspToAspX_Split ( clubuser_zip , "|" ) '145
                xzimg = xzarr ( 0 ) '146
                xzms = xzarr ( 1 ) '147
                xzstr = xzstr & "<img src=../images/" & xzimg & " width=20 height=35 alt=" & xzms & ">" '148
            End If '149
        Else '150
            xzstr = "" '151
        End If '152
    Else '153
        jingyuan = 0 '154
        tili = 100 '155
        img = "cache5.gif" '156
        signname = "你还没有签名，可以从修改资料中加入自已的签名" '157
        bz = 0 '158
        procity = "福建厦门" '159
    End If '160
    touxian = touxianvalue ( jingyuan , ft ) '161
    jibie = jibievalue ( jingyuan , ft ) '162
    menu = htmlencode2 ( menu ) '163
    menu = ftHTMLCode ( menu ) '164
    menu = ubbcode ( menu ) '165
    menu = RegExReplace ( menu , "\b(script)\b" , " $1 " ) '166
    menu = RegExReplace ( menu , "\b(iframe)\b" , " $1 " ) '167
    indate = DateAndTime.Now '169
    htmfilename = inFolder & "/" & FileName '170
    sql = "select * from " & ft & "bbstitle where (id is null)" '171
    rsr = New ADODB.Recordset ( ) '172
    rsr.Open ( sql , conn , 1 , 3 ) '173
    rsr.addnew ( ) '174
    rsr.Fields ( "name" ) .Value = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_name" ) .Value) '175
    rsr.Fields ( "user_id" ) .Value = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_nickname" ) .Value) '176
    rsr.Fields ( "BoardID_1" ) .Value = BoardID_1 '177
    rsr.Fields ( "BoardID_2" ) .Value = BoardID_2 '178
    rsr.Fields ( "mail" ) .Value = AspToAspX_CheckDBNull(rs.Fields ( "clubuser_email" ) .Value) '179
    rsr.Fields ( "title" ) .Value = title '180
    rsr.Fields ( "menu" ) .Value = menu '181
    rsr.Fields ( "ip" ) .Value = ip '183
    rsr.Fields ( "dateh" ) .Value = indate '184
    rsr.Fields ( "hit" ) .Value = 0 '185
    rsr.Fields ( "rep" ) .Value = 0 '186
    rsr.Fields ( "redate" ) .Value = indate '187
    If AspToAspX_CheckDBNull ( ticon ) < > EmptyString.Value Then '188
        rsr.Fields ( "picture" ) .Value = ticon '189
    End If '190
    rsr.Fields ( "htmfilename" ) .Value = htmfilename '191
    rsr.Fields ( "flag" ) .Value = 1 '192
    rsr.Update ( ) '193
    sql = "select top 1 id,dateh from " & ft & "bbstitle order by id desc" '194
    rsr = New ADODB.Recordset ( ) '195
    rsr.Open ( sql , conn , 1 , 3 ) '196