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

    Public AspToAspX_Host_Class_Object As Object

Public Const nSaturation = 90
Public Const nBlankNoisyDotOdds = 0.0
Public Const nColorNoisyDotOdds = 0.0
Public Const nNoisyLineCount = 1
Public Const nCharMin = 4
Public Const nCharMax = 4
Public Const nSpaceX = 2
Public Const nSpaceY = 2
Public Const nImgWidth = 60
Public Const nImgHeight = 16
Public Const nCharWidthRandom = 16
Public Const nCharHeightRandom = 16
Public Const nPositionXRandom = 10
Public Const nPositionYRandom = 10
Public Const nAngleRandom = 6
Public Const nLengthRandom = 6
Public Const nColorHue = - 2
Public Const cCharSet = "0123456789"
Public Buf,DigtalStr
Public Lines,LineCount
Public CursorX,CursorY,DirX,DirY,nCharCount,nPixelWidth,nPixelHeight,PicWidth,PicHeight
#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
    Response.Expires = - 9999 '5
    Response.Charset = "utf-8" '6
    Response.AddHeader ( "Pragma" , "no-cache" ) '7
    Response.AddHeader ( "cache-ctrol" , "no-cache" ) '8
    Response.ContentType = "Image/BMP" '9
    Randomize ( ) '28
    nCharCount = nCharMin + AspToAspX_CInt ( AspToAspX_Rnd * ( nCharMax - nCharMin ) ) '32
    PicWidth = nImgWidth + 2 * nSpaceX '33
    PicHeight = nImgHeight + 2 * nSpaceY '34
    CreatValidCode ( "GetCode" & trim ( Request ( "s" ) ) ) '35
    Response.Write ( vbCrLf )

        AspToAspX_UnloadIncludeFiles()
        Exit Sub
    _AspToAspX_Err:
        AspToAspX_WriteLog ("ftbbscode_aspx Page_Init:" & Err.Description)
        Resume Next
        End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_Reset()
On Error Goto _AspToAspX_Err
    LineCount = 0 '37
    CursorX = 0 '38
    CursorY = 0 '39
    DirX = 0 '40
    DirY = 1 '41
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_Reset:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_Clear()
On Error Goto _AspToAspX_Err
    Dim i
    Dim j
    ReDim Buf ( PicHeight - 1 , PicWidth - 1 ) '45
    For j = 0 To Val ( PicHeight ) - 1 '46
        For i = 0 To Val ( PicWidth ) - 1 '47
            Buf ( j , i ) = 0 '48
        Next '49
    Next '50
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_Clear:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_PSet(ByRef  X,ByRef Y )
On Error Goto _AspToAspX_Err
    If AspToAspX_CheckDBNull ( X ) > = 0 And AspToAspX_CheckDBNull ( X ) < PicWidth And AspToAspX_CheckDBNull ( Y ) > = 0 And AspToAspX_CheckDBNull ( Y ) < PicHeight Then
Buf ( Y , X ) = 1
End If
   '53
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_PSet:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_Line(ByRef  X1,ByRef Y1,ByRef X2,ByRef Y2 )
On Error Goto _AspToAspX_Err
    Dim DX
    Dim DY
    Dim DeltaT
    Dim i
    DX = X2 - X1 '57
    DY = Y2 - Y1 '58
    If AspToAspX_Abs ( DX ) > AspToAspX_Abs ( DY ) Then
