asptoaspxglobal.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]              *
' ***************************************************
Module AspToAspXGlobal
Public Interface AspToAspX_Interface
    Inherits System.Web.SessionState.IRequiresSessionState
End Interface
Public Server As System.Web.HttpServerUtility
Public Request As System.Web.HttpRequest
Public Response As System.Web.HttpResponse
Public Session As System.Web.SessionState.HttpSessionState
Public Application As System.Web.HttpApplicationState
Public AspToAspX_Object As Object
Public AspToAspX_JScriptObject As MSScriptControl.ScriptControl
Function AspToAspX_CheckIsNothing(theObject)As String
On Error Resume Next
    If IsNothing(theObject) Then
        AspToAspX_CheckIsNothing = ""
    ElseIf VarType(theObject).ToString = "String" Then
        AspToAspX_CheckIsNothing = theObject.ToString
    Else
        AspToAspX_CheckIsNothing = theObject.Value
    End If
End Function
Function AspToAspX_CheckIsNumeric(theValue) As Boolean
On Error Resume Next
    If theValue Is Nothing Then
        Return False
    ElseIf VarType(theValue).ToString = "String" Then
        Return (theValue = "" Or IsNumeric(theValue))
    Else
        Return IsNumeric(theValue)
    End If
End Function
Function AspToAspX_ConvertDbl(theValue) As Double
On Error Resume Next
    If VarType(theValue).ToString = "Date" Then
        Return theValue.ToOADate()
    ElseIf IsNumeric(theValue) Then
        Return CDbl(theValue)
    Else
        Return 0
    End If
End Function
Function AspToAspX_ConvertBool(theValue) As Boolean
On Error Resume Next
    Return Convert.ToBoolean(theValue)
End Function
Function AspToAspX_DateDiff(theValue1, theValue2, theValue3)
On Error Resume Next
    If IsNumeric(theValue2) Then theValue2 = DateTime.FromOADate(theValue2)
    If IsNumeric(theValue3) Then theValue3 = DateTime.FromOADate(theValue3)
    Return DateDiff(theValue1,theValue2,theValue3)
End Function
Function AspToAspX_InStrB(intBeg, theValue1, theValue2, compare)
On Error Resume Next
    Return InStr(intBeg, System.Text.Encoding.AscII.GetString(theValue1), theValue2,compare)
End Function
Function AspToAspX_InStrB(intBeg, theValue1, theValue2)
On Error Resume Next
    Return InStr(intBeg, System.Text.Encoding.AscII.GetString(theValue1), theValue2)
End Function
Function AspToAspX_InStrB(theValue1, theValue2)
On Error Resume Next
    Return InStr(1, System.Text.Encoding.AscII.GetString(theValue1), theValue2)
End Function
Function AspToAspX_MidB(theValue, intBeg, intLen)
On Error Resume next
    Return Mid(System.Text.Encoding.AscII.GetString(theValue), intBeg, intLen)
End Function
Function AspToAspX_MidB(theValue, intBeg)
On Error Resume next
    Return Mid(System.Text.Encoding.AscII.GetString(theValue), intBeg, Len(theValue))
End Function
Function AspToAspX_Int(theValue) As Integer
On Error Resume Next
    If IsNumeric(theValue) Then
        If VarType(theValue).ToString = "Char" Then
            AspToAspX_Int = Val(theValue)
        Else
            AspToAspX_Int = CInt(Int(theValue))
        End If
    Else
        AspToAspX_Int = 0
    End If
End Function
Function AspToAspX_CInt(theValue) As Integer
On Error Resume Next
    If IsNumeric(theValue) Then
        If VarType(theValue).ToString = "Char" Then
            AspToAspX_CInt = Val(theValue)
        Else
            AspToAspX_CInt = CInt(theValue)
        End If
    Else
        AspToAspX_CInt = 0
    End If
End Function
Sub AspToAspX_Response_BinaryWrite(ByVal strTemp)
    Dim bf() As Byte
    Dim intX As Long
    Response.Clear()
    If IsArray(strTemp) Then
        Response.BinaryWrite (strTemp)
    Else
        For intX = 1 To Len(strTemp.ToString)
            ReDim Preserve bf(intX - 1)
            bf(intX - 1) = Asc(Mid(strTemp.ToString, intX, 1))
        Next
        Response.BinaryWrite (bf)
    End If
    Response.Flush()
End Sub
Sub AspToAspX_Response_Redirect(ByVal strTemp)
    If Left(strTemp,1) = "?" Then strTemp = Request.Path & strTemp
    Response.Redirect (strTemp)
End Sub
Public Function Eval(ByRef strEval)
On Error Resume Next
    Dim EvalObject As New MSScriptControl.ScriptControl
    EvalObject.Language = "VBScript"
    Eval = EvalObject.Eval(strEval)
    EvalObject = Nothing
End Function
Public Sub Execute(ByRef strExecute)
On Error Resume Next
    Dim ExecuteObject As New MSScriptControl.ScriptControl
    ExecuteObject.Language = "VBScript"
    ExecuteObject.AddObject ("Me", AspToAspX_Object, True)
    ExecuteObject.ExecuteStatement (strExecute)
    ExecuteObject = Nothing
End Sub
Public Sub ExecuteGlobal(ByRef strExecute)
On Error Resume Next
    Dim ExecuteObject As New MSScriptControl.ScriptControl
    ExecuteObject.Language = "VBScript"
    ExecuteObject.AddObject ("Me", AspToAspX_Object, True)
    ExecuteObject.ExecuteStatement (strExecute)
    ExecuteObject = Nothing
End Sub
Public Function AspToAspX_CStr(ByVal theValue)
On Error Resume Next
    If VarType(theValue).ToString() = "Object" Then
        Return CStr(theValue.Value)
    Else
        Return CStr(theValue)
    End If
End Function
Public Function AspToAspX_Split(ByVal theValue1, Optional ByVal theValue2 = "",Optional ByVal theValue3 = -1,Optional ByVal theValue4 = 0)
    Dim theArray
    If theValue1 = "" Then
        ReDim theArray(-1)
        Return theArray
    Else
        Return Split(theValue1, theValue2, theValue3, theValue4)
    End If
End Function
Function AspToAspX_CheckIsNull(ByVal theValue)
    If VarType(theValue).ToString = "Null" Then
        Return True
    Else
        Return False
    End If
End Function
Function AspToAspX_CheckDBNull(ByVal theValue)
    If VarType(theValue).ToString = "Null" Or VarType(theValue).ToString = "Object" Or theValue Is Nothing Then
        Return Nothing
    ElseIf VarType(theValue).ToString = "Boolean" Or VarType(theValue).ToString = "Date" Or VarType(theValue).ToString = "Long" Or VarType(theValue).ToString = "Integer" Or VarType(theValue).ToString = "Double" Then
        Return theValue
    Else
        Return CStr(theValue)
    End If
End Function
Function AspToAspX_CheckNumber(ByVal theValue)
    If VarType(theValue).ToString = "Null" Or VarType(theValue).ToString = "Object" Then
        Return 0
    ElseIf VarType(theValue).ToString = "String" Then
        If IsNumeric(theValue) Then
            Return theValue
        Else
            Return 0
        End If
    Else
        Return theValue
    End If
End Function
Function AspToAspX_CheckExpression(ByVal theValue)
    If VarType(theValue).ToString = "Null" Or VarType(theValue).ToString = "Object" Then
        Return 0
    ElseIf VarType(theValue).ToString = "String" Then
        If IsNumeric(theValue) Then
            Return theValue
        Else
            Return 0
        End If
    Else
        Return theValue
    End If
End Function
Function AspToAspX_CheckIsObject(ByVal theValue) As Boolean
    If VarType(theValue).ToString() = "Object" Then
        If theValue Is Nothing Then
            Return False
        End If
        Return True
    Else
        Return False
    End If
End Function
Function AspToAspX_GetRequestCookies()
    Return Request.Cookies
End Function
Function AspToAspX_GetRequestCookies(ByVal Item1, ByVal Item2) As String
    If Request.Cookies(Item1) Is Nothing Then
          Return ""
    Else
        Return (Request.Cookies(Item1).Values(Item2))
    End If
End Function
Function AspToAspX_GetRequestCookies(ByVal Item1) As String
    If Request.Cookies(Item1) Is Nothing Then
          Return ""
    Else
        Return (Request.Cookies(Item1).Value)
    End If
End Function
Public Function AspToAspX_Request_GetValues(ByVal theValue1, ByVal theValue2) As String
    If Request.Form(theValue1) <> "" Then
        Return Request.Form.GetValues(theValue1)(theValue2)