getcode.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 _GETCODE
    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
    Response.buffer = true '3
    NumCode ( ) '4
    Response.Write ( vbCrLf )

        AspToAspX_UnloadIncludeFiles()
        Exit Sub
    _AspToAspX_Err:
        AspToAspX_WriteLog ("GetCode_aspx Page_Init:" & Err.Description)
        Resume Next
        End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\GETCODE.ASP
Function NumCode()
On Error GoTo _AspToAspX_Err
    Dim zNum
    Dim i
    Dim j
    Dim Ados
    Dim Ados1
    Dim zimg( 4 )
    Dim NStr
    Dim Pos
    Response.Expires = - 1 '6
    Response.AddHeader ( "Pragma" , "no-cache" ) '7
    Response.AddHeader ( "cache-ctrol" , "no-cache" ) '8
    On Error Resume Next '9
    Randomize ( timer ) '12
    zNum = AspToAspX_CInt ( 8999 * AspToAspX_Rnd + 1000 ) '13
    Session ( "GetCode" ) = zNum '14
    NStr = AspToAspX_CStr ( zNum ) '16
    For i = 0 To 3 '17
        zimg ( i ) = AspToAspX_CInt ( mid ( NStr , i + 1 , 1 ) ) '18
    Next '19
    Ados = New ADODB.Stream ( ) '21
    Ados.Mode = 3 '22
    Ados.Type = 1 '23
    Ados.Open ( ) '24
    Ados1 = New ADODB.Stream ( ) '25
    Ados1.Mode = 3 '26
    Ados1.Type = 1 '27
    Ados1.Open ( ) '28
    Ados.LoadFromFile ( ( Server.MapPath ( "body.Fix" ) ) ) '29
    Ados1.Write ( Ados.read ( 1280 ) ) '30
    For i = 0 To 3 '31
        Ados.Position = ( 9 - zimg ( i ) ) * 320 '32
        Ados1.Position = i * 320 '33
        Ados1.Write ( ados.read ( 320 ) ) '34
    Next '35
    Ados.LoadFromFile ( ( Server.MapPath ( "head.fix" ) ) ) '36
    Pos = AspToAspX_Len ( Ados.read ) '37
    Ados.Position = Pos '38
    For i = 0 To 9 Step 1 '39
        For j = 0 To 3 '40
            Ados1.Position = i * 32 + j * 320 '41
            Ados.Position = Pos + 30 * j + i * 120 '42
            Ados.Write ( ados1.read ( 30 ) ) '43
        Next '44
    Next '45
    Response.ContentType = "image/BMP" '46
    Ados.Position = 0 '47
    AspToAspX_Response_BinaryWrite ( Ados.read ) '48
    Ados.Close ( )
Ados = Nothing
   '49
    Ados1.Close ( )
Ados1 = Nothing
   '50
    If Err.Number Then
Session ( "GetCode" ) = 9999
End If
   '51
    Exit Function
_AspToAspX_Err:
    AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\GETCODE.ASP NumCode:" & Err.Description)
    Resume Next
End Function
#Region "..."
#End Region
End Class