📄 code.aspx.vb
字号:
' ***************************************************
' * 本程序由AspToAspX风火轮0.99转换生成 *
' * http://Www.AspToAspX.Cn *
' * Q Q : 139227536 *
' * QQ群: 17152722 *
' * MSN : gzliangjianhua@hotmail.com *
' * EMail AspToDll@vip.163.com *
' ***************************************************
Imports Microsoft.VisualBasic
Imports System.Web
Imports System.Math
Imports System.Web.SessionState
Public Class _INC_CODE
Inherits System.Web.UI.Page
Implements IHttpHandler, AspToAspX_Interface
Public AspToAspX_Host_Class_Object As Object
Public sBASE_64_CHARACTERS
#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
sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" '2
sBASE_64_CHARACTERS = strUnicode2Ansi ( sBASE_64_CHARACTERS ) '3
Response.Write ( vbCrLf )
AspToAspX_UnloadIncludeFiles()
Exit Sub
_AspToAspX_Err:
AspToAspX_WriteLog ("code_aspx Page_Init:" & Err.Description)
Resume Next
End Sub
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP
Function strUnicodeLen(ByRef asContents )
On Error GoTo _AspToAspX_Err
Dim asContents1
Dim len1
Dim k
Dim i
Dim asc1
asContents1 = "a" & asContents '6
len1 = AspToAspX_Len ( asContents1 ) '7
k = 0 '8
For i = 1 To Val ( len1 ) '9
asc1 = Asc ( mid ( asContents1 , i , 1 ) ) '10
If AspToAspX_CheckDBNull ( asc1 ) < 0 Then
asc1 = 65536 + asc1
End If
'11
If AspToAspX_CheckDBNull ( asc1 ) > 255 Then '12
k = k + 2 '13
Else '14
k = k + 1 '15
End If '16
Next '17
strUnicodeLen = k - 1 '18
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP strUnicodeLen:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP
Function strUnicode2Ansi(ByRef asContents )
On Error GoTo _AspToAspX_Err
Dim len1
Dim i
Dim varchar
Dim varasc
Dim varHex
Dim varlow
Dim varhigh
strUnicode2Ansi = "" '22
len1 = AspToAspX_Len ( asContents ) '23
For i = 1 To Val ( len1 ) '24
varchar = mid ( asContents , i , 1 ) '25
varasc = Asc ( varchar ) '26
If AspToAspX_CheckDBNull ( varasc ) < 0 Then
varasc = varasc + 65536
End If
'27
If AspToAspX_CheckDBNull ( varasc ) > 255 Then '28
varHex = Hex ( varasc ) '29
varlow = left ( varHex , 2 ) '30
varhigh = right ( varHex , 2 ) '31
strUnicode2Ansi = strUnicode2Ansi & Chr ( "&H" & varlow ) & Chr ( "&H" & varhigh ) '32
Else '33
strUnicode2Ansi = strUnicode2Ansi & Chr ( varasc ) '34
End If '35
Next '36
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP strUnicode2Ansi:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP
Function strAnsi2Unicode(ByRef asContents )
On Error GoTo _AspToAspX_Err
Dim len1
Dim i
Dim varchar
Dim varasc
strAnsi2Unicode = "" '40
len1 = AspToAspX_Len ( asContents ) '41
If AspToAspX_CheckDBNull ( len1 ) = 0 Then
Exit Function
End If
'42
For i = 1 To Val ( len1 ) '43
varchar = AspToAspX_MidB ( asContents , i , 1 ) '44
varasc = Asc ( varchar ) '45
If AspToAspX_CheckDBNull ( varasc ) > 127 Then '46
strAnsi2Unicode = strAnsi2Unicode & chr ( Asc ( AspToAspX_MidB ( asContents , i + 1 , 1 ) & varchar ) ) '47
i = i + 1 '48
Else '49
strAnsi2Unicode = strAnsi2Unicode & chr ( varasc ) '50
End If '51
Next '52
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP strAnsi2Unicode:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP
Function Base64encode(ByRef asContents )
On Error GoTo _AspToAspX_Err
Dim lnPosition
Dim lsResult
Dim Char1
Dim Char2
Dim Char3
Dim Char4
Dim Byte1
Dim Byte2
Dim Byte3
Dim SaveBits1
Dim SaveBits2
Dim lsGroupBinary
Dim lsGroup64
Dim m4
Dim len1
Dim len2
Dim m3
len1 = AspToAspX_Len ( asContents ) '71
If AspToAspX_CheckDBNull ( len1 ) < 1 Then '72
Base64encode = "" '73
Exit Function '74
End If '75
m3 = Len1 Mod 3 '76
If AspToAspX_CheckDBNull ( M3 ) > 0 Then
asContents = asContents & New String ( Chr ( 0 ) , 3 - M3 )
End If
'77
If AspToAspX_CheckDBNull ( m3 ) > 0 Then '78
len1 = len1 + ( 3 - m3 ) '79
len2 = len1 - 3 '80
Else '81
len2 = len1 '82
End If '83
lsResult = "" '84
For lnPosition = 1 To Val ( len2 ) Step 3 '85
lsGroup64 = "" '86
lsGroupBinary = AspToAspX_MidB ( asContents , lnPosition , 3 ) '87
Byte1 = Asc ( AspToAspX_MidB ( lsGroupBinary , 1 , 1 ) )
SaveBits1 = Byte1 And 3
'88
Byte2 = Asc ( AspToAspX_MidB ( lsGroupBinary , 2 , 1 ) )
SaveBits2 = Byte2 And 15
'89
Byte3 = Asc ( AspToAspX_MidB ( lsGroupBinary , 3 , 1 ) ) '90
Char1 = AspToAspX_MidB ( sBASE_64_CHARACTERS , ( ( Byte1 And 252 ) \ 4 ) + 1 , 1 ) '91
Char2 = AspToAspX_MidB ( sBASE_64_CHARACTERS , ( ( ( Byte2 And 240 ) \ 16 ) Or ( SaveBits1 * 16 ) And &HFF ) + 1 , 1 ) '92
Char3 = AspToAspX_MidB ( sBASE_64_CHARACTERS , ( ( ( Byte3 And 192 ) \ 64 ) Or ( SaveBits2 * 4 ) And &HFF ) + 1 , 1 ) '93
Char4 = AspToAspX_MidB ( sBASE_64_CHARACTERS , ( Byte3 And 63 ) + 1 , 1 ) '94
lsGroup64 = Char1 & Char2 & Char3 & Char4 '95
lsResult = lsResult & lsGroup64 '96
Next '97
If AspToAspX_CheckDBNull ( M3 ) > 0 Then '98
lsGroup64 = "" '99
lsGroupBinary = AspToAspX_MidB ( asContents , len2 + 1 , 3 ) '100
Byte1 = Asc ( AspToAspX_MidB ( lsGroupBinary , 1 , 1 ) )
SaveBits1 = Byte1 And 3
'101
Byte2 = Asc ( AspToAspX_MidB ( lsGroupBinary , 2 , 1 ) )
SaveBits2 = Byte2 And 15
'102
Byte3 = Asc ( AspToAspX_MidB ( lsGroupBinary , 3 , 1 ) ) '103
Char1 = AspToAspX_MidB ( sBASE_64_CHARACTERS , ( ( Byte1 And 252 ) \ 4 ) + 1 , 1 ) '104
Char2 = AspToAspX_MidB ( sBASE_64_CHARACTERS , ( ( ( Byte2 And 240 ) \ 16 ) Or ( SaveBits1 * 16 ) And &HFF ) + 1 , 1 ) '105
Char3 = AspToAspX_MidB ( sBASE_64_CHARACTERS , ( ( ( Byte3 And 192 ) \ 64 ) Or ( SaveBits2 * 4 ) And &HFF ) + 1 , 1 ) '106
If AspToAspX_CheckDBNull ( M3 ) = 1 Then '107
lsGroup64 = Char1 & Char2 & Chr ( 61 ) & Chr ( 61 ) '108
Else '109
lsGroup64 = Char1 & Char2 & Char3 & Chr ( 61 ) '110
End If '111
lsResult = lsResult & lsGroup64 '112
End If '113
Base64encode = lsResult '114
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP Base64encode:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP
Function Base64decode(ByRef asContents )
On Error GoTo _AspToAspX_Err
Dim lsResult
Dim lnPosition
Dim lsGroup64
Dim lsGroupBinary
Dim Char1
Dim Char2
Dim Char3
Dim Char4
Dim Byte1
Dim Byte2
Dim Byte3
Dim M4
Dim len1
Dim len2
len1 = AspToAspX_Len ( asContents ) '125
M4 = len1 Mod 4 '126
If AspToAspX_CheckDBNull ( len1 ) < 1 Or AspToAspX_CheckDBNull ( M4 ) > 0 Then '127
Base64decode = "" '128
Exit Function '129
End If '130
If AspToAspX_MidB ( asContents , len1 , 1 ) = Chr ( 61 ) Then
m4 = 3
End If
'131
If AspToAspX_MidB ( asContents , AspToAspX_CheckExpression ( len1 ) - 1 , 1 ) = Chr ( 61 ) Then
m4 = 2
End If
'132
If AspToAspX_CheckDBNull ( m4 ) = 0 Then '133
len2 = len1 '134
Else '135
len2 = len1 - 4 '136
End If '137
For lnPosition = 1 To Val ( Len2 ) Step 4 '138
lsGroupBinary = "" '139
lsGroup64 = AspToAspX_MidB ( asContents , lnPosition , 4 ) '140
Char1 = AspToAspX_InStrB ( sBASE_64_CHARACTERS , AspToAspX_MidB ( lsGroup64 , 1 , 1 ) ) - 1 '141
Char2 = AspToAspX_InStrB ( sBASE_64_CHARACTERS , AspToAspX_MidB ( lsGroup64 , 2 , 1 ) ) - 1 '142
Char3 = AspToAspX_InStrB ( sBASE_64_CHARACTERS , AspToAspX_MidB ( lsGroup64 , 3 , 1 ) ) - 1 '143
Char4 = AspToAspX_InStrB ( sBASE_64_CHARACTERS , AspToAspX_MidB ( lsGroup64 , 4 , 1 ) ) - 1 '144
Byte1 = Chr ( ( ( Char2 And 48 ) \ 16 ) Or ( Char1 * 4 ) And &HFF ) '145
Byte2 = lsGroupBinary & Chr ( ( ( Char3 And 60 ) \ 4 ) Or ( Char2 * 16 ) And &HFF ) '146
Byte3 = Chr ( ( ( ( Char3 And 3 ) * 64 ) And &HFF ) Or ( Char4 And 63 ) ) '147
lsGroupBinary = Byte1 & Byte2 & Byte3 '148
lsResult = lsResult & lsGroupBinary '149
Next '150
If AspToAspX_CheckDBNull ( M4 ) > 0 Then '152
lsGroupBinary = "" '153
lsGroup64 = AspToAspX_MidB ( asContents , len2 + 1 , m4 ) & Chr ( 65 ) '154
If AspToAspX_CheckDBNull ( M4 ) = 2 Then '155
lsGroup64 = lsGroup64 & Chr ( 65 ) '156
End If '157
Char1 = AspToAspX_InStrB ( sBASE_64_CHARACTERS , AspToAspX_MidB ( lsGroup64 , 1 , 1 ) ) - 1 '158
Char2 = AspToAspX_InStrB ( sBASE_64_CHARACTERS , AspToAspX_MidB ( lsGroup64 , 2 , 1 ) ) - 1 '159
Char3 = AspToAspX_InStrB ( sBASE_64_CHARACTERS , AspToAspX_MidB ( lsGroup64 , 3 , 1 ) ) - 1 '160
Char4 = AspToAspX_InStrB ( sBASE_64_CHARACTERS , AspToAspX_MidB ( lsGroup64 , 4 , 1 ) ) - 1 '161
Byte1 = Chr ( ( ( Char2 And 48 ) \ 16 ) Or ( Char1 * 4 ) And &HFF ) '162
Byte2 = lsGroupBinary & Chr ( ( ( Char3 And 60 ) \ 4 ) Or ( Char2 * 16 ) And &HFF ) '163
Byte3 = Chr ( ( ( ( Char3 And 3 ) * 64 ) And &HFF ) Or ( Char4 And 63 ) ) '164
If AspToAspX_CheckDBNull ( M4 ) = 2 Then '165
lsGroupBinary = Byte1 '166
ElseIf AspToAspX_CheckDBNull ( M4 ) = 3 Then '167
lsGroupBinary = Byte1 & Byte2 '168
End If '169
lsResult = lsResult & lsGroupBinary '170
End If '171
Base64decode = lsResult '172
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP Base64decode:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP
Function Encode(ByRef passwd )
On Error GoTo _AspToAspX_Err
Encode = strAnsi2Unicode ( Base64encode ( strUnicode2Ansi ( passwd ) ) ) '176
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP Encode:" & Err.Description)
Resume Next
End Function
'E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP
Function Decode(ByRef passwd )
On Error GoTo _AspToAspX_Err
Decode = strAnsi2Unicode ( Base64decode ( strUnicode2Ansi ( passwd ) ) ) '179
Exit Function
_AspToAspX_Err:
AspToAspX_WriteLog("E:\FTBBS_UTF8_7.0\UPLOAD\INC\CODE.ASP Decode:" & Err.Description)
Resume Next
End Function
#Region "..."
#End Region
End Class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -