WaBis

walter.bislins.ch

Datei: fs.inc

Inhalt der Datei: ./asp/fs/fs.inc
<%
' fs.inc: (C) http://walter.bislins.ch/doku/fs
'
' Some File-System Functions, optimized for speed
' - uses a common FileSystemObject for all operations
' - all paths may be relative to the application or absolute
' - supports both unix and DOS style path delimeter
' - exports global object FS to access file system functions

class CFileSystem
  public  FileFormat ' 0 -> ASCII (default), -1 -> Unicode, -2 -> System Settings
  private mFSO
  private mRegExp
  private mFolderStateCache
  private mLastFileName
  private mLastFileState
  private mLastRelPath ' used as cache in MapPath()
  private mLastAbsPath ' dito

  property get FSO()
    set FSO = mFSO
  end property

  private sub Class_Initialize()
    FileFormat = 0
    set mRegExp = new RegExp
    mRegExp.Multiline = false
    mRegExp.IgnoreCase = false
    mRegExp.Global = false
    set mFSO = Server.CreateObject("Scripting.FileSystemObject")
    set mFolderStateCache = Server.CreateObject("Scripting.Dictionary")
    mFolderStateCache.CompareMode = 0
    mLastFileName = ""
    mLastFileState = false
    mLastRelPath = ""
    mLastAbsPath = ""
  end sub

  private function TestPattern( aString, aPattern )
    mRegExp.Pattern = aPattern
    TestPattern = mRegExp.Test(aString)
  end function

  private function ReplacePattern( aString, aPattern, aReplace )
    mRegExp.Pattern = aPattern
    ReplacePattern = mRegExp.Replace( aString, aReplace )
  end function

  function MapPath( aPath )
    ' returns the absolute path to aPath
    if aPath = mLastRelPath then
      MapPath = mLastAbsPath
      exit function
    elseif aPath = "" then
      MapPath = Server.MapPath(".")
    elseif InStr(aPath,":\") then
      ' path is absolute already
      MapPath = aPath
    else
      MapPath = Server.MapPath(aPath)
    end if
    mLastRelPath = aPath
    mLastAbsPath = MapPath
  end function

  function AppendSlash( aPath )
    AppendSlash = aPath
    if InStrRev(AppendSlash,"/") <> Len(AppendSlash) then
      AppendSlash = AppendSlash & "/"
    end if
  end function

  function AppendName( aPath, aName )
    AppendName = AppendSlash(aPath) & aName
  end function

  function AppendNameN( aPath, aName )
    ' normalizes returned path
    AppendNameN = NormalizePath(AppendSlash(aPath) & aName)
  end function

  sub SplitPath( aPath, byRef aPathRet, byRef aFilenameRet )
    dim p
    aFilenameRet = aPath
    aPathRet = ""
    p = InStrRev(aFilenameRet,"/")
    if p <= 1 then p = InStrRev(aFilenameRet,"\")
    if p > 0 then
      aPathRet = Left(aFilenameRet,p)
      aFilenameRet = Right(aFilenameRet,Len(aFilenameRet)-p)
    end if
  end sub

  function GetFileName( aPath )
    dim p, name
    name = aPath
    p = InStrRev(name,"\")
    if p <= 1 then p = InStrRev(name,"/")
    if p > 0 then name = Right(name,Len(name)-p)
    GetFileName = name
  end function

  function GetBaseName( aPath )
    dim p, name
    name = GetFileName(aPath)
    p = InStrRev(name,".")
    if p > 0 then name = Left(name,p-1)
    GetBaseName = name
  end function

  function GetExtension( aPath )
    dim p, name, ext
    ext = ""
    name = GetFileName(aPath)
    p = InStrRev(name,".")
    if p > 0 then ext = Right(name,Len(name)-p+1)
    GetExtension = ext
  end function

  function GetPathRelativeToRoot( aAbsPath, aRelRootPath )
    ' returns the rel. path from aRelRootPath to current directory. e.g:
    ' aAbsPath = "C:\usr\wabis\wikis\test"
    ' aRelRootPath = "../../"
    ' returns = "wikis/test"
    dim pth, sep, pParts, p, i
    pth = aAbsPath
    if InStr(pth,"\") then
      sep = "\"
    else
      sep = "/"
    end if
    pParts = Split(pth,sep)
    pth = ""
    p = 1
    i = UBound(pParts)
    do while p > 0 and i >= 0
      p = InStr(p,aRelRootPath,"/")
      if p > 0 then
        if pth <> "" then pth = "/" & pth
        pth = pParts(i) & pth
        i = i - 1
        p = p + 1
      end if
    loop
    GetPathRelativeToRoot = pth
  end function

  function GetCurrentPathRelativeToRoot( aRelRootPath )
    GetCurrentPathRelativeToRoot = GetPathRelativeToRoot( MapPath("."), aRelRootPath )
  end function

  function NormalizePath(aPath)
    ' entfernt bzw. fasst überflüssige ../ Teile zusammen
    dim pth, newLen, oldLen, pars, p
    NormalizePath = aPath
    if InStr(aPath,"./") = 1 then
      NormalizePath = Right(aPath,Len(aPath)-2)
    end if
    NormalizePath = Replace( NormalizePath, "/./", "/" )
    ' aPath contains no pattern "x/../"
    if not mRegExp1.Test(aPath) then exit function
    pth = NormalizePath
    pars = ""
    p = InStr(aPath,"?")
    if p > 0 then
      pars = Right(pth,Len(pth)-p+1)
      pth  = Left(pth,p-1)
    end if
    pth = Replace(pth, "../",">/")
    newLen = Len(pth)
    do
      oldLen = newLen
      ' replace "[^>/]+/>/" -> ""
      pth = mRegExp2.Replace(pth,"")
      newLen = Len(pth)
    loop until oldLen = newLen
    NormalizePath = Replace(pth,">/","../") & pars
  end function

  private function GetFolderStateFromCache( aAbsFolderPath, byRef aStateRet )
    ' returns true if aAbsFolderPath is in cache
    ' if return is true, the folder state is returned in aStateRet
    GetFolderStateFromCache = false
    if mFolderStateCache.Exists(aAbsFolderPath) then
      aStateRet = mFolderStateCache.Item(aAbsFolderPath)
      GetFolderStateFromCache = true
    end if
  end function

  private sub SaveFolderStateToCache( aAbsFolderPath, aState )
    on error resume next
    if mFolderStateCache.Exists(aAbsFolderPath) then
      mFolderStateCache.Item(aAbsFolderPath) = aState
    else
      mFolderStateCache.Add aAbsFolderPath, aState
    end if
    if Err <> 0 then Err.Clear
  end sub

  function GetFolder( aPath )
    ' require FolderExists(aPath)
    ' returns a Folder object
    set GetFolder = mFSO.GetFolder(MapPath(aPath))
  end function

  function FolderExists( aPath )
    dim absPath
    absPath = MapPath(aPath)
    if GetFolderStateFromCache(absPath, FolderExists) then exit function
    on error resume next
    FolderExists = mFSO.FolderExists(absPath)
    if Err <> 0 then
      FolderExists = false
      Err.Clear
    end if
    SaveFolderStateToCache absPath, FolderExists
  end function

  sub CreateFolder( aPath )
    ' creates folder aPath, if not already exists
    ' returns exception, if not successful
    dim absPath
    absPath = MapPath(aPath)
    if not FolderExists(aPath) then
      mFSO.CreateFolder(absPath)
      SaveFolderStateToCache absPath, true
    end if
  end sub

  sub DeleteFolder( aPath )
    ' deletes folder aPath, if exists
    dim absPath
    absPath = MapPath(aPath)
    if FolderExists(aPath) then
      mFSO.DeleteFolder absPath, true
      SaveFolderStateToCache absPath, false
    end if
  end sub

  function ListFiles( aPath )
    ' require FolderExists(aPath)
    ' returns array of filenames (strings)
    dim folder, filenames, file, i
    set folder = GetFolder(aPath)
    redim filenames(folder.Files.Count-1)
    i = 0
    for each file in folder.Files
      filenames(i) = file.Name
      i = i + 1
    next
    ListFiles = filenames
  end function

  function GetFile( aPath )
    ' require FileExists(aPath)
    ' returns a File object
    set GetFile = mFSO.GetFile(MapPath(aPath))
  end function

  function FileExists( aPath )
    dim absPath
    on error resume next
    absPath = MapPath(aPath)
    if mLastFileName = absPath then
      FileExists = mLastFileState
      exit function
    end if
    FileExists = mFSO.FileExists(absPath)
    if Err <> 0 then
      FileExists = false
      Err.Clear
    end if
    mLastFileName = absPath
    mLastFileState = FileExists
  end function

  function ReadFile( aPath )
    ' require FileExists(aPath)
    dim file, tstream
    set file = mFSO.GetFile(MapPath(aPath))
    set tstream = file.OpenAsTextStream(1, FileFormat)
    if tstream.AtEndOfStream then
      ReadFile = ""
    else
      ReadFile = tstream.Readall
    end if
  end function

  sub WriteFile( aPath, aText )
    dim file, absPath
    absPath = MapPath(aPath)
    if StrComp(mLastFileName,absPath,1) = 0 then mLastFileName = ""
    set file = mFSO.OpenTextFile(absPath, 2, True, FileFormat)
    file.Write aText
    file.Close
  end sub

  function OpenFileForWriting( aPath )
    ' returns a File object opened for writing
    '
    ' usage:
    '
    '  dim file
    '  set file = FS.OpenFileForWriting( filename )
    '  file.Write text
    '  file.Close
    '
    dim absPath
    absPath = MapPath(aPath)
    if StrComp(mLastFileName,absPath,1) = 0 then mLastFileName = ""
    set OpenFileForWriting = mFSO.OpenTextFile(absPath, 2, True, FileFormat)
  end function

  sub DeleteFile( aPath )
    ' deletes file aPath if exists
    dim absPath
    absPath = MapPath(aPath)
    if FileExists(aPath) then
      if StrComp(mLastFileName,absPath,1) = 0 then mLastFileState = false
      mFSO.DeleteFile absPath
    end if
  end sub

  sub CopyFile( aRelSrcPath, aRelDestPath )
    ' copies file aRelSrcPath, if exists
    ' returns exception, if destination could't be created
    dim srcPath, destPath
    srcPath = MapPath(aRelSrcPath)
    destPath = MapPath(aRelDestPath)
    if FileExists(aRelSrcPath) then
      if StrComp(mLastFileName,destPath,1) = 0 then mLastFileName = ""
      mFSO.CopyFile srcPath, destPath, true
    end if
  end sub

  sub MoveFile( aRelSrcPath, aRelDestPath )
    ' moves file aRelSrcPath, if exists
    ' returns exception, if destination could't be created
    dim srcPath, destPath
    srcPath = MapPath(aRelSrcPath)
    destPath = MapPath(aRelDestPath)
    if FileExists(aRelSrcPath) then
      if StrComp(mLastFileName,srcPath,1) = 0 then mLastFileName = ""
      if StrComp(mLastFileName,destPath,1) = 0 then mLastFileName = ""
      if mFSO.FileExists(destPath) then mFSO.DeleteFile destPath
      mFSO.MoveFile srcPath, destPath
    end if
  end sub

  function DateLastModified( aPath )
    ' require FileExists(aPath)
    dim file
    set file = GetFile(aPath)
    DateLastModified = file.DateLastModified
  end function

end class

dim FS
set FS = new CFileSystem

%>

Weitere Infos zur Seite
Erzeugt Dienstag, 18. Oktober 2011
von wabis
Zum Seitenanfang
Geändert Dienstag, 1. Mai 2012
von *System*