stdio.asp

WAPmo手机网站管理平台是一款创建与管理维护WAP网站的的软件产品

<%
'--------------------------------------------------------------------
' stdio.asp - standard io functions
'
' Copyright (c) 2006 - 2008 MOEx Group.
'
'
' last update: 2008/06/16
'
'--------------------------------------------------------------------

'--------------------------------------------------------------------
' GetFileString     - 获取指定文件路径的文件内容
'                   - 返回类型：String
'                   - arguments[0] = 文件绝对路径(type: String)
'                   - arguments[1] = 指定字符集(type: String)
'--------------------------------------------------------------------
Public Function GetFileString(ByVal strPath, ByVal strCharset)
    Dim objTemp
    Set objTemp = Server.CreateObject("ADODB.Stream")
    objTemp.Type = adTypeText
    objTemp.Mode = adModeShareExclusive
    objTemp.Charset = strCharset
    objTemp.Open
    objTemp.LoadFromFile strPath
    GetFileString = objTemp.ReadText(-1)
    objTemp.Close
    Set objTemp = Nothing
End Function

'--------------------------------------------------------------------
' GetFileBinary     - 获取指定文件路径的文件内容
'                   - 返回类型：Byte()
'                   - arguments[0] = 文件绝对路径(type: String)
'--------------------------------------------------------------------
Public Function GetFileBinary(ByVal strPath)
    Dim objTemp
    Set objTemp = Server.CreateObject("ADODB.Stream")
    objTemp.Type = adTypeBinary
    objTemp.Mode = adModeShareExclusive
    objTemp.Open
    objTemp.LoadFromFile strPath
    GetFileBinary = objTemp.Read(-1)
    objTemp.Close
    Set objTemp = Nothing
End Function

'--------------------------------------------------------------------
' SetFileString     - 添加内容至指定文件
'                   - 返回类型：
'                   - arguments[0] = 文件绝对路径(type: String)
'                   - arguments[1] = 字符集(type: String)
'                   - arguments[2] = 内容(type: String)
'                   - arguments[3] = 是否用内容覆盖当前文件中的内容(type: Boolean)
'--------------------------------------------------------------------
Public Function SetFileString(ByVal strPath, ByVal strCharset, ByVal strValue, ByVal blnRewrite)
    Dim objTemp
    Set objTemp = Server.CreateObject("ADODB.Stream")
    objTemp.Type = adTypeText
    objTemp.Mode = adModeShareExclusive
    objTemp.Charset = strCharset
    objTemp.Open
    If Not blnRewrite And fso.FileExists(strPath) Then
        objTemp.LoadFromFile strPath
        objTemp.Position = objTemp.Size
    End If
    objTemp.WriteText strValue
    objTemp.SaveToFile strPath, adSaveCreateOverWrite
    objTemp.Close
    Set objTemp = Nothing
End Function

'--------------------------------------------------------------------
' SetFileBinary     - 添加内容至指定文件
'                   - 返回类型：
'                   - arguments[0] = 文件绝对路径(type: String)
'                   - arguments[1] = 内容(type: Byte())
'                   - arguments[2] = 是否用内容覆盖当前文件中的内容(type: Boolean)
'--------------------------------------------------------------------
Public Function SetFileBinary(ByVal strPath, vtValue, ByVal blnRewrite)
    Dim objTemp
    Set objTemp = Server.CreateObject("ADODB.Stream")
    objTemp.Type = adTypeBinary
    objTemp.Mode = adModeShareExclusive
    objTemp.Open
    If Not blnRewrite And fso.FileExists(strPath) Then
        objTemp.LoadFromFile strPath
        objTemp.Position = objTemp.Size
    End If
    objTemp.Write vtValue
    objTemp.SaveToFile strPath, adSaveCreateOverWrite
    objTemp.Close
    Set objTemp = Nothing
End Function

'--------------------------------------------------------------------
' Debug             - 输出字符串
'                   - 返回类型：
'                   - arguments[0] = 字符串(type: Variant)
'--------------------------------------------------------------------
Sub Debug(ByVal vtData)
    Dim strPath
    strPath = Server.MapPath("debug/" & FormatDate(Now(), "Ymd") & ".txt")
    DetectFolder Server.MapPath("."), "debug"
    SetFileString strPath, LOCAL_CHARSET, str_format("$0 $1$2", Array(FormatDate(Now(), "H:i:s"), vtData, vbCrLf)), False
End Sub

'--------------------------------------------------------------------
' ASPInclude        - 动态执行一个ASP或HTML文件
'                   - 返回类型：
'                   - arguments[0] = 文件相对路径(type: String)
'                   - arguments[1] = 文件字符集(type: String)
'--------------------------------------------------------------------
Public Sub ASPInclude(ByVal strPath, ByVal strCharset)
    Dim strData
    Dim reg, arr, ptr, pos
    Dim tmp, ret, i, l
    strData = GetFileString(Server.MapPath(strPath), strCharset)
    Set reg = New RegExp
    reg.Global = True
    reg.IgnoreCase = True
    'parse include file
    reg.Pattern = "<!--#include\s+file=""([^""]+)""-->"
    strData = reg.Replace(strData, "<" & "%ASPInclude """ & ASPPath(strPath) & "$1"", """ & strCharset & """%" & ">")
    'parse include virtual
    reg.Pattern = "<!--#include\s+virtual=""([^""]+)""-->"
    strData = reg.Replace(strData, "<" & "%ASPInclude ""$1"", """ & strCharset & """%" & ">")
    'clear object or script tag that runat server
    reg.Pattern = "<(object|script)\s[^>]*?runat=""server""[^>]*>[\s\S]*?</\1>"
    strData = reg.replace(strData, "")
    'parse asp tag
    reg.Pattern = "<" & "%([\s\S]*?)%" & ">"
    Set arr = reg.Execute(strData)
    If arr.Count > 0 Then
        ReDim tmp(arr.Count * 2)
        pos = 1
        i = 0
        For Each ptr In arr
            l = ptr.FirstIndex + 1 - pos
            If l > 0 Then
                tmp(i) = "Response.Write Mid(strData, " & pos & ", " & l & ")"
                i = i + 1
            End If
            pos = ptr.FirstIndex + 1 + ptr.Length
            If Left(ptr.SubMatches(0), 1) = "=" Then
                tmp(i) = "Response.Write " & Mid(ptr.SubMatches(0), 2)
            Else
                tmp(i) = ptr.SubMatches(0)
            End If
            i = i + 1
        Next
        tmp(i) = "Response.Write Mid(strData, " & pos & ")"
        ReDim Preserve tmp(i)
        ret = Join(tmp, vbCrLf)
    Else
        ret = "Response.Write strData"
    End If
    'Response.Write "<h4>Debug</h4>"
    'Response.Write "<textarea cols=""90"" rows=""10"">" & Server.HTMLEncode(ret) & "</textarea>"
    ExecuteGlobal ret
    Set arr = Nothing
    Set reg = Nothing
End Sub

'--------------------------------------------------------------------
' ASPPath           - 获取指定文件的相对路径
'                   - 返回类型：String
'                   - arguments[0] = 文件相对路径(type: String)
'--------------------------------------------------------------------
Private Function ASPPath(ByVal strPath)
    Dim ret, tmp, pos
    tmp = Replace(strPath, "\", "/")
    pos = InStrRev(tmp, "/")
    If pos > 0 Then
        ret = Mid(tmp, 1, pos)
    End If
    ASPPath = ret
End Function

Public Sub DetectFolder(ByVal strParent, ByVal strPath)
    Dim tmp, arr, i
    strPath = Replace(strPath, "/", "\")
    If Left(strPath, 1) = "\" Then strPath = Mid(strPath, 2)
    If fso.FolderExists(strParent & "\" & strPath) Then Exit Sub
    arr = Split(strPath, "\")
    tmp = strParent
    For i = 0 To UBound(arr)
        tmp = tmp & "\" & arr(i)
        If Not fso.FolderExists(tmp) Then
            fso.CreateFolder tmp
        End If
    Next
End Sub

Public Sub DetectFile(ByVal strParent, ByVal strPath)
    Dim tmp, arr, i
    strPath = Replace(strPath, "/", "\")
    If Left(strPath, 1) = "\" Then strPath = Mid(strPath, 2)
    If fso.FileExists(strParent & "\" & strPath) Then Exit Sub
    arr = Split(strPath, "\")
    tmp = strParent
    For i = 0 To UBound(arr) - 1
        tmp = tmp & "\" & arr(i)
        If Not fso.FolderExists(tmp) Then
            fso.CreateFolder tmp
        End If
    Next
End Sub

Public Function GetFileSize(ByVal strPath)
    Dim objFile
    If fso.FileExists(strPath) Then
        Set objFile = fso.GetFile(strPath)
        GetFileSize = objFile.Size
        Set objFile = Nothing
    Else
        GetFileSize = -1
    End If
End Function

Public Function GetFileNameNoExt(ByVal strFileName)
    Dim pos
    pos = InstrRev(strFileName, ".")
    GetFileNameNoExt = Left(strFileName, pos - 1)
End Function

Public Function GetFileModify(ByVal strPath)
    Dim objFile
    If fso.FileExists(strPath) Then
        Set objFile = fso.GetFile(strPath)
        GetFileModify = objFile.DateLastModified
        Set objFile = Nothing
    Else
        GetFileModify = CDate("1970-01-01")
    End If
End Function

Public Function GetFolderSize(ByVal strPath)
    If fso.FolderExists(strPath) Then
        Dim objFolder
        Set objFolder = fso.GetFolder(strPath)
        GetFolderSize = objFolder.size
        Set objFolder = Nothing
    Else
        GetFolderSize = 0
    End If
End Function
%>