arrest.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 _INC_ARREST
    Inherits System.Web.UI.Page
    Implements IHttpHandler, AspToAspX_Interface

    Public AspToAspX_Host_Class_Object As Object

#Region "..."
    Public Sub AspToAspX_InitIncludeFiles()
    End Sub

    Public Sub AspToAspX_UnloadIncludeFiles()
    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
    checkIPArrest ( ) '3
    checkKeywordArrest ( ) '4
    Response.Write ( vbCrLf )

        AspToAspX_UnloadIncludeFiles()
        Exit Sub
    _AspToAspX_Err:
        AspToAspX_WriteLog ("arrest_aspx Page_Init:" & Err.Description)
        Resume Next
        End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\ARREST.ASP
Sub checkIPArrest()
On Error Goto _AspToAspX_Err
    Dim ip
    Dim rs
    Dim sql
    Dim ft
    ip = AspToAspX_GetRequestServerVariables ( "remote_addr" ) '7
    If AspToAspX_CheckDBNull ( ip ) = EmptyString.Value Then '8
        Exit Sub '9
    End If '10
    sql = "select * from " & ft & "BBS_arrest where Kind='IP' and Content='" & ip & "'" '11
    rs = AspToAspX_Object.conn.Execute ( sql ) '12
    If Not rs.EOF Then '13
        Response.Write ( "<br><br>IP禁止[" & ip & "]，不能访问本页，解禁请与管理员联系。" ) '14
        Response.End ( ) '15
    End If '16
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\ARREST.ASP checkIPArrest:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\ARREST.ASP
Sub checkKeywordArrest()
On Error Goto _AspToAspX_Err
    Dim strRequest
    Dim keyword
    Dim rs
    Dim sql
    Dim p1
    Dim p2
    Dim ft
    strRequest = Request.QueryString '20
    If AspToAspX_CheckDBNull ( strRequest ) = EmptyString.Value Then '21
        Exit Sub '22
    End If '23
    sql = "select Content from " & ft & "BBS_arrest where Kind='Keyword' and Content<>''" '24
    rs = AspToAspX_Object.conn.Execute ( sql ) '25
    While ( Not rs.EOF ) '26
    keyword = AspToAspX_CheckDBNull(rs.Fields ( "Content" ) .Value) '27
    p1 = InStr ( 1 , strRequest , keyword , 1 ) '28
    p2 = InStr ( 1 , strRequest , Server.URLEncode ( keyword ) , 1 ) '29
    If AspToAspX_CheckDBNull ( p1 ) > 0 Or AspToAspX_CheckDBNull ( p2 ) > 0 Then '30
        Response.Write ( "<br><br>禁止使用关键字： " & keyword ) '31
        Response.End ( ) '32
        Exit Sub '33
    End If '34
    rs.MoveNext ( ) '35
    End While '36
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\ARREST.ASP checkKeywordArrest:" & Err.Description)
    Resume Next
End Sub
#Region "..."
#End Region
End Class