gbtoutf8.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 _GBTOUTF8

    Public AspToAspX_Host_Class_Object As Object

#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 ("gbtoutf8_aspx Page_Init:" & Err.Description)
        Resume Next
        End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\GBTOUTF8.ASP
Function GBtoUTF8(ByRef  szInput )
On Error GoTo _AspToAspX_Err
    Dim wch
    Dim uch
    Dim szRet
    Dim x
    Dim nAsc
    Dim nAsc2
    Dim nAsc3
    If AspToAspX_CheckDBNull ( szInput ) = EmptyString.Value Then '6
        GBtoUTF8 = szInput '7
        Exit Function '8
    End If '9
    For x = 1 To Val ( AspToAspX_Len ( szInput ) ) '10
        wch = Mid ( szInput , x , 1 ) '11
        nAsc = Asc ( wch ) '12
    If AspToAspX_CheckDBNull ( nAsc ) < 0 Then
nAsc = nAsc + 65536
End If
   '13
        If ( nAsc And AspToAspX_CheckDBNull ( &HFF80 ) ) = 0 Then '14
        szRet = szRet & wch '15
    Else '16
        If ( nAsc And AspToAspX_CheckDBNull ( &HF000 ) ) = 0 Then '17
        uch = "%" & Hex ( ( ( nAsc \ 2 ^ 6 ) ) Or &HC0 ) & Hex ( nAsc And &H3F Or &H80 ) '18
        szRet = szRet & uch '19
    Else '20
        uch = "%" & Hex ( ( nAsc \ 2 ^ 12 ) Or &HE0 ) & "%" & Hex ( ( nAsc \ 2 ^ 6 ) And &H3F Or &H80 ) & "%" & Hex ( nAsc And &H3F Or &H80 ) '21
        szRet = szRet & uch '22
    End If '23
    End If '24
    Next '25
    GBtoUTF8 = szRet '26
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\GBTOUTF8.ASP GBtoUTF8:" & Err.Description)
    Resume Next
End Function
#Region "..."
#End Region
End Class