DeltaT = AspToAspX_Abs ( DX )
Else
DeltaT = AspToAspX_Abs ( DY )
End If
   '59
        If AspToAspX_CheckDBNull ( DeltaT ) = 0 Then '60
            CDGen_PSet ( AspToAspX_CInt ( X1 ) , AspToAspX_CInt ( Y1 ) ) '61
        Else '62
            For i = 0 To Val ( DeltaT ) '63
                CDGen_PSet ( AspToAspX_CInt ( X1 + DX * i / DeltaT ) , AspToAspX_CInt ( Y1 + DY * i / DeltaT ) ) '64
            Next '65
        End If '66
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_Line:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_FowardDraw(ByRef  nLength )
On Error Goto _AspToAspX_Err
    nLength = nLength * ( 1 + ( AspToAspX_Rnd * 2 - 1 ) * nLengthRandom / 100 ) '69
    ReDim Preserve Lines ( 3 , LineCount ) '70
    Lines ( 0 , LineCount ) = CursorX '71
    Lines ( 1 , LineCount ) = CursorY '72
    CursorX = CursorX + DirX * nLength '73
    CursorY = CursorY + DirY * nLength '74
    Lines ( 2 , LineCount ) = CursorX '75
    Lines ( 3 , LineCount ) = CursorY '76
    LineCount = LineCount + 1 '77
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_FowardDraw:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_SetDirection(ByRef  nAngle )
On Error Goto _AspToAspX_Err
    Dim DX
    Dim DY
    nAngle = ( nAngle + ( AspToAspX_Rnd * 2 - 1 ) * nAngleRandom ) / 180 * 3.1415926 '81
    DX = DirX '82
    DY = DirY '83
    DirX = DX * Cos ( nAngle ) - DY * Sin ( nAngle ) '84
    DirY = DX * Sin ( nAngle ) + DY * Cos ( nAngle ) '85
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_SetDirection:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_MoveToMiddle(ByRef  nActionIndex,ByRef nPercent )
On Error Goto _AspToAspX_Err
    Dim DeltaX
    Dim DeltaY
    DeltaX = Lines ( 2 , nActionIndex ) - Lines ( 0 , nActionIndex ) '89
    DeltaY = Lines ( 3 , nActionIndex ) - Lines ( 1 , nActionIndex ) '90
    CursorX = Lines ( 0 , nActionIndex ) + DeltaX * nPercent / 100 '91
    CursorY = Lines ( 1 , nActionIndex ) + DeltaY * AspToAspX_Abs ( DeltaY ) * nPercent / 100 '92
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_MoveToMiddle:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_MoveCursor(ByRef  nActionIndex )
On Error Goto _AspToAspX_Err
    CursorX = Lines ( 0 , nActionIndex ) '95
    CursorY = Lines ( 1 , nActionIndex ) '96
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_MoveCursor:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_Close(ByRef  nActionIndex )
On Error Goto _AspToAspX_Err
    ReDim Preserve Lines ( 3 , LineCount ) '99
    Lines ( 0 , LineCount ) = CursorX '100
    Lines ( 1 , LineCount ) = CursorY '101
    CursorX = Lines ( 0 , nActionIndex ) '102
    CursorY = Lines ( 1 , nActionIndex ) '103
    Lines ( 2 , LineCount ) = CursorX '104
    Lines ( 3 , LineCount ) = CursorY '105
    LineCount = LineCount + 1 '106
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_Close:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_CloseToMiddle(ByRef  nActionIndex,ByRef nPercent )
On Error Goto _AspToAspX_Err
    Dim DeltaX
    Dim DeltaY
    ReDim Preserve Lines ( 3 , LineCount ) '110
    Lines ( 0 , LineCount ) = CursorX '111
    Lines ( 1 , LineCount ) = CursorY '112
    DeltaX = Lines ( 2 , nActionIndex ) - Lines ( 0 , nActionIndex ) '113
    DeltaY = Lines ( 3 , nActionIndex ) - Lines ( 1 , nActionIndex ) '114
    CursorX = Lines ( 0 , nActionIndex ) + Sign ( DeltaX ) * AspToAspX_Abs ( DeltaX ) * nPercent / 100 '115
    CursorY = Lines ( 1 , nActionIndex ) + Sign ( DeltaY ) * AspToAspX_Abs ( DeltaY ) * nPercent / 100 '116
    Lines ( 2 , LineCount ) = CursorX '117
    Lines ( 3 , LineCount ) = CursorY '118
    LineCount = LineCount + 1 '119
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_CloseToMiddle:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_Flush(ByRef  X0,ByRef Y0 )
On Error Goto _AspToAspX_Err
    Dim MaxX
    Dim MinX
    Dim MaxY
    Dim MinY
    Dim DeltaX
    Dim DeltaY
    Dim StepX
    Dim StepY
    Dim OffsetX
    Dim OffsetY
    Dim i
    MaxX = MinX = MaxY = MinY = 0 '125
    For i = 0 To Val ( LineCount ) - 1 '126
    If AspToAspX_CheckDBNull ( MaxX ) < Lines ( 0 , i ) Then
MaxX = Lines ( 0 , i )
End If
   '127
    If AspToAspX_CheckDBNull ( MaxX ) < Lines ( 2 , i ) Then
MaxX = Lines ( 2 , i )
End If
   '128
    If AspToAspX_CheckDBNull ( MinX ) > Lines ( 0 , i ) Then
MinX = Lines ( 0 , i )
End If
   '129
    If AspToAspX_CheckDBNull ( MinX ) > Lines ( 2 , i ) Then
MinX = Lines ( 2 , i )
End If
   '130
    If AspToAspX_CheckDBNull ( MaxY ) < Lines ( 1 , i ) Then
MaxY = Lines ( 1 , i )
End If
   '131
    If AspToAspX_CheckDBNull ( MaxY ) < Lines ( 3 , i ) Then
MaxY = Lines ( 3 , i )
End If
   '132
    If AspToAspX_CheckDBNull ( MinY ) > Lines ( 1 , i ) Then
MinY = Lines ( 1 , i )
End If
   '133
    If AspToAspX_CheckDBNull ( MinY ) > Lines ( 3 , i ) Then
MinY = Lines ( 3 , i )
End If
   '134
    Next '135
    DeltaX = MaxX - MinX '136
    DeltaY = MaxY - MinY '137
    If AspToAspX_CheckDBNull ( DeltaX ) = 0 Then
DeltaX = 1
End If
   '138
    If AspToAspX_CheckDBNull ( DeltaY ) = 0 Then
DeltaY = 1
End If
   '139
        MaxX = MinX '140
        MaxY = MinY '141
        If AspToAspX_CheckDBNull ( DeltaX ) > DeltaY Then '142
            StepX = ( nPixelWidth - 2 ) / DeltaX '143
            StepY = ( nPixelHeight - 2 ) / DeltaX '144
            OffsetX = 0 '145
            OffsetY = ( DeltaX - DeltaY ) / 2 '146
        Else '147
            StepX = ( nPixelWidth - 2 ) / DeltaY '148
            StepY = ( nPixelHeight - 2 ) / DeltaY '149
            OffsetX = ( DeltaY - DeltaX ) / 2 '150
            OffsetY = 0 '151
        End If '152
        For i = 0 To Val ( LineCount ) - 1 '153
            Lines ( 0 , i ) = Round ( ( Lines ( 0 , i ) - MaxX + OffsetX ) * StepX , 0 ) '154
            Lines ( 1 , i ) = Round ( ( Lines ( 1 , i ) - MaxY + OffsetY ) * StepY , 0 ) '155
            Lines ( 2 , i ) = Round ( ( Lines ( 2 , i ) - MinX + OffsetX ) * StepX , 0 ) '156
            Lines ( 3 , i ) = Round ( ( Lines ( 3 , i ) - MinY + OffsetY ) * StepY , 0 ) '157
            CDGen_Line ( Lines ( 0 , i ) + X0 + 1 , Lines ( 1 , i ) + Y0 + 1 , Lines ( 2 , i ) + X0 + 1 , Lines ( 3 , i ) + Y0 + 1 ) '158
        Next '159
    Exit Sub
_AspToAspX_Err:
    AspToAspX_WriteLog ("E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP CDGen_Flush:" & Err.Description)
    Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\FTBBSCODE.ASP
Sub CDGen_Char(ByRef  AspToAspX_CChar,ByRef X0,ByRef Y0 )
On Error Goto _AspToAspX_Err
    CDGen_Reset ( ) '162
    Select Case AspToAspX_CChar '163
        Case "0" '164
            CDGen_SetDirection ( - 60 ) '165