WaBis

walter.bislins.ch

Datei: seq.inc

Inhalt der Datei: ./asp/seq/seq.inc
<%
' Serialize and Parse ----------------
' seq: Copyright (C) 2008, 2015 Walter Bislin
' http://walter.bislins.ch/projekte/asp/seq/
'
' Dependencies:
' - perf.inc (CStream)
'
' classes to serialize data into and parse from strings, usefull to store objects in files
' - CSerializer
' - CParser

class CParser
  private mString
  private mPos
  private mPStack
  private mStack
  private mStackPtr
  private mDecimalChar

  private sub Class_Initialize()
    mString = ""
    mPos = 1
    mStack = Array()
    mPStack = Array()
    mStackPtr = -1
    ' induce language dependant decimal character
    mDecimalChar = Mid(CStr(1.2),2,1)
  end sub

  sub Init( aString )
    mString = aString
    mPos = 1
    mStackPtr = -1
  end sub

  sub OpenSubData( )
    dim s
    s = GetStrD("")
    mStackPtr = mStackPtr + 1
    if mStackPtr > UBound(mStack) then
      redim preserve mStack(mStackPtr)
      redim preserve mPStack(mStackPtr)
    end if
    mStack(mStackPtr) = mString
    mPStack(mStackPtr) = mPos
    mString = s
    mPos = 1
  end sub

  sub CloseSubData( )
    if mStackPtr < 0 then exit sub
    mString = mStack(mStackPtr)
    mPos = mPStack(mStackPtr)
    mStackPtr = mStackPtr - 1
  end sub

  sub SkipSubData( )
    ' skips a whole sub data struct
    dim x
    x = GetStrD("")
  end sub

  function GetIntD( aDefault )
    dim p, s
    GetIntD = aDefault
    p = InStr(mPos,mString,"|")
    if p > 0 then
      s = Mid(mString,mPos,p-mPos)
      if IsNumeric(s) then
        GetIntD = CLng(s)
        mPos = p + 1
      end if
    end if
  end function

  function GetInt( )
    GetInt = GetIntD( 0 )
  end function

  function GetNumD( aDefault )
    dim p, s
    GetNumD = aDefault
    p = InStr(mPos,mString,"|")
    if p > 0 then
      s = Mid(mString,mPos,p-mPos)
      s = Replace( s, ".", mDecimalChar )
      s = Replace( s, ",", mDecimalChar )
      if IsNumeric(s) then
        if InStr( s, mDecimalChar ) then
          GetNumD = CDbl(s)
        else
          GetNumD = CLng(s)
        end if
        mPos = p + 1
      end if
    end if
  end function

  function GetNum( )
    GetNum = GetNumD( 0 )
  end function

  function GetBoolD( aDefault )
    dim d, r
    d = 0
    GetBoolD = false
    if aDefault then d = 1
    r = GetIntD( d )
    if r <> 0 then GetBoolD = true
  end function

  function GetBool( )
    GetBool = GetBoolD( false )
  end function

  function GetDateD( aDefault )
    GetDateD = CDate( GetNumD( aDefault ) )
  end function

  function GetDate( )
    GetDate = GetDateD( CDate(0) )
  end function

  function GetStrD( aDefaultStr )
    dim n
    GetStrD = aDefaultStr
    n = GetIntD( -1 )
    if n = 0 then
      GetStrD = ""
    elseif n > 0 and mPos+n <= Len(mString) then
      GetStrD = Mid(mString,mPos,n)
      mPos = mPos + n + 1
    end if
  end function

  function GetStr( )
    GetStr = GetStrD( "" )
  end function

  function GetFixStr( aStrLen )
    GetFixStr = ""
    if mPos+aStrLen-1 <= Len(mString) then
      GetFixStr = Mid(mString,mPos,aStrLen)
      mPos = mPos + aStrLen
    end if
  end function

  function GetStrArray( )
    dim sz, i, arr, last
    sz = GetIntD( 0 )
    if sz <= 0  then
      GetStrArray = Array()
    else
      last = sz-1
      redim arr(last)
      for i = 0 to last
        arr(i) = GetStrD( "" )
      next
      GetStrArray = arr
    end if
  end function

  function Parse( aString )
    ' usage: object.parse parser.Parse(aString)
    Init aString
    set Parse = Me
  end function

end class

function NewParser( aString )
  set NewParser = new CParser
  NewParser.Init aString
end function

'--------------------------------

class CSerializer
  private mStream
  private mStack
  private mStackPtr
  private mDecimalChar

  private sub Class_Initialize( )
    set mStream = NewStream( 0 )
    mStack = Array()
    redim mStack(0)
    set mStack(0) = mStream
    mStackPtr = 0
    ' induce language dependant decimal character
    mDecimalChar = Mid(CStr(1.2),2,1)
  end sub

  sub SetSizeEstimate( aSizeEstimate )
    if aSizeEstimate >= 0 then mStream.SetSizeEstimate aSizeEstimate
  end sub

  function GetString( bClear )
    ' set bClear to false, if this stream is not used any more or if more strings are appended later
    ' set bClear to true, if this stream is reused and should be cleared
    GetString = mStream.GetString( bClear )
  end function

  sub OpenSubData( aSizeEstimate )
    ' counts as 1 element when CloseSubData is called
    mStackPtr = mStackPtr + 1
    if mStackPtr > UBound(mStack) then
      redim preserve mStack(mStackPtr)
      set mStack(mStackPtr) = NewStream(0)
    end if
    set mStream = mStack(mStackPtr)
    mStream.SetSizeEstimate aSizeEstimate
  end sub

  private function DoCloseSubData( )
    ' require mStackPtr > 0
    DoCloseSubData = mStream.GetString(true)
    mStackPtr = mStackPtr - 1
    set mStream = mStack(mStackPtr)
  end function

  sub CloseSubData( )
    if mStackPtr = 0 then exit sub
    AddStr DoCloseSubData()
  end sub

  sub AddNL( )
    mStream.Add vbCRLF
  end sub

  sub AddNum( aNum )
    ' note: CStr uses a language dependant decimal separator character! we have to normalize this to a point.
    mStream.Add Replace( CStr(aNum), ",", "." ) & "|"
  end sub

  sub AddInt( aInt )
    mStream.Add aInt & "|"
  end sub

  sub AddBool( aBool )
    dim b
    b = 0
    if aBool then b = 1
    AddInt b
  end sub

  sub AddDate( aDate )
    AddNum CDbl(aDate)
  end sub

  sub AddStr( aStr )
    dim l, s
    l = Len(aStr)
    s = l & "|"
    if l > 0 then s = s & aStr & "|"
    mStream.Add s
  end sub

  sub AddFixStr( aStr )
    mStream.Add aStr
  end sub

  sub AddStrArray( aStrArray )
    ' counts as 1 element!
    dim i, last
    last = UBound(aStrArray)
    if last < 0 then
      AddInt 0
    else
      OpenSubData last + 3
      AddNL
      AddInt last + 1
      for i = 0 to last
        AddStr aStrArray(i)
      next
      mStream.Add DoCloseSubData()
    end if
  end sub

end class

function NewSerializer( aSizeEstimate )
  set NewSerializer = new CSerializer
  NewSerializer.SetSizeEstimate aSizeEstimate
end function

%>

Weitere Infos zur Seite
Erzeugt Freitag, 6. Januar 2012
von wabis
Zum Seitenanfang
Geändert Samstag, 20. Juni 2015
von *System*