asptoaspxglobal.vb

本程序修改自飞天BBS 7.0 将原来的ASP语法迁移为ASP.NET并封装成DLL ASP.NET相对ASP有更快的执行效率以及更高的并发访问量 基于ASP.NET的DLL可以运行在支持ASP

    Else
        Return Request.QueryString.GetValues(theValue1)(theValue2)
    End If
End Function
Function AspToAspX_Rnd(Optional ByVal theValue = 1) As Double
    If VarType(theValue) = 7 Then
        Return Rnd(theValue.ToOADate)
    Else
        Return Rnd(theValue)
    End If
End Function
Sub AspToAspX_WriteLog(ByRef strErr As String)
On Error Resume Next
Dim fLog As System.IO.StreamWriter = New System.IO.StreamWriter(Server.MapPath("AspToAspXLog.Log") , True)
fLog.WriteLine (DateAndTime.Now.ToString & strErr & vbCrLf)
fLog.Close()
End Sub
Function AspToAspX_ConvertSessionID()
On Error Resume Next
    Dim strTemp As String, strTemp1 As String, intItem As Integer
    Dim intX As Integer
    strTemp = Session.SessionID
    For intX = Len(strTemp) - 7 To Len(strTemp)
        If Not IsNumeric(Mid(strTemp, intX, 1)) Then
            intItem = Asc(Mid(strTemp, intX, 1)) - 97
            If intItem > 20 Then intItem = intItem - 20
            If intItem > 10 Then intItem = intItem - 10
            strTemp1 = strTemp1 & CStr(intItem)
        Else
            strTemp1 = strTemp1 & CStr(Mid(strTemp, intX, 1))
        End If
    Next
    AspToAspX_ConvertSessionID = strTemp1
End Function
Function Day(ByVal Data) As Integer
    If VarType(Data).ToString() = "Date" Then
        Return Data.Day
    ElseIf VarType(Data).ToString() = "Long" Or VarType(Data).ToString() = "Integer" Or VarType(Data).ToString() = "Double" Then
        Return Date.FromOADate(Data).Day
    ElseIf VarType(Data).ToString() = "String" Then
            Return Date.Parse(Data).Day
    Else
            Return Data.Day
    End If
End Function
Function Month(ByVal Data) As Integer
    If VarType(Data).ToString() = "Date" Then
        Return Data.Month
    ElseIf VarType(Data).ToString() = "Long" Or VarType(Data).ToString() = "Integer" Or VarType(Data).ToString() = "Double" Then
        Return Date.FromOADate(Data).Month
    ElseIf VarType(Data).ToString() = "String" Then
            Return Date.Parse(Data).Month
    Else
            Return Data.Month
    End If
End Function
Function Year(ByVal Data) As Integer
    If VarType(Data).ToString() = "Date" Then
        Return Data.Year
    ElseIf VarType(Data).ToString() = "Long" Or VarType(Data).ToString() = "Integer" Or VarType(Data).ToString() = "Double" Then
        Return Date.FromOADate(Data).Year
    ElseIf VarType(Data).ToString() = "String" Then
            Return Date.Parse(Data).Year
    Else
            Return Data.Year
    End If
End Function
Function Hour(ByVal Data) As Integer
    If VarType(Data).ToString() = "Date" Then
        Return Data.Hour
    ElseIf VarType(Data).ToString() = "Long" Or VarType(Data).ToString() = "Integer" Or VarType(Data).ToString() = "Double" Then
        Return Date.FromOADate(Data).Hour
    ElseIf VarType(Data).ToString() = "String" Then
            Return Date.Parse(Data).Hour
    Else
            Return Data.Hour
    End If
End Function
Function Minute(ByVal Data) As Integer
    If VarType(Data).ToString() = "Date" Then
        Return Data.Minute
    ElseIf VarType(Data).ToString() = "Long" Or VarType(Data).ToString() = "Integer" Or VarType(Data).ToString() = "Double" Then
        Return Date.FromOADate(Data).Minute
    ElseIf VarType(Data).ToString() = "String" Then
            Return Date.Parse(Data).Minute
    Else
            Return Data.Minute
    End If
End Function
Function Second(ByVal Data) As Integer
    If VarType(Data).ToString() = "Date" Then
        Return Data.Second
    ElseIf VarType(Data).ToString() = "Long" Or VarType(Data).ToString() = "Integer" Or VarType(Data).ToString() = "Double" Then
        Return Date.FromOADate(Data).Second
    ElseIf VarType(Data).ToString() = "String" Then
            Return Date.Parse(Data).Second
    Else
            Return Data.Second
    End If
End Function
Function AspToAspX_GetRequestServerVariables(Optional ByVal strName As String = "")
    If Request.ServerVariables(strName) Is Nothing Then
        Return ""
    ElseIf strName = "" Then 
        Return Request.ServerVariables
    Else
        Return Request.ServerVariables(strName).ToString()
    End If
End Function
Function AspToAspX_GetServerUrlEncode(ByVal Data) As String
    If VarType(Data).ToString() = "String" Then
        Return Server.UrlEncode(Data)
    Else
        Return Server.UrlEncode(Data.ToString())
    End If
End Function
Function AspToAspX_GetXMLFromStream(ByRef XMLStream As IO.stream) As String
    Dim XML As New System.Xml.XmlDocument()
    Dim strXML As String
    XML.Load (XMLStream)
    strXML = XML.OuterXml
    XML = Nothing
    Return strXML
End Function
Function AspToAspX_Len(ByVal theValue) As Integer
    If VarType(theValue).ToString() = "String" Then
        Return theValue.Length()
    ElseIf VarType(theValue).ToString() = "8209" Then
        Return UBound(theValue) + 1
    ElseIf theValue Is Nothing Or VarType(theValue).ToString = "Null" Then
        Return 0
    Else
        Return CStr(theValue).Length()
    End If
End Function
Function AspToAspX_VarType(ByVal theValue) As Integer
    If theValue Is Nothing Then
        Return 0
    Else
        Return VarType(theValue)
    End If
End Function
Function AspToAspX_Abs(ByVal theValue)
    Return Math.Abs(Val(theValue))
End Function
Function CreateObject(ByVal strProgID)
    Select Case Trim(UCase(strProgID))
        Case "ADODB.CONNECTION"
            Return New ADODB.Connection
        Case "ADODB.RECORDSET"
            Return New ADODB.Recordset
        Case "SCRIPTING.FILESYSTEMOBJECT"
            Return New Scripting.FileSystemObject
        Case "MSXML2.FREETHREADEDDOMDOCUMENT.3.0"
            Return New MSXML2.FreeThreadedDOMDocument30
        Case "MSXML2.XSLTEMPLATE.3.0"
            Return New MSXML2.XSLTemplate30
        Case "MICROSOFT.XMLDOM"
            Return New MSXML2.DOMDocument
        Case "MICROSOFT.FREETHREADEDXMLDOM"
            Return New MSXML2.FreeThreadedDOMDocument
        Case "SCRIPTING.DICTIONARY"
            Return New Scripting.Dictionary
        Case "MSWC.BROWSERTYPE"
            Return Request.Browser
        Case "ADOX.CATALOG"
            Return New ADOX.Catalog
        Case Else
            Return Server.CreateObject(strProgID)
    End Select
End Function
Public Class Empty
    Public Shared ReadOnly Value = New Empty
    Public Shared Operator =(ByVal theValue As Object, ByVal objEmpty As Empty) As Boolean
        Return CheckIsEmpty(theValue)
    End Operator
    Public Shared Operator <>(ByVal theValue As Object, ByVal objEmpty As Empty) As Boolean
        Return Not CheckIsEmpty(theValue)
    End Operator
    Private Shared Function CheckIsEmpty(ByVal theValue As Object) As Boolean
        If VarType(theValue).ToString = "Null" Then
            Return True
        End If
        If VarType(theValue).ToString = "String" Then
            Return theValue = ""
        End If
        If (VarType(theValue).ToString = "Integer" Or VarType(theValue).ToString = "Double" Or VarType(theValue).ToString = "Long") Then
            Return theValue = 0
        End If
        If VarType(theValue).ToString = "Object" Then
            Return theValue Is Nothing
        End If
    End Function
End Class
Public Class Now
    Public Shared ReadOnly Value = New Now
    Public Shared Operator +(ByVal objNow As Now,ByVal theValue As Object) As Date
        Return DateAndTime.Now.AddDays(theValue)
    End Operator
    Public Shared Operator +(ByVal theValue As Object,ByVal objNow As Now) As Date
        Return DateAndTime.Now.AddDays(theValue)
    End Operator
    Public Shared Operator -(ByVal objNow As Now,ByVal theValue As Object) As Date
        Return DateAndTime.Now.AddDays(-theValue)
    End Operator
End Class
   Public Class EmptyString
        Public Shared ReadOnly Value = New EmptyString
        Public Shared Operator =(ByVal theValue As Object, ByVal obj As EmptyString) As Boolean
            If VarType(theValue).ToString = "String" Then
                Return theValue = ""
            ElseIf VarType(theValue).ToString = "Null" Then
                Return True
            ElseIf theValue Is Nothing Then
                Return True
            Else
                Return False
            End If
        End Operator
        Public Shared Operator <>(ByVal theValue As Object, ByVal obj As EmptyString) As Boolean
            If VarType(theValue).ToString = "String" Then
                Return theValue <> ""
            ElseIf VarType(theValue).ToString = "Null" Then
                Return False
            ElseIf theValue Is Nothing Then
                Return False
            Else
                Return True
            End If
        End Operator
    End Class
End Module