⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 io

📁 WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品
💻
📖 第 1 页 / 共 2 页
字号:
            SetItem strName, strValue, clsItem(ITEM_FORM)
        Else
            Set clsFile = vbsre.mocom.util.FileItem.newInstance()
            clsFile.Name = strName
            clsFile.Size = intPos2 - intPos3 - 4'4 = LenB("--") + LenB(vbCrLfB)
            clsFile.FileName = strFileName
            If clsFile.Size < 1 Then
                clsFile.State = 1
            ElseIf clsFile.Size > lngFileBytes Then
                clsFile.State = 2
            Else
                clsFile.Value = StreamToBinary(intPos3, clsFile.Size)
                info = GetFileInfo2(clsFile.Value)
                clsFile.FileExt = info(0)
                clsFile.Width = info(1)
                clsFile.Height = info(2)
                If clsFile.FileExt = "" Then
                    clsFile.FileExt = fso.GetExtensionName(clsFile.FileName)
                End If
                If clsFile.FileExt = "" Then
                    clsFile.State = 3
                ElseIf InString(strAllow, clsFile.FileExt, False) Then
                    If InString("gif|png|jpg|bmp", clsFile.FileExt, False) And (clsFile.Width = 0 Or clsFile.Height = 0) Then
                        clsFile.State = 4
                    Else
                        clsFile.State = 0
                    End If
                Else
                    clsFile.State = 5
                End If
            End If
            Set clsItem(ITEM_FILE)(i) = clsFile
            If clsProc Is Nothing Then
                'pass
            ElseIf Not clsProc.Exists("OnUpload") Then
                'pass
            Else
                clsProc.Invoke "OnUpload", Array(clsFile)
            End If
            Set clsFile = Nothing
            i = i + 1
        End If
        intPos1 = intPos2
    Loop
    Set objTemp = Nothing
End Sub

Private Function GetMultiAttr(ByVal strData, ByVal strStart, ByVal strEnd)
    Dim intPos1, intPos2
    intPos1 = InStr(strData, strStart)
    If intPos1 = 0 Then Exit Function
    intPos1 = intPos1 + Len(strStart)
    intPos2 = InStr(intPos1, strData, strEnd)
    If intPos2 = 0 Then Exit Function
    GetMultiAttr = Mid(strData, intPos1, intPos2 - intPos1)
End Function

Private Function StreamToString(ByVal intPos, ByVal intLen)
    objTemp.Type = adTypeBinary
    objTemp.Open

    objInput.Position = intPos - 1
    objInput.CopyTo objTemp, intLen
    
    objTemp.Position = 0
    objTemp.Type = adTypeText
    objTemp.Charset = GetCharset(Session.CodePage)
    StreamToString = Replace(objTemp.ReadText(), Chr(0), "")
    objTemp.Close
End Function

Private Function StreamToBinary(ByVal intPos, ByVal intLen)
    objInput.Position = intPos - 1
    StreamToBinary = objInput.Read(intLen)
End Function

'Response Extension
Public Property Get Buffer()
    Buffer = Response.Buffer
End Property

Public Property Let Buffer(ByVal blnValue)
    Response.Buffer = blnValue
End Property

Public Property Get Status()
    Status = Response.Status
End Property

Public Property Let Status(ByVal strValue)
    Response.Status = strValue
End Property

Public Property Get ContentType()
    ContentType = Response.ContentType
End Property

Public Property Let ContentType(ByVal strValue)
    Response.ContentType = strValue
End Property

Public Property Get Charset()
    Charset = Response.Charset
End Property

Public Property Let Charset(ByVal strValue)
    Response.Charset = strValue
End Property

Public Property Get CacheControl()
    CacheControl = Response.CacheControl
End Property

Public Property Let CacheControl(ByVal strValue)
    Response.CacheControl = strValue
End Property

Public Property Get Expires()
    Expires = Response.Expires
End Property

Public Property Let Expires(ByVal strValue)
    Response.Expires = strValue
End Property

Public Property Get ExpiresAbsolute()
    ExpiresAbsolute = Response.ExpiresAbsolute
End Property

Public Property Let ExpiresAbsolute(ByVal strValue)
    Response.ExpiresAbsolute = strValue
End Property

Public Property Get IsClientConnected()
    IsClientConnected = Response.IsClientConnected
End Property

Public Property Get Pics()
    Pics = Response.Pics
End Property

Public Property Let Pics(ByVal strValue)
    Response.Pics = strValue
End Property

Public Sub AddHeader(ByVal strName, ByVal vtValue)
    Response.AddHeader strName, vtValue
End Sub

Public Sub AppendToLog(ByVal strData)
    Response.AppendToLog strData
End Sub

Public Sub Redirect(ByVal strURL)
    Response.Redirect strURL
End Sub

Public Sub Echo(ByVal vtData)
    Response.Write vtData
End Sub

Public Sub BinaryWrite(vtData)
    Response.BinaryWrite vtData
End Sub

Public Sub Clear()
    Response.Clear
End Sub

Public Sub Flush()
    Response.Flush
End Sub

Public Sub Finish()
    Response.End
End Sub

'Server Extension
Public Function HTMLEncode(ByVal vtData)
    If IsNull(vtData) Then Exit Function
    Dim ret
    ret = vtData
    ret = Replace(ret, "&", "&amp;")
    ret = Replace(ret, "<", "&lt;")
    ret = Replace(ret, ">", "&gt;")
    ret = Replace(ret, Chr(34), "&quot;")
    HTMLEncode = ret
End Function

Public Function HTMLDecode(ByVal vtData)
    If IsNull(vtData) Then Exit Function
    Dim ret
    ret = vtData
    ret = Replace(ret, "&quot;", Chr(34))
    ret = Replace(ret, "&gt;", ">")
    ret = Replace(ret, "&lt;", "<")
    ret = Replace(ret, "&amp;", "&")
    HTMLDecode = ret
End Function

Public Function URLEncode(ByVal vtData)
    If IsNull(vtData) Then Exit Function
    URLEncode = Server.URLEncode(vtData)
End Function

Public Function MapPath(ByVal strPath)
    MapPath = Server.MapPath(strPath)
End Function

Public Sub Transfer(ByVal strPath)
    Server.Transfer strPath
End Sub

Public Sub Execute(ByVal strPath)
    Server.Execute strPath
End Sub

'Session Extension
Public Property Get CodePage()
    CodePage = Session.CodePage
End Property

Public Property Let CodePage(ByVal lngValue)
    Session.CodePage = lngValue
End Property

Public Property Get LCID()
    LCID = Session.LCID
End Property

Public Property Let LCID(ByVal lngValue)
    Session.LCID = lngValue
End Property

'Application Extension
Private Function GetCacheName(ByVal strName)
    Dim ret
    ret = "ASP.Cache.$1"
    ret = Replace(ret, "$1", strName)
    ret = Replace(ret, ".", "_")
    GetCacheName = ret
End Function

Public Property Get Cache(ByVal strName)
    Dim strCacheName
    strCacheName = GetCacheName(strName)
    If VarType(Application.Contents(strCacheName)) = vbObject Then
        Set Cache = Application.Contents(strCacheName)
    Else
        Cache = Application.Contents(strCacheName)
    End If
End Property

Public Property Let Cache(ByVal strName, vtValue)
    Dim strCacheName
    strCacheName = GetCacheName(strName)
    Application.Lock
    If VarType(vtValue) = vbObject Then
        Set Application.Contents(strCacheName) = vtValue
    Else
        Application.Contents(strCacheName) = vtValue
    End If
    Application.Unlock
End Property

Public Sub CacheRemove(ByVal strName)
    Application.Lock
    Application.Contents.Remove GetCacheName(strName)
    Application.Unlock
End Sub

Public Sub CacheRemoveAll()
    Application.Contents.RemoveAll
End Sub

Public Property Let Processor(ByVal clsValue)
    Set clsProc = clsValue
End Property

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -