xmldom: ures CDATA-ra elszallas javitva

xmldom: ures CDATA-ra elszallas javitva

/*
 *  CCC - The Clipper to C++ Compiler
 *  Copyright (C) 2005 ComFirm BT.
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Lesser General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Lesser General Public License for more details.
 *
 *  You should have received a copy of the GNU Lesser General Public
 *  License along with this library; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */

#include "jtelem.ch"

****************************************************************************
//jtdialog
****************************************************************************
class jtdialog(jtelem)

    method  initialize

    attrib  pid                 // process id
    attrib  layout              // fix,vbox,hbox,flow
    attrib  defaultradiogroup   // radiogroup
    attrib  parser              // xml parser
    attrib  mustreact           // must answer the last action
    attrib  _blklist_           // these have block (hash table)
    attrib  _blkcount_          // items in blklist
    attrib  _varlist_           // these have name (hash table)
    attrib  _varcount_          // items in varlist
    attrib  var                 // _varlist_ as an object

    method  caption             {|this,x|if(x==NIL,this:text,this:text:=x)}
    method  list
    method  getcontrolbyname
    method  get                 :getcontrolbyname
    method  add
    method  xmlout
    method  send                {|this,x|jtsocket():send(x)}
    method  recv
    method  show
    method  exit
    method  close
    method  getmessage
    method  response
    method  alert               {|this,msg,opt|jtalert(msg,opt)}

    method  blklist
    method  varlist
    method  varinst

****************************************************************************
static function jtdialog.initialize(this,t,l,b,r)
static dialogid:=0
    if(t==NIL.and.l==NIL.and.b==NIL.and.r==NIL)
        t:=0
        l:=0
        b:=16
        r:=64
    end
    this:(jtelem)initialize(t,l,b,r)
    this:itemlist:={}
    this:pid:=alltrim(str(getpid()))
    this:dialogid:=this:pid+"_"+alltrim(str(++dialogid))
    this:defaultradiogroup:=jtradiogroup()
    this:parser:=xmlparserNew()
    this:mustreact:=.f.
    return this

function jtdialogIni(this,t,l,b,r)//compatibility
    return this:(jtdialog)initialize(t,l,b,r)

****************************************************************************
static function jtdialog.add(this,item)
    item:setdialogid(this:dialogid)
    aadd(this:itemlist,item)
    if( item:classname=="jtradio" .and. item:group==NIL  )
        item:setgroup(this:defaultradiogroup)
    end
    return item

****************************************************************************
static function jtdialog.xmlout(this)

local x,n,c,g:={},grp,i

    x:="<jtdialog"
    x+=ATTRI("top",this:top)
    x+=ATTRI("left",this:left)
    x+=ATTRI("bottom",this:bottom)
    x+=ATTRI("right",this:right)
    x+=ATTR("name",this:name)
    x+=ATTR("dialogid",this:dialogid)
    x+=ATTR("pid",this:pid)
    x+=">"+EOL
    x+="<caption>"+cdataif(this:text)+"</caption>"+EOL

    if( this:layout!=NIL )
        x+="<layout>"+this:layout+"</layout>"+EOL
    end

    for n:=1 to len(this:itemlist)
        c:=this:itemlist[n]
        if( c:classname=="jtradio" .and. c:group!=NIL )

            grp:=eval(c:group)

            for i:=1 to len(g)
                if( grp==g[i] )
                    exit
                end
            next

            if( i>len(g) )
                aadd(g,grp)
                x+="<jtradiogroup>"+EOL
                for i:=1 to len(grp)
                    x+=grp[i]:xmlout+EOL
                next
                x+="</jtradiogroup>"+EOL
            end

        else
            x+=c:xmlout+EOL
        end
    next

    x+="</jtdialog>"

    return x

****************************************************************************
static function jtdialog.show(this)
local n

    //Megjegyzés:
    //Az alábbi ciklus inicializálja a kontrollok laststate attribútumait
    //abból a célból, hogy a frissen megjelenített dialogbox tartalmát
    //feleslegesen ne küldjük újra a reaction message-ben.
    //Ugyanezt a műveletet a terminál NEM csinálja, így a terminál az első
    //action message-ben minden kontrollt küldeni fog. Ez viszont
    //azért jó, mert így biztosan összhangba kerül az alkalmazás és
    //a terminál olyan esetekben is, amikor az inicializáláskor
    //küldött érték nem kezelhető a terminálban, pl. a picturenél
    //hosszabb inicializáló szöveg.

    for n:=1 to len(this:varlist)
        if( this:varlist[n]!=NIL )
            this:varlist[n]:savestate  //inicializálja a laststate-eket
        end
    next

    this:mustreact:=.f.
    this:send(this:xmlout)

    return NIL

****************************************************************************
static function jtdialog.exit(this)
    this:mustreact:=.f.
    this:send("<exit/>")
    return NIL

****************************************************************************
static function jtdialog.close(this)
    this:mustreact:=.f.
    this:send('<close dialogid="'+this:dialogid+'"/>')
    return NIL

****************************************************************************
static function jtdialog.recv(this,wtime)
local msg:=jtsocket():dequeue
    if( msg==NIL )
        msg:=jtsocket():recv(wtime)
    end
    return msg

****************************************************************************
static function jtdialog.getmessage(this,wtime)

local msg,dom,node,type,dlgid,source
local n,value,name,i,blk

    if( this:mustreact )
        this:response
    end

    if( empty(msg:=this:recv(wtime)) )
        //NIL, ha megszakadt a kapcsolat
        //"" , ha lejárt a várakozási idő
        return msg
    end

    dom:=this:parser:parsestring(msg)
    node:=dom:content[1]
    type:=node:type
    dlgid:=node:getattrib("dialogid")

    if( !dlgid==this:dialogid )
        //alert( "DIALOGID ELTÉR!"  )
        ? "INVALID DIALOGID,", "  expected:",this:dialogid, "  recieved:",dlgid
    end

    if( type=="action" )
        //a kontrollok új tartalmát
        //betölti a dialog objektumba

        this:mustreact:=.t.

        source:=node:content[1]:gettext

        for n:=2 to len(node:content)
            name:=node:content[n]:type

            i:=hash_index(this:varlist,name)
            if( this:varlist[i]!=NIL )
                this:varlist[i]:xmlput(node:content[n])   //új érték tárolva
                this:varlist[i]:savestate                 //ne küldje vissza

                //Megjegyzés:
                //Ugyanezt a savestate adminisztrációt a terminál
                //NEM csinálja, azaz minden új adatot egyszer visszaküld.
                //Ez azért jó, mert összhangba kerül az alkalmazás
                //és a terminál. Pl. ha egy picture nagybetűre konvertál,
                //de kisbetűs adatot töltünk bele, akkor az visszajön
                //nagybetűre konvertálva.
            else
                ? "Unknown control:",name
            end
        next

        //ha a source kontrollnak van blokkja,
        //akkor azt itt végrehajtjuk

        i:=hash_index(this:blklist,source)
        if( this:blklist[i]!=NIL )
            eval(this:blklist[i]:actionblock,this)
        end

        return source

    elseif( type=="destroy" )
        return NIL //becsukták az ablakot

    end

    return NIL

****************************************************************************
static function jtdialog.response(this)
local n,v,x:=""
    for n:=1 to len(this:varlist)
        v:=this:varlist[n]
        if( v!=NIL .and. v:changed )
            x+="<"+v:name+">"+v:xmlget+"</"+v:name+">"
            v:savestate
        end
    next
    if( empty(x) )
        x:='<reaction dialogid="'+this:dialogid+'"/>'
    else
        x:='<reaction dialogid="'+this:dialogid+'"><set>'+x+'</set></reaction>'
    end
    this:send(x)
    this:mustreact:=.f.
    return NIL

****************************************************************************
static function jtdialog.getcontrolbyname(this,name)
    return this:varlist[ hash_index(this:varlist,lower(name)) ]

****************************************************************************
static function jtdialog.blklist(this)
local n

    if( this:_blklist_==NIL  )
        this:_blklist_:=array(64)
        this:_blkcount_:=0
        jtdialog.setblk1(this,this:itemlist)
    end
    return this:_blklist_

static function jtdialog.setblk1(this,itemlist)
local n,x,it

    for n:=1 to len(itemlist)
        it:=itemlist[n]
        if( NIL!=it:actionblock )
            x:=hash_index(this:_blklist_,it:name)
            this:_blklist_[x]:=it
            if( ++this:_blkcount_>0.66*len(this:_blklist_) )
                this:_blklist_:=hash_rebuild(this:_blklist_,2*len(this:_blklist_))
            end
        end
        if( NIL!=it:itemlist )
            jtdialog.setblk1(this,it:itemlist)
        end
    next
    return NIL

****************************************************************************
static function jtdialog.varlist(this)
local n
    if( this:_varlist_==NIL )
        this:_varlist_:=array(64)
        this:_varcount_:=0
        jtdialog.setvar1(this,this:itemlist)
    end
    return this:_varlist_

static function jtdialog.setvar1(this,itemlist)
local n,x,v,vn,e

    for n:=1 to len(itemlist)

        //csak akkor tesszük be a listába, ha van neve,
        //de nem teszünk bele több egyező nevű kontrollt.

        v:=itemlist[n]

        if( !empty(vn:=v:name) .and. left(vn,6)!="_ctrl_" )
            x:=hash_index(this:_varlist_,vn)
            if( this:_varlist_[x]==NIL )
                this:_varlist_[x]:=v
                if( ++this:_varcount_>0.66*len(this:_varlist_) )
                    this:_varlist_:=hash_rebuild(this:_varlist_,2*len(this:_varlist_))
                end
            else
                e:=errorNew()
                e:operation:="jtdialog.varlist"
                e:description:="multiple control name"
                e:args:={vn}
                break(e)
            end
        end

        if( NIL!=v:itemlist )
            jtdialog.setvar1(this,v:itemlist)
        end
    next
    return NIL

****************************************************************************
static function jtdialog.list(this)
local n,a:={}
    for n:=1 to len(this:varlist)
        if( this:varlist[n]!=NIL )
            aadd(a,this:varlist[n])
        end
    next
    asort(a,,,{|x,y|x:name<y:name})
    for n:=1 to len(a)
        ? padr(a[n]:classname,24),;
          padr(a[n]:name,24),;
          if(a[n]:actionblock==NIL," ","B"),;
          if(a[n]:valid,"V"," "),;
          if(a[n]:enabled," ","D"),;
          a[n]:xmlget
    next
    return NIL

****************************************************************************
static function jtdialog.varinst(this,alias)

//Készít egy objektumot:
//
//az osztály neve: varlist_alias
//attribútumainak neve: varlist[i]:name
//attribútumainak értéke: varlist[i] (objektum)
//
//Ezt az objektumot betesszük a jtdialog var attribútumába,
//ami lehetővé teszi, hogy a komponenseket név szerint érjük el,
//
//pl: dialog:var:field:varput("FFFFFFFFUUUUUUUUAAAAAAAA")
//
//Probléma, hogy a kontrollokhoz csak azután lehet így
//hozzáférni, miután véglegesen elkészült a dialogbox,
//és teljes a varlist, azaz minden kontroll ismert.
//
//Az alábbi metódusok elkészítik varlist-et, ami bajt okozhat,
//ha a híváskor a komponenesek még nincsenek hiánytalanul meg:
//
//  show
//  getmessage
//  getcontrol
//  list
//  response

local clnm:="varlist_"+alias
local clid:=classidbyname(clnm)
local attrlist,n,i:=0

    this:_varlist_:=NIL  //ez kell!
    this:_blklist_:=NIL  //ez kell!

    if( empty(clid) )
        clid:=classRegister(clnm,{objectClass()})
        for n:=1 to len(this:varlist)
            if( this:varlist[n]!=NIL )
                classAttrib(clid,this:varlist[n]:name)
            end
        end
    end

    this:var:=objectNew(clid)
    attrlist:=this:var:asarray

    for n:=1 to len(this:varlist)
        if( this:varlist[n]!=NIL )
            attrlist[++i]:=this:varlist[n]
        end
    end

    #ifdef HASH_PRINT //teszt
        hash_print(this:varlist)
        hash_print(this:blklist)
    #endif

    return NIL

****************************************************************************
//hash algoritmus
****************************************************************************
static function hash_rebuild(hash,len)
local hash1:=array(len),n,x
    for n:=1 to len(hash)
        if( hash[n]!=NIL )
            x:=hash_index(hash1,hash[n]:name)
            hash1[x]:=hash[n]
        end
    next
    return hash1

// A hash tábla egy array: {item1,item2,...},
// ahol item==NIL, vagy item egy name attribútummal rendelkező object,
// object:name játssza a kulcs szerepét.

****************************************************************************
static function hash_index(hash,key)

local hlen:=len(hash)
local hcode:=hashcode(key)
local hidx:=hcode%hlen
local item

    while( .t. )
        item:=hash[1+hidx]
        if( item==NIL )
            return 1+hidx
        elseif( item:name==key )
            return 1+hidx
        elseif( ++hidx>=hlen )
            hidx:=0
        end
    end
    return NIL

// Keresés a hash táblában:
// A ciklus véget ér, ui. a táblának van NIL eleme.
// visszatérés: hashidx
// Ha hash[hasidx]==NIL, akkor a keresett elem nincs a táblában,
//                       és éppen a hashidx helyre kell/lehet betenni.
// Ha hash[hasidx]!=NIL, akkor az a keresett elem.

****************************************************************************
#ifdef HASH_PRINT //csak teszteléshez

static function hash_print(hash)

local hidx,hidx0,coll
local elemcnt:=0,collcnt:=0

    for hidx:=1 to len(hash)
        if( hash[hidx]!=NIL )
            hidx0:=1+hashcode(hash[hidx]:name)%len(hash)
            coll:=(hidx-hidx0+len(hash))%len(hash)
            collcnt+=coll
            elemcnt++
            ?  hidx, padr(hash[hidx]:name,20), hidx0, replicate("!",coll)
        end
    next

    ?
    ? "tab length :",  len(hash)
    ? "item count :",  elemcnt
    ? "collisions :",  collcnt
    ?

#endif

****************************************************************************

/*
 *  CCC - The Clipper to C++ Compiler
 *  Copyright (C) 2005 ComFirm BT.
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Lesser General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Lesser General Public License for more details.
 *
 *  You should have received a copy of the GNU Lesser General Public
 *  License along with this library; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */

#include "jtelem.ch"

****************************************************************************
//jtdialog
****************************************************************************
class jtdialog(jtelem)

    method  initialize

    attrib  pid                 // process id
    attrib  layout              // fix,vbox,hbox,flow
    attrib  defaultradiogroup   // radiogroup
    attrib  parser              // xml parser
    attrib  mustreact           // must answer the last action
    attrib  _blklist_           // these have block (hash table)
    attrib  _blkcount_          // items in blklist
    attrib  _varlist_           // these have name (hash table)
    attrib  _varcount_          // items in varlist
    attrib  var                 // _varlist_ as an object

    method  caption             {|this,x|if(x==NIL,this:text,this:text:=x)}
    method  list
    method  getcontrolbyname
    method  add
    method  xmlout
    method  send                {|this,x|jtsocket():send(x)}
    method  recv
    method  show
    method  exit
    method  close
    method  getmessage
    method  response
    method  alert               {|this,msg,opt|jtalert(msg,opt)}

    method  blklist
    method  varlist
    method  varinst

****************************************************************************
static function jtdialog.initialize(this,t,l,b,r)
static dialogid:=0
    if(t==NIL.and.l==NIL.and.b==NIL.and.r==NIL)
        t:=0
        l:=0
        b:=16
        r:=64
    end
    this:(jtelem)initialize(t,l,b,r)
    this:itemlist:={}
    this:pid:=alltrim(str(getpid()))
    this:dialogid:=this:pid+"_"+alltrim(str(++dialogid))
    this:defaultradiogroup:=jtradiogroup()
    this:parser:=xmlparserNew()
    this:mustreact:=.f.
    return this

function jtdialogIni(this,t,l,b,r)//compatibility
    return this:(jtdialog)initialize(t,l,b,r)

****************************************************************************
static function jtdialog.add(this,item)
    item:setdialogid(this:dialogid)
    aadd(this:itemlist,item)
    if( item:classname=="jtradio" .and. item:group==NIL  )
        item:setgroup(this:defaultradiogroup)
    end
    return item

****************************************************************************
static function jtdialog.xmlout(this)

local x,n,c,g:={},grp,i

    x:="<jtdialog"
    x+=ATTRI("top",this:top)
    x+=ATTRI("left",this:left)
    x+=ATTRI("bottom",this:bottom)
    x+=ATTRI("right",this:right)
    x+=ATTR("name",this:name)
    x+=ATTR("dialogid",this:dialogid)
    x+=ATTR("pid",this:pid)
    x+=">"+EOL
    x+="<caption>"+cdataif(this:text)+"</caption>"+EOL

    if( this:layout!=NIL )
        x+="<layout>"+this:layout+"</layout>"+EOL
    end

    for n:=1 to len(this:itemlist)
        c:=this:itemlist[n]
        if( c:classname=="jtradio" .and. c:group!=NIL )

            grp:=eval(c:group)

            for i:=1 to len(g)
                if( grp==g[i] )
                    exit
                end
            next

            if( i>len(g) )
                aadd(g,grp)
                x+="<jtradiogroup>"+EOL
                for i:=1 to len(grp)
                    x+=grp[i]:xmlout+EOL
                next
                x+="</jtradiogroup>"+EOL
            end

        else
            x+=c:xmlout+EOL
        end
    next

    x+="</jtdialog>"

    return x

****************************************************************************
static function jtdialog.show(this)
local n

    //Megjegyzés:
    //Az alábbi ciklus inicializálja a kontrollok laststate attribútumait
    //abból a célból, hogy a frissen megjelenített dialogbox tartalmát
    //feleslegesen ne küldjük újra a reaction message-ben.
    //Ugyanezt a műveletet a terminál NEM csinálja, így a terminál az első
    //action message-ben minden kontrollt küldeni fog. Ez viszont
    //azért jó, mert így biztosan összhangba kerül az alkalmazás és
    //a terminál olyan esetekben is, amikor az inicializáláskor
    //küldött érték nem kezelhető a terminálban, pl. a picturenél
    //hosszabb inicializáló szöveg.

    for n:=1 to len(this:varlist)
        if( this:varlist[n]!=NIL )
            this:varlist[n]:savestate  //inicializálja a laststate-eket
        end
    next

    this:mustreact:=.f.
    this:send(this:xmlout)

    return NIL

****************************************************************************
static function jtdialog.exit(this)
    this:mustreact:=.f.
    this:send("<exit/>")
    return NIL

****************************************************************************
static function jtdialog.close(this)
    this:mustreact:=.f.
    this:send('<close dialogid="'+this:dialogid+'"/>')
    return NIL

****************************************************************************
static function jtdialog.recv(this,wtime)
local msg:=jtsocket():dequeue
    if( msg==NIL )
        msg:=jtsocket():recv(wtime)
    end
    return msg

****************************************************************************
static function jtdialog.getmessage(this,wtime)

local msg,dom,node,type,dlgid,source
local n,value,name,i,blk

    if( this:mustreact )
        this:response
    end

    if( empty(msg:=this:recv(wtime)) )
        //NIL, ha megszakadt a kapcsolat
        //"" , ha lejárt a várakozási idő
        return msg
    end

    dom:=this:parser:parsestring(msg)
    node:=dom:content[1]
    type:=node:type
    dlgid:=node:getattrib("dialogid")

    if( !dlgid==this:dialogid )
        //alert( "DIALOGID ELTÉR!"  )
        ? "INVALID DIALOGID,", "  expected:",this:dialogid, "  recieved:",dlgid
    end

    if( type=="action" )
        //a kontrollok új tartalmát
        //betölti a dialog objektumba

        this:mustreact:=.t.

        source:=node:content[1]:gettext

        for n:=2 to len(node:content)
            name:=node:content[n]:type

            i:=hash_index(this:varlist,name)
            if( this:varlist[i]!=NIL )
                this:varlist[i]:xmlput(node:content[n])   //új érték tárolva
                this:varlist[i]:savestate                 //ne küldje vissza

                //Megjegyzés:
                //Ugyanezt a savestate adminisztrációt a terminál
                //NEM csinálja, azaz minden új adatot egyszer visszaküld.
                //Ez azért jó, mert összhangba kerül az alkalmazás
                //és a terminál. Pl. ha egy picture nagybetűre konvertál,
                //de kisbetűs adatot töltünk bele, akkor az visszajön
                //nagybetűre konvertálva.
            else
                ? "Unknown control:",name
            end
        next

        //ha a source kontrollnak van blokkja,
        //akkor azt itt végrehajtjuk

        i:=hash_index(this:blklist,source)
        if( this:blklist[i]!=NIL )
            eval(this:blklist[i]:actionblock,this)
        end

        return source

    elseif( type=="destroy" )
        return NIL //becsukták az ablakot

    end

    return NIL

****************************************************************************
static function jtdialog.response(this)
local n,v,x:=""
    for n:=1 to len(this:varlist)
        v:=this:varlist[n]
        if( v!=NIL .and. v:changed )
            x+="<"+v:name+">"+v:xmlget+"</"+v:name+">"
            v:savestate
        end
    next
    if( empty(x) )
        x:='<reaction dialogid="'+this:dialogid+'"/>'
    else
        x:='<reaction dialogid="'+this:dialogid+'"><set>'+x+'</set></reaction>'
    end
    this:send(x)
    this:mustreact:=.f.
    return NIL

****************************************************************************
static function jtdialog.getcontrolbyname(this,name)
    return this:varlist[ hash_index(this:varlist,lower(name)) ]

****************************************************************************
static function jtdialog.blklist(this)
local n

    if( this:_blklist_==NIL  )
        this:_blklist_:=array(64)
        this:_blkcount_:=0
        jtdialog.setblk1(this,this:itemlist)
    end
    return this:_blklist_

static function jtdialog.setblk1(this,itemlist)
local n,x,it

    for n:=1 to len(itemlist)
        it:=itemlist[n]
        if( NIL!=it:actionblock )
            x:=hash_index(this:_blklist_,it:name)
            this:_blklist_[x]:=it
            if( ++this:_blkcount_>0.66*len(this:_blklist_) )
                this:_blklist_:=hash_rebuild(this:_blklist_,2*len(this:_blklist_))
            end
        end
        if( NIL!=it:itemlist )
            jtdialog.setblk1(this,it:itemlist)
        end
    next
    return NIL

****************************************************************************
static function jtdialog.varlist(this)
local n
    if( this:_varlist_==NIL )
        this:_varlist_:=array(64)
        this:_varcount_:=0
        jtdialog.setvar1(this,this:itemlist)
    end
    return this:_varlist_

static function jtdialog.setvar1(this,itemlist)
local n,x,v,vn,e

    for n:=1 to len(itemlist)

        //csak akkor tesszük be a listába, ha van neve,
        //de nem teszünk bele több egyező nevű kontrollt.

        v:=itemlist[n]

        if( !empty(vn:=v:name) .and. left(vn,6)!="_ctrl_" )
            x:=hash_index(this:_varlist_,vn)
            if( this:_varlist_[x]==NIL )
                this:_varlist_[x]:=v
                if( ++this:_varcount_>0.66*len(this:_varlist_) )
                    this:_varlist_:=hash_rebuild(this:_varlist_,2*len(this:_varlist_))
                end
            else
                e:=errorNew()
                e:operation:="jtdialog.varlist"
                e:description:="multiple control name"
                e:args:={vn}
                break(e)
            end
        end

        if( NIL!=v:itemlist )
            jtdialog.setvar1(this,v:itemlist)
        end
    next
    return NIL

****************************************************************************
static function jtdialog.list(this)
local n,a:={}
    for n:=1 to len(this:varlist)
        if( this:varlist[n]!=NIL )
            aadd(a,this:varlist[n])
        end
    next
    asort(a,,,{|x,y|x:name<y:name})
    for n:=1 to len(a)
        ? padr(a[n]:classname,24),;
          padr(a[n]:name,24),;
          if(a[n]:actionblock==NIL," ","B"),;
          if(a[n]:valid,"V"," "),;
          if(a[n]:enabled," ","D"),;
          a[n]:xmlget
    next
    return NIL

****************************************************************************
static function jtdialog.varinst(this,alias)

//Készít egy objektumot:
//
//az osztály neve: varlist_alias
//attribútumainak neve: varlist[i]:name
//attribútumainak értéke: varlist[i] (objektum)
//
//Ezt az objektumot betesszük a jtdialog var attribútumába,
//ami lehetővé teszi, hogy a komponenseket név szerint érjük el,
//
//pl: dialog:var:field:varput("FFFFFFFFUUUUUUUUAAAAAAAA")
//
//Probléma, hogy a kontrollokhoz csak azután lehet így
//hozzáférni, miután véglegesen elkészült a dialogbox,
//és teljes a varlist, azaz minden kontroll ismert.
//
//Az alábbi metódusok elkészítik varlist-et, ami bajt okozhat,
//ha a híváskor a komponenesek még nincsenek hiánytalanul meg:
//
//  show
//  getmessage
//  getcontrol
//  list
//  response

local clnm:="varlist_"+alias
local clid:=classidbyname(clnm)
local attrlist,n,i:=0

    this:_varlist_:=NIL  //ez kell!
    this:_blklist_:=NIL  //ez kell!

    if( empty(clid) )
        clid:=classRegister(clnm,{objectClass()})
        for n:=1 to len(this:varlist)
            if( this:varlist[n]!=NIL )
                classAttrib(clid,this:varlist[n]:name)
            end
        end
    end

    this:var:=objectNew(clid)
    attrlist:=this:var:asarray

    for n:=1 to len(this:varlist)
        if( this:varlist[n]!=NIL )
            attrlist[++i]:=this:varlist[n]
        end
    end

    #ifdef HASH_PRINT //teszt
        hash_print(this:varlist)
        hash_print(this:blklist)
    #endif

    return NIL

****************************************************************************
//hash algoritmus
****************************************************************************
static function hash_rebuild(hash,len)
local hash1:=array(len),n,x
    for n:=1 to len(hash)
        if( hash[n]!=NIL )
            x:=hash_index(hash1,hash[n]:name)
            hash1[x]:=hash[n]
        end
    next
    return hash1

// A hash tábla egy array: {item1,item2,...},
// ahol item==NIL, vagy item egy name attribútummal rendelkező object,
// object:name játssza a kulcs szerepét.

****************************************************************************
static function hash_index(hash,key)

local hlen:=len(hash)
local hcode:=hashcode(key)
local hidx:=hcode%hlen
local item

    while( .t. )
        item:=hash[1+hidx]
        if( item==NIL )
            return 1+hidx
        elseif( item:name==key )
            return 1+hidx
        elseif( ++hidx>=hlen )
            hidx:=0
        end
    end
    return NIL

// Keresés a hash táblában:
// A ciklus véget ér, ui. a táblának van NIL eleme.
// visszatérés: hashidx
// Ha hash[hasidx]==NIL, akkor a keresett elem nincs a táblában,
//                       és éppen a hashidx helyre kell/lehet betenni.
// Ha hash[hasidx]!=NIL, akkor az a keresett elem.

****************************************************************************
#ifdef HASH_PRINT //csak teszteléshez

static function hash_print(hash)

local hidx,hidx0,coll
local elemcnt:=0,collcnt:=0

    for hidx:=1 to len(hash)
        if( hash[hidx]!=NIL )
            hidx0:=1+hashcode(hash[hidx]:name)%len(hash)
            coll:=(hidx-hidx0+len(hash))%len(hash)
            collcnt+=coll
            elemcnt++
            ?  hidx, padr(hash[hidx]:name,20), hidx0, replicate("!",coll)
        end
    next

    ?
    ? "tab length :",  len(hash)
    ? "item count :",  elemcnt
    ? "collisions :",  collcnt
    ?

#endif

****************************************************************************


Fixes #776

Fixes #776

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System
USING System.IO
USING System.Runtime
USING System.Diagnostics
USING System.Runtime.InteropServices
USING System.Collections.Generic
USING System.Runtime.CompilerServices
USING System.Linq

BEGIN NAMESPACE XSharp.IO
    // This class was inspired by a post on StackOverflow
    INTERNAL CLASS LRUCache<K,V> WHERE V IS CLASS
        PRIVATE _capacity as LONG
        PRIVATE _cacheMap AS Dictionary<K, LinkedListNode<LRUCacheItem<K, V>>>
        PRIVATE _lruList  AS LinkedList<LRUCacheItem<K, V>>

        INTERNAL CONSTRUCTOR (capacity as int)
            SELF:_capacity := capacity
            SELF:_cacheMap := Dictionary<K, LinkedListNode<LRUCacheItem<K, V>>>{}
            SELF:_lruList  := LinkedList<LRUCacheItem<K, V>>{}

        INTERNAL PROPERTY Values AS IList<V>
            GET
                VAR result := List<V>{}
                FOREACH VAR item in _cacheMap
                    VAR llnode := item:Value
                    VAR cacheItem := llnode:Value
                    result:Add(cacheItem:Value)
                NEXT
                RETURN result
            END GET
        END PROPERTY

        [MethodImpl(MethodImplOptions.Synchronized)];
        INTERNAL METHOD Get (key as K) AS V
            LOCAL node as LinkedListNode<LRUCacheItem<K, V>>
            if _cacheMap:TryGetValue(key, out node)
                LOCAL result := node:Value:Value AS V
                _lruList:Remove(node)
                _lruList:AddLast(node)
                return result
            ENDIF
        return default (V)

        [MethodImpl(MethodImplOptions.Synchronized)] ;
        INTERNAL METHOD Add(key as K, val as V) AS V
            LOCAL old as V
            if _cacheMap:Count >= _capacity
                old := SELF:RemoveFirst()
            ELSE
                old := NULL
            endif
            var cacheItem := LRUCacheItem<K, V>{key, val}
            var node      := LinkedListNode<LRUCacheItem<K, V>>{cacheItem}
            _lruList:AddLast(node)
            _cacheMap.Add(key, node)
        RETURN old

        PRIVATE METHOD RemoveFirst() AS V
            // Remove from LRUPriority
            var node := _lruList:First
            _lruList:RemoveFirst()
            // Remove from cache
            _cacheMap:Remove(node:Value:Key)
        RETURN node:Value:Value

        [MethodImpl(MethodImplOptions.Synchronized)];
        INTERNAL METHOD Remove(key as K) AS LOGIC
            IF _cacheMap:ContainsKey(key)
                VAR v := _cacheMap[key]
                _lruList:Remove(v)
                _cacheMap:Remove(key)
                return TRUE
            ENDIF
        RETURN FALSE

        [DebuggerDisplay("{Key}")];
        INTERNAL CLASS LRUCacheItem<K1,V1>
            INTERNAL @@Key as K1
            INTERNAL @@Value as V1
            INTERNAL CONSTRUCTOR (k as K1, v as V1)
                Key := k
                @@Value := v
        END CLASS
    END CLASS

    /// This class was inspired by the DiskIO module in Visual Objects
    INTERNAL CLASS PageBuffers
        [DebuggerDisplay("{Key}")];
        INTERNAL CLASS FilePage
            INTERNAL Stream     AS XsBufferedFileStream
            INTERNAL Page       AS INT64
            INTERNAL Buffer     AS Byte[]
            INTERNAL Size       AS LONG
            INTERNAL Used       AS LONG
            INTERNAL Hot        AS LOGIC
            INTERNAL PROPERTY Key  AS STRING GET GetHash(Stream, Page)

            INTERNAL STATIC METHOD GetHash(oStream as XsBufferedFileStream, nPage as INT64) AS STRING
                RETURN  oStream:FileName:ToLower()+":"+nPage:ToString()

            INTERNAL CONSTRUCTOR (oStream AS XsBufferedFileStream, nPage AS INT64, nSize AS LONG)
                SELF:Stream := oStream
                SELF:Page   := nPage
                SELF:Size   := nSize
                SELF:Used   := 0
                SELF:Hot    := FALSE
                SELF:Buffer := BYTE[]{nSize}

        END CLASS

        STATIC PROTECTED cache AS LRUCache<STRING, FilePage>

        STATIC CONSTRUCTOR
            cache := LRUCache<STRING, FilePage> {512}

        INTERNAL STATIC METHOD GetPage(oStream AS XsBufferedFileStream, nPage AS INT64, nSize AS LONG) AS FilePage
            VAR key  := FilePage.GetHash(oStream, nPage)
            VAR page := cache:Get(key)
            IF page == NULL
                page := __AddPage(oStream, nPage, nSize)
                VAR bytesRead := oStream:XRead(nPage, page:Buffer, nSize)
                page:Used     := bytesRead
                // if bytesRead < nSize then we have reached EOF
            ENDIF
            return page

        INTERNAL STATIC METHOD __AddPage(oStream AS XsBufferedFileStream, nPage AS INT64, nSize AS LONG) AS FilePage
            VAR page := FilePage{oStream, nPage, nSize}
            VAR old  := cache:Add(page:Key, page)
            IF old != NULL         // Cache is full, oldest page is returned and needs to written here
                __WritePage(old)
            ENDIF
        RETURN page

        INTERNAL STATIC METHOD __WritePage(page as FilePage) AS VOID
            IF !page:Hot
                RETURN
            ENDIF
            VAR nSize := Math.Min(page:Size, page:Used)
            IF ! page:Stream:XWrite( page:Page, page:Buffer, nSize)
                THROW Exception{"Error writing to disk"}
            ENDIF
            page:Hot := FALSE
        RETURN

        STATIC METHOD WritePages(oStream AS XsBufferedFileStream) AS VOID
            FOREACH VAR page IN cache:Values
                IF page:Stream == oStream
                    __WritePage(page)
                ENDIF
            NEXT
        RETURN

        STATIC METHOD FlushPages(oStream AS XsBufferedFileStream) AS VOID
            WritePages(oStream)
            FOREACH VAR page IN cache:Values:ToArray()
                IF page:Stream == oStream
                    // We can delete in the foreach loop because ToArray() creates a copy of the collection
                    cache:Remove(page:Key)
                ENDIF
            NEXT
        RETURN

    END CLASS

    /// This class performs buffered IO to files opened exclusively
    CLASS XsBufferedFileStream INHERIT XsFileStream

        PUBLIC CONST BUFF_SIZE  := 0x400 AS LONG
        PUBLIC CONST BUFF_MASK  := 0x3FF AS LONG
        PROTECTED _length   AS INT64
        PROTECTED _position AS INT64
        PROTECTED _closed   AS LOGIC
        PROTECTED _callOriginalMethods AS LOGIC

        CONSTRUCTOR(path AS STRING, mode AS FileMode, faccess AS FileAccess, share AS FileShare, bufferSize AS LONG, options AS FileOptions)
            SUPER(path, mode, faccess, share, bufferSize, options)
            SELF:_length := SUPER:Length
            SELF:Position := 0
            SELF:_callOriginalMethods := FALSE

        /// Bypass the buffered Read mechanism and call the original Read() method in the base class
        PUBLIC METHOD XRead(page AS INT64,bytes AS BYTE[] , count AS INT) AS INT
            SELF:_callOriginalMethods := TRUE
            SELF:Position := page
            VAR result := SUPER:Read(bytes, 0, count)
            SELF:_callOriginalMethods := FALSE
            RETURN result

        /// Bypass the buffered Write mechanism and call the original Write() method in the base class
        PUBLIC METHOD XWrite(page AS INT64, bytes AS BYTE[] , count AS INT) AS LOGIC
            SELF:_callOriginalMethods := TRUE
            SELF:Position := page
            SUPER:Write(bytes, 0, count)
            SELF:_callOriginalMethods := FALSE
            RETURN TRUE

        /// <inheritdoc />
        PUBLIC OVERRIDE PROPERTY Position AS INT64
            GET
                IF SELF:_callOriginalMethods
                    RETURN SUPER:Position
                ENDIF
                RETURN _position
            END GET
            SET
                IF SELF:_callOriginalMethods
                    SUPER:Position := VALUE
                ELSE
                    _position := VALUE
                ENDIF
            END SET
        END PROPERTY
        /// <inheritdoc />
        PUBLIC OVERRIDE PROPERTY Length   AS INT64
            GET
                IF SELF:_callOriginalMethods
                    RETURN SUPER:Length
                ENDIF
                RETURN _length
            END GET

        END PROPERTY

        /// <inheritdoc />

        PUBLIC OVERRIDE METHOD SetLength (newLength AS INT64) AS VOID
            IF SELF:_callOriginalMethods
                SUPER:SetLength(newLength)
            ENDIF
            _length := newLength

        /// <inheritdoc />
        /// <remarks>This method overrides the normal behavior of the FileStream class and reads the data from an inmemory cache, when possible </remarks>
        PUBLIC OVERRIDE METHOD Read(bytes AS BYTE[] , offset AS INT, count AS INT) AS INT
            // pages in the cache are 1 K
            IF SELF:_callOriginalMethods
                RETURN SUPER:Read(bytes, offset, count)
            ENDIF
            var pos         := SELF:Position
            VAR pageNo      := (INT64) _AND(pos , ~BUFF_MASK)
            var pageoffset  := (LONG) _AND(pos , BUFF_MASK)
            VAR read        := 0
            VAR endOfPage   := FALSE
            DO WHILE read < count .AND. ! endOfPage
                VAR page         := PageBuffers.GetPage(SELF, pageNo, BUFF_SIZE)
                VAR buffer       := page:Buffer
                // we either read the rest of the page, or just the bytes needed
                VAR onthispage   := count - read
                if onthispage > (BUFF_SIZE - pageoffset)
                    onthispage := BUFF_SIZE - pageoffset
                else
                    nop
                ENDIF
                IF pageoffset + onthispage > page:Used
                    onthispage := Math.Max(page:Used - pageoffset, 0)
                    endOfPage := TRUE
                ENDIF
                System.Array.Copy(buffer, pageoffset, bytes, offset+read, onthispage)
                pageNo     += BUFF_SIZE
                read       += onthispage
                pageoffset := 0                 // we start the next page on byte 0
            ENDDO
            SELF:Position += read
        RETURN read

        /// <inheritdoc />
        /// <remarks>This method overrides the normal behavior of the FileStream class and writed the data to an inmemory cache, when possible </remarks>
        PUBLIC OVERRIDE METHOD Write(bytes AS BYTE[] , offset AS INT, count AS INT) AS VOID
            IF SELF:_callOriginalMethods
                SUPER:Write(bytes, offset, count)
                RETURN
            ENDIF
            VAR pos         := SELF:Position
            VAR pageNo      := (INT64) _AND(pos , ~BUFF_MASK)
            var pageoffset  := (LONG) _AND(pos , BUFF_MASK)
            var written     := 0
            DO WHILE written < count
                VAR page         := PageBuffers.GetPage(SELF, pageNo, BUFF_SIZE)
                VAR buffer       := page:Buffer
                // we either write the rest of the page, or just the bytes needed
                VAR onthispage := count - written
                if onthispage > ( BUFF_SIZE - pageoffset)
                    onthispage :=  (BUFF_SIZE - pageoffset)
                else
                    nop
                endif
                System.Array.Copy(bytes, offset+written, buffer, pageoffset, onthispage)
                IF pageoffset + onthispage > page:Used
                   page:Used  := pageoffset + onthispage
                    Debug.Assert(page:Used <= page:Size)
                ENDIF
                page:Hot   := TRUE
                pageNo     += BUFF_SIZE
                written    += onthispage
                pageoffset := 0                 // we start the next page on byte 0
            ENDDO
            VAR newPos := pos + count
            SELF:_length  := Math.Max(SELF:_length, newPos)
            SELF:Position := newPos

        RETURN

        PRIVATE _temp := BYTE[]{1} AS BYTE[]
        /// <inheritdoc />
        /// <remarks>This method overrides the normal behavior of the FileStream class and writed the data to an inmemory cache, when possible </remarks>
        PUBLIC OVERRIDE METHOD WriteByte(b AS BYTE ) AS VOID
            IF SELF:_callOriginalMethods
                SUPER:WriteByte(b)
                RETURN
            ENDIF
            _temp[0] := b
            SELF:Write(_temp, 0, 1)
        RETURN

        /// <inheritdoc />
        /// <remarks>This method overrides the normal behavior of the FileStream class and flushes the cached data to disk before calling the parent Flush() method.</remarks>
        PUBLIC OVERRIDE METHOD Flush(lCommit AS LOGIC) AS VOID
            PageBuffers.WritePages(SELF)
            SUPER:Flush(lCommit)
            IF SUPER:Length != _length
                SUPER:SetLength(_length)
            ENDIF
            SELF:Position := _length
        RETURN

        /// <inheritdoc />
        /// <remarks>This method overrides the normal behavior of the FileStream class and flushes the cached data to disk before calling the parent Close() method.</remarks>
        PUBLIC OVERRIDE METHOD Close( ) AS VOID
            IF ! SELF:_closed
                PageBuffers.FlushPages(SELF)
                IF SUPER:Length != _length
                    SUPER:SetLength(_length)
                ENDIF
                SELF:_closed := TRUE
            ENDIF
            SUPER:Close()
            RETURN

        /// <inheritdoc />
        PUBLIC OVERRIDE METHOD Seek(offset AS INT64, origin AS SeekOrigin) AS INT64
            IF SELF:_callOriginalMethods
                RETURN SUPER:Seek(offset, origin)
            ENDIF
            var pos := self:Position
            SWITCH origin
            CASE SeekOrigin.Begin
                 pos := offset
            CASE SeekOrigin.Current
                 pos += offset
            CASE SeekOrigin.End
                 pos := offset + SELF:_length
            END SWITCH
            SELF:Position := pos
            return pos

        END CLASS

END NAMESPACE

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System
USING System.IO
USING System.Runtime
USING System.Diagnostics
USING System.Runtime.InteropServices
USING System.Collections.Generic
USING System.Runtime.CompilerServices
USING System.Linq

BEGIN NAMESPACE XSharp.IO
    // This class was inspired by a post on StackOverflow
    INTERNAL CLASS LRUCache<K,V> WHERE V IS CLASS
        PRIVATE _capacity as LONG
        PRIVATE _cacheMap AS Dictionary<K, LinkedListNode<LRUCacheItem<K, V>>>
        PRIVATE _lruList  AS LinkedList<LRUCacheItem<K, V>>

        INTERNAL CONSTRUCTOR (capacity as int)
            SELF:_capacity := capacity
            SELF:_cacheMap := Dictionary<K, LinkedListNode<LRUCacheItem<K, V>>>{}
            SELF:_lruList  := LinkedList<LRUCacheItem<K, V>>{}

        INTERNAL PROPERTY Values AS IList<V>
            GET
                VAR result := List<V>{}
                FOREACH VAR item in _cacheMap
                    VAR llnode := item:Value
                    VAR cacheItem := llnode:Value
                    result:Add(cacheItem:Value)
                NEXT
                RETURN result
            END GET
        END PROPERTY

        [MethodImpl(MethodImplOptions.Synchronized)];
        INTERNAL METHOD Get (key as K) AS V
            LOCAL node as LinkedListNode<LRUCacheItem<K, V>>
            if _cacheMap:TryGetValue(key, out node)
                LOCAL result := node:Value:Value AS V
                _lruList:Remove(node)
                _lruList:AddLast(node)
                return result
            ENDIF
        return default (V)

        [MethodImpl(MethodImplOptions.Synchronized)] ;
        INTERNAL METHOD Add(key as K, val as V) AS V
            LOCAL old as V
            if _cacheMap:Count >= _capacity
                old := SELF:RemoveFirst()
            ELSE
                old := NULL
            endif
            var cacheItem := LRUCacheItem<K, V>{key, val}
            var node      := LinkedListNode<LRUCacheItem<K, V>>{cacheItem}
            _lruList:AddLast(node)
            _cacheMap.Add(key, node)
        RETURN old

        PRIVATE METHOD RemoveFirst() AS V
            // Remove from LRUPriority
            var node := _lruList:First
            _lruList:RemoveFirst()
            // Remove from cache
            _cacheMap:Remove(node:Value:Key)
        RETURN node:Value:Value

        [MethodImpl(MethodImplOptions.Synchronized)];
        INTERNAL METHOD Remove(key as K) AS LOGIC
            IF _cacheMap:ContainsKey(key)
                VAR v := _cacheMap[key]
                _lruList:Remove(v)
                _cacheMap:Remove(key)
                return TRUE
            ENDIF
        RETURN FALSE

        [DebuggerDisplay("{Key}")];
        INTERNAL CLASS LRUCacheItem<K1,V1>
            INTERNAL @@Key as K1
            INTERNAL @@Value as V1
            INTERNAL CONSTRUCTOR (k as K1, v as V1)
                Key := k
                @@Value := v
        END CLASS
    END CLASS

    /// This class was inspired by the DiskIO module in Visual Objects
    INTERNAL CLASS PageBuffers
        [DebuggerDisplay("{Key}")];
        INTERNAL CLASS FilePage
            INTERNAL Stream     AS XsBufferedFileStream
            INTERNAL Page       AS INT64
            INTERNAL Buffer     AS Byte[]
            INTERNAL Size       AS LONG
            INTERNAL Used       AS LONG
            INTERNAL Hot        AS LOGIC
            INTERNAL PROPERTY Key  AS STRING GET GetHash(Stream, Page)

            INTERNAL STATIC METHOD GetHash(oStream as XsBufferedFileStream, nPage as INT64) AS STRING
                RETURN  oStream:FileName:ToLower()+":"+nPage:ToString()

            INTERNAL CONSTRUCTOR (oStream AS XsBufferedFileStream, nPage AS INT64, nSize AS LONG)
                SELF:Stream := oStream
                SELF:Page   := nPage
                SELF:Size   := nSize
                SELF:Used   := 0
                SELF:Hot    := FALSE
                SELF:Buffer := BYTE[]{nSize}

        END CLASS

        STATIC PROTECTED cache AS LRUCache<STRING, FilePage>

        STATIC CONSTRUCTOR
            cache := LRUCache<STRING, FilePage> {512}

        INTERNAL STATIC METHOD GetPage(oStream AS XsBufferedFileStream, nPage AS INT64, nSize AS LONG) AS FilePage
            VAR key  := FilePage.GetHash(oStream, nPage)
            VAR page := cache:Get(key)
            IF page == NULL
                page := __AddPage(oStream, nPage, nSize)
                VAR bytesRead := oStream:XRead(nPage, page:Buffer, nSize)
                page:Used     := bytesRead
                // if bytesRead < nSize then we have reached EOF
            ENDIF
            return page

        INTERNAL STATIC METHOD __AddPage(oStream AS XsBufferedFileStream, nPage AS INT64, nSize AS LONG) AS FilePage
            VAR page := FilePage{oStream, nPage, nSize}
            VAR old  := cache:Add(page:Key, page)
            IF old != NULL         // Cache is full, oldest page is returned and needs to written here
                __WritePage(old)
            ENDIF
        RETURN page

        INTERNAL STATIC METHOD __WritePage(page as FilePage) AS VOID
            IF !page:Hot
                RETURN
            ENDIF
            VAR nSize := Math.Min(page:Size, page:Used)
            IF ! page:Stream:XWrite( page:Page, page:Buffer, nSize)
                THROW Exception{"Error writing to disk"}
            ENDIF
            page:Hot := FALSE
        RETURN

        STATIC METHOD WritePages(oStream AS XsBufferedFileStream) AS VOID
            FOREACH VAR page IN cache:Values
                IF page:Stream == oStream
                    __WritePage(page)
                ENDIF
            NEXT
        RETURN

        STATIC METHOD FlushPages(oStream AS XsBufferedFileStream) AS VOID
            WritePages(oStream)
            FOREACH VAR page IN cache:Values:ToArray()
                IF page:Stream == oStream
                    // We can delete in the foreach loop because ToArray() creates a copy of the collection
                    cache:Remove(page:Key)
                ENDIF
            NEXT
        RETURN

    END CLASS

    /// This class performs buffered IO to files opened exclusively
    CLASS XsBufferedFileStream INHERIT XsFileStream

        PUBLIC CONST BUFF_SIZE  := 0x400 AS LONG
        PUBLIC CONST BUFF_MASK  := 0x3FF AS LONG
        PROTECTED _length   AS INT64
        PROTECTED _position AS INT64
        PROTECTED _closed   AS LOGIC
        PROTECTED _callOriginalMethods AS LOGIC

        CONSTRUCTOR(path AS STRING, mode AS FileMode, faccess AS FileAccess, share AS FileShare, bufferSize AS LONG, options AS FileOptions)
            SUPER(path, mode, faccess, share, bufferSize, options)
            SELF:_length := SUPER:Length
            SELF:Position := 0
            SELF:_callOriginalMethods := FALSE

        /// Bypass the buffered Read mechanism and call the original Read() method in the base class
        PUBLIC METHOD XRead(page AS INT64,bytes AS BYTE[] , count AS INT) AS INT
            SELF:_callOriginalMethods := TRUE
            SELF:Position := page
            VAR result := SUPER:Read(bytes, 0, count)
            SELF:_callOriginalMethods := FALSE
            RETURN result

        /// Bypass the buffered Write mechanism and call the original Write() method in the base class
        PUBLIC METHOD XWrite(page AS INT64, bytes AS BYTE[] , count AS INT) AS LOGIC
            SELF:_callOriginalMethods := TRUE
            SELF:Position := page
            SUPER:Write(bytes, 0, count)
            SELF:_callOriginalMethods := FALSE
            RETURN TRUE

        /// <inheritdoc />
        PUBLIC OVERRIDE PROPERTY Position AS INT64
            GET
                IF SELF:_callOriginalMethods
                    RETURN SUPER:Position
                ENDIF
                RETURN _position
            END GET
            SET
                IF SELF:_callOriginalMethods
                    SUPER:Position := VALUE
                ELSE
                    _position := VALUE
                ENDIF
            END SET
        END PROPERTY
        /// <inheritdoc />
        PUBLIC OVERRIDE PROPERTY Length   AS INT64
            GET
                IF SELF:_callOriginalMethods
                    RETURN SUPER:Length
                ENDIF
                RETURN _length
            END GET

        END PROPERTY

        /// <inheritdoc />

        PUBLIC OVERRIDE METHOD SetLength (newLength AS INT64) AS VOID
            IF SELF:_callOriginalMethods
                SUPER:SetLength(newLength)
            ENDIF
            _length := newLength

        /// <inheritdoc />
        /// <remarks>This method overrides the normal behavior of the FileStream class and reads the data from an inmemory cache, when possible </remarks>
        PUBLIC OVERRIDE METHOD Read(bytes AS BYTE[] , offset AS INT, count AS INT) AS INT
            // pages in the cache are 1 K
            IF SELF:_callOriginalMethods
                RETURN SUPER:Read(bytes, offset, count)
            ENDIF
            var pos         := SELF:Position
            VAR pageNo      := (INT64) _AND(pos , ~BUFF_MASK)
            var pageoffset  := (LONG) _AND(pos , BUFF_MASK)
            VAR read        := 0
            VAR endOfPage   := FALSE
            DO WHILE read < count .AND. ! endOfPage
                VAR page         := PageBuffers.GetPage(SELF, pageNo, BUFF_SIZE)
                VAR buffer       := page:Buffer
                // we either read the rest of the page, or just the bytes needed
                VAR onthispage   := count - read
                if onthispage > (BUFF_SIZE - pageoffset)
                    onthispage := BUFF_SIZE - pageoffset
                else
                    nop
                ENDIF
                IF pageoffset + onthispage > page:Used
                    onthispage := Math.Max(page:Used - pageoffset, 0)
                    endOfPage := TRUE
                ENDIF
                System.Array.Copy(buffer, pageoffset, bytes, offset+read, onthispage)
                pageNo     += BUFF_SIZE
                read       += onthispage
                pageoffset := 0                 // we start the next page on byte 0
            ENDDO
            SELF:Position += read
        RETURN read

        /// <inheritdoc />
        /// <remarks>This method overrides the normal behavior of the FileStream class and writed the data to an inmemory cache, when possible </remarks>
        PUBLIC OVERRIDE METHOD Write(bytes AS BYTE[] , offset AS INT, count AS INT) AS VOID
            IF SELF:_callOriginalMethods
                SUPER:Write(bytes, offset, count)
                RETURN
            ENDIF
            VAR pos         := SELF:Position
            VAR pageNo      := (INT64) _AND(pos , ~BUFF_MASK)
            var pageoffset  := (LONG) _AND(pos , BUFF_MASK)
            var written     := 0
            DO WHILE written < count
                VAR page         := PageBuffers.GetPage(SELF, pageNo, BUFF_SIZE)
                VAR buffer       := page:Buffer
                // we either write the rest of the page, or just the bytes needed
                VAR onthispage := count - written
                if onthispage > ( BUFF_SIZE - pageoffset)
                    onthispage :=  (BUFF_SIZE - pageoffset)
                else
                    nop
                endif
                System.Array.Copy(bytes, offset+written, buffer, pageoffset, onthispage)
                IF pageoffset + onthispage > page:Used
                   page:Used  := pageoffset + onthispage
                    Debug.Assert(page:Used <= page:Size)
                ENDIF
                page:Hot   := TRUE
                pageNo     += BUFF_SIZE
                written    += onthispage
                pageoffset := 0                 // we start the next page on byte 0
            ENDDO
            VAR newPos := pos + count
            SELF:_length  := Math.Max(SELF:_length, newPos)
            SELF:Position := newPos

        RETURN

        /// <inheritdoc />
        /// <remarks>This method overrides the normal behavior of the FileStream class and writed the data to an inmemory cache, when possible </remarks>
        PUBLIC OVERRIDE METHOD WriteByte(b AS BYTE ) AS VOID
            IF SELF:_callOriginalMethods
                SUPER:WriteByte(b)
                RETURN
            ENDIF
            VAR pos             := SELF:Position
            VAR pageNo          := (INT64) _AND(pos , ~BUFF_MASK)
            var pageoffset      := (LONG) _AND(pos , BUFF_MASK)
            VAR page            := PageBuffers.GetPage(SELF, pageNo, BUFF_SIZE)
            page:Buffer[pageoffset]  := b
            page:Hot            := TRUE
            SELF:_length  := Math.Max(SELF:_length, pos+1)
            SELF:Position := pos+1
        RETURN

        /// <inheritdoc />
        /// <remarks>This method overrides the normal behavior of the FileStream class and flushes the cached data to disk before calling the parent Flush() method.</remarks>
        PUBLIC OVERRIDE METHOD Flush(lCommit AS LOGIC) AS VOID
            PageBuffers.WritePages(SELF)
            SUPER:Flush(lCommit)
            IF SUPER:Length != _length
                SUPER:SetLength(_length)
            ENDIF
            SELF:Position := _length
        RETURN

        /// <inheritdoc />
        /// <remarks>This method overrides the normal behavior of the FileStream class and flushes the cached data to disk before calling the parent Close() method.</remarks>
        PUBLIC OVERRIDE METHOD Close( ) AS VOID
            IF ! SELF:_closed
                PageBuffers.FlushPages(SELF)
                IF SUPER:Length != _length
                    SUPER:SetLength(_length)
                ENDIF
                SELF:_closed := TRUE
            ENDIF
            SUPER:Close()
            RETURN

        /// <inheritdoc />
        PUBLIC OVERRIDE METHOD Seek(offset AS INT64, origin AS SeekOrigin) AS INT64
            IF SELF:_callOriginalMethods
                RETURN SUPER:Seek(offset, origin)
            ENDIF
            var pos := self:Position
            SWITCH origin
            CASE SeekOrigin.Begin
                 pos := offset
            CASE SeekOrigin.Current
                 pos += offset
            CASE SeekOrigin.End
                 pos := offset + SELF:_length
            END SWITCH
            SELF:Position := pos
            return pos

        END CLASS

END NAMESPACE