htmlencode2.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_HTMLENCODE2

    Public AspToAspX_Host_Class_Object As Object

Dim _aspx_AspToAspX_Str,_aspx_i
#Region "..."
    Public Sub AspToAspX_InitIncludeFiles()
    End Sub

    Public Sub AspToAspX_UnloadIncludeFiles()
    End Sub

#End Region
    Public Sub AspToAspX_Page_Init()
    On Error GoTo _AspToAspX_Err
    Response.Write ( vbCrLf )

        Exit Sub
    _AspToAspX_Err:
        AspToAspX_WriteLog ("htmlencode2_aspx Page_Init:" & Err.Description)
        Resume Next
        End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\HTMLENCODE2.ASP
Function htmlencode2(ByRef  AspToAspX_Str )
On Error GoTo _AspToAspX_Err
    Dim result
    Dim l
    Dim i
    If IsDBNull ( AspToAspX_Str ) Then '5
        htmlencode2 = "" '6
        Exit Function '7
    End If '8
    l = AspToAspX_Len ( AspToAspX_Str ) '9
    result = "" '10
    For i = 1 To Val ( l ) '12
        Select Case mid ( AspToAspX_Str , i , 1 ) '13
            Case "<" '14
                result = result + "&lt;" '15
            Case ">" '16
                result = result + "&gt;" '17
            Case chr ( 13 ) '18
                result = result + "<br>" '19
            Case chr ( 34 ) '20
                result = result + "&quot;" '21
            Case "&" '22
                result = result + "&amp;" '23
            Case chr ( 32 ) '24
                If AspToAspX_CheckDBNull ( AspToAspX_CheckExpression ( i ) + 1 ) < = l And AspToAspX_CheckDBNull ( AspToAspX_CheckExpression ( i ) - 1 ) > 0 Then '26
                    If AspToAspX_CheckDBNull ( mid ( AspToAspX_Str , AspToAspX_CheckExpression ( i ) + 1 , 1 ) ) = chr ( 32 ) Or AspToAspX_CheckDBNull ( mid ( AspToAspX_Str , AspToAspX_CheckExpression ( i ) + 1 , 1 ) ) = chr ( 9 ) Or AspToAspX_CheckDBNull ( mid ( AspToAspX_Str , AspToAspX_CheckExpression ( i ) - 1 , 1 ) ) = chr ( 32 ) Or AspToAspX_CheckDBNull ( mid ( AspToAspX_Str , AspToAspX_CheckExpression ( i ) - 1 , 1 ) ) = chr ( 9 ) Then '27
                        result = result + "&nbsp;" '28
                    Else '29
                        result = result + " " '30
                    End If '31
                Else '32
                    result = result + "&nbsp;" '33
                End If '34
            Case chr ( 9 ) '35
                result = result + "    " '36
            Case Else '37
                result = result + mid ( AspToAspX_Str , i , 1 ) '38
        End Select '39
    Next '40
    htmlencode2 = result '41
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\HTMLENCODE2.ASP htmlencode2:" & Err.Description)
    Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\HTMLENCODE2.ASP
Function unhtmlencode2(ByRef  AspToAspX_Str )
On Error GoTo _AspToAspX_Err
    Dim result
    If IsDBNull ( AspToAspX_Str ) Then '46
        unhtmlencode2 = "" '47
        Exit Function '48
    End If '49
    result = AspToAspX_Str '50
    result = replace ( result , "<br>" , chr ( 13 ) ) '51
    result = replace ( result , "&nbsp;" , "" ) '52
    unhtmlencode2 = result '53
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\HTMLENCODE2.ASP unhtmlencode2:" & Err.Description)
    Resume Next
End Function
#Region "..."
    Public Property AspToAspX_Str
        Get
            On Error Resume Next
            AspToAspX_Str = AspToAspX_Host_Class_Object.AspToAspX_Str
            If Err.Number = 438 Then
                Err.Clear
                AspToAspX_Str = _aspx_AspToAspX_Str
            End If
        End Get
        Set(ByVal value)
            On Error Resume Next
            AspToAspX_Host_Class_Object.AspToAspX_Str = value
            If Err.Number = 438 Then
                Err.Clear
                _aspx_AspToAspX_Str = value
            End If
        End Set
    End Property
    Public Property i
        Get
            On Error Resume Next
            i = AspToAspX_Host_Class_Object.i
            If Err.Number = 438 Then
                Err.Clear
                i = _aspx_i
            End If
        End Get
        Set(ByVal value)
            On Error Resume Next
            AspToAspX_Host_Class_Object.i = value
            If Err.Number = 438 Then
                Err.Clear
                _aspx_i = value
            End If
        End Set
    End Property
#End Region
End Class