Interface scannen mit JSON / wieder mal eine Class.pbi

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Interface scannen mit JSON / wieder mal eine Class.pbi

Beitrag von GPI »

Warum hat mir keiner gesagt, das man mittels den JSON-Befehlen ein Interface "Scannen" kann und so die Namen und Positionen rausbekommen kann?

InsertJSONStructure( ObjectValue,*vt,Interface)

Akzeptiert auch Interfaces. Man muss nur als "Variable" einen nummerierten (Integer) Speicherbereich übergeben (größe über SizeOf(Interface) ermitteln) und schon hat man alle "Member" als String und ihre Positionen in JSON, die man auf verschiedene Art und Weise auslesen kann.

Mit der Runtime-Bibliothek erhält man ein sehr mächtiges Werkzeug. So lassen sich zu den Interface-Member-Namen problemlos die passenden Proceduren finden - solange diese Proceduren ein Runtime davor stehen haben.

Es gibt leider nur zwei größere "Probleme". Zum einen bekommt man so die nicht die Parameter-Liste. Das wäre für den einen oder anderen Fall durchaus interessant. Zum anderen gibt es das problem, dass das "Interface/Structure" bei InsertJSONStructure nicht variable sein kann, da sich Structure/Interface-Namen nicht in Variablen speichern lassen und Strings hier nicht akzeptiert werden. Auch bekommt man leider nicht mit, ob das Interface ein "Extend" eines anderen Interface ist.

Für was man sowas alles braucht? Eine Klassen-Verwaltungs-Include-Datei bspw. Durch den Trick über das JSON spart man sich ein haufen "asMethod" und andere Tricks. Man muss nur vor jeder Methode-Procedure ein RUNTIME schreiben, damit es gefunden wird und fertig.

Ich hab mal wieder gebastelt. Nur ein paar Hinweise: Class::Declare() ist vollständig optional. Der Unterschied zwischen Class::New und Class::FastNew liegt daran, das New die Runtime-Bibliothek zwingend benötigt. FastNew greift direkt auf eine globale Variable zurück, die muss aber vorher mit Class::Declare/Define() definiert werden. Die VT-Table der Klassen werden überigens beim ersten Aufruf von NEW erzeugt oder wenn man sie mittels class::init() initialisiert.

Code: Alles auswählen


DeclareModule __Class;----Declare __Class
  EnableExplicit
  Prototype.i OnePara(one.i)
  Prototype.i TwoPara(one.i,two.i)
  Prototype.i NonePara()
  Prototype.s output(*obj,jsonflag=0)
  
  #isDLL=Bool(#PB_Compiler_ExecutableFormat=#PB_Compiler_DLL)
  
  Structure MethodsList
    name.s
    pos.i
    *method.onepara
  EndStructure
  
  Structure ClassInfo
    *Class_VT;must be first!
    Name.s
    Array methods.MethodsList(0)
    *vt
    SizeOfVT.i 
    Constructor.OnePara
    ConstructorEx.TwoPara
    CopyConstructor.OnePara
    Destructor.OnePara
    Allocate.NonePara
    CopyObj.OnePara
    Output.Output
    Array *Uplist.ClassInfo(0)
    *Extends.ClassInfo
  EndStructure
  
  Macro _c34
    "
  EndMacro
  
  Declare _new(class.s,modulename.s,*para=0)
  Declare GetClassInfo(class.s,ModuleName.s="")
EndDeclareModule
;-
DeclareModule Class;----Declare Class
  EnableExplicit
  Interface class
    new(*para=0)
    free(*obj.integer)
    copy(*obj.integer)
    IsClass(*obj.integer)
    IsAccessable(*obj.integer)
    GetName.s(*obj.integer)
  EndInterface
  
  Global Class.Class
  
  Macro Declare(classname,extendClass=/,AllowNull=0)
    CompilerIf Not Defined(classname#__sizeof,#PB_Constant)
      CompilerIf SizeOf(classname)
        #classname#__sizeof=SizeOf(classname)
      CompilerElse
        #classname#__sizeof=SizeOf(integer)
      CompilerEndIf
      
      CompilerIf __class::_c34#extendClass#__class::_c34<>"/"
        #classname#__extends=__class::_c34#extendClass#__class::_c34
      CompilerElse
        #classname#__extends=""
      CompilerEndIf
      
      #classname#__module=#PB_Compiler_Module
      #classname#__AllowNull=AllowNull
      Runtime #classname#__sizeof
      Runtime #classname#__extends
      Runtime #classname#__module
      Runtime #classname#__AllowNull
      Global classname#__ClassInfo
      Runtime classname#__ClassInfo
      Global classname.class::class
      CompilerIf  Not __class::#isDLL
        classname=__class::GetClassInfo(__class::_c34#classname#__class::_c34,#PB_Compiler_Module)
      CompilerEndIf
    CompilerEndIf
  EndMacro
  
  Macro Define(classname,extendClass=/,AllowNull=0)
    CompilerIf OffsetOf(s#classname\__vt)<>0
      CompilerError "s"+__class::_c34#classname#__class::_c34+" Structure-Error. __VT is not first element!"
    CompilerEndIf
    
    CompilerIf Not Defined(classname#__sizeof,#PB_Constant)
      CompilerIf SizeOf(classname)
        #classname#__sizeof=SizeOf(classname)
      CompilerElse
        #classname#__sizeof=SizeOf(integer)
      CompilerEndIf
      
      CompilerIf __class::_c34#extendClass#__class::_c34<>"/"
        #classname#__extends=__class::_c34#extendClass#__class::_c34
      CompilerElse
        #classname#__extends=""
      CompilerEndIf
      
      #classname#__module=#PB_Compiler_Module
      #classname#__AllowNull=AllowNull

      Runtime #classname#__sizeof
      Runtime #classname#__extends
      Runtime #classname#__module
      Runtime #classname#__AllowNull
      
      Global classname#__ClassInfo
      Runtime classname#__ClassInfo
      Global classname.class::class
    CompilerEndIf  
    
    CompilerIf __class::#isDLL
      Procedure classname#___Init()
        classname=__class::GetClassInfo(__class::_c34#classname#__class::_c34,#PB_Compiler_Module)
      EndProcedure
      classname#___Init()
    CompilerElse
      classname=__class::GetClassInfo(__class::_c34#classname#__class::_c34,#PB_Compiler_Module)
    CompilerEndIf
    
    Runtime Procedure.i classname#___GetTable(Array functions.__class::MethodsList(1))
      Protected js,i,ii,*vt,ObjectValue
      CompilerIf SizeOf(classname)
        Dim functions(SizeOf(classname)/SizeOf(integer)-1)
        
        js=CreateJSON(#PB_Any)
        If js
          *vt=AllocateMemory(SizeOf(classname))
          If *vt
            For i=0 To SizeOf(classname)-SizeOf(integer) Step SizeOf(integer)
              PokeI(*vt+i,i)
            Next
            
            ObjectValue=JSONValue(js)
            InsertJSONStructure( ObjectValue,*vt,classname)
            FreeMemory(*vt)
            
            If ExamineJSONMembers(ObjectValue)
              While NextJSONMember(ObjectValue)
                i=GetJSONInteger(JSONMemberValue(ObjectValue))
                ii=i/SizeOf(integer)
                functions(ii)\name=JSONMemberKey(ObjectValue)
                functions(ii)\pos=GetJSONInteger(JSONMemberValue(ObjectValue))
              Wend
            EndIf
            
            ;ExtractJSONMap(JSONValue(js),functions())
          EndIf
        EndIf  
        FreeJSON(js)
      CompilerElse
        ;Dim functions(0)
      CompilerEndIf
    EndProcedure
    Runtime Procedure.s classname#___Output(*obj,flag=0)
      Protected ret.s,js
      js=CreateJSON(#PB_Any)
      If js
        InsertJSONStructure( JSONValue(js), *obj, s#classname)
        ret=ComposeJSON(js,flag)
        FreeJSON(#PB_Any)
      EndIf
      ProcedureReturn ret
    EndProcedure  
    Runtime Procedure.i classname#___Allocate()
      ProcedureReturn AllocateStructure(s#classname)
    EndProcedure
    Runtime Procedure.i classname#___Copy(*obj)
      Protected *new=AllocateStructure(s#ClassName)
      If *new
        CopyStructure(*obj,*new,s#ClassName)
      EndIf
      ProcedureReturn *new
    EndProcedure
  EndMacro
  
  Macro New(classname,para=0)
    (__class::_new(__class::_c34#classname#__class::_c34,#PB_Compiler_Module,para))
  EndMacro
  Macro FastNew(classname,para=0)
    (classname\new(para))
  EndMacro  
  Declare Copy(*obj.integer)
  Declare Call(*obj,method.s)
  Declare.s GetName(*obj.integer)
  
  Declare Free(*obj)
  
  Macro Delete(obj)
    class::free(Obj)
  EndMacro
  
  Declare.s Output(*obj.integer)
  
  Global CountObjects
  
  ;-Class::PBObject
  Interface PBObject
    GetPBHandle()
    GetID()
    Free()
  EndInterface
  Structure sPBObject
    *__vt
    handle.i
  EndStructure
  class::Declare(PBObject,/,#True)
  Declare GetPBObject(*class,handle)
  Declare.s XMAP(i)
EndDeclareModule
;-
Module __Class;----__Class
  Prototype.i GetTable(Array functions.MethodsList(1))
  
  Declare CreateTable(class.s)
  Declare ClassNew(*ClassInfo.ClassInfo,*para=0)    
  Declare ClassFree(*ClassInfo.ClassInfo,*obj.integer)
  Declare ClassCopy(*ClassInfo.ClassInfo,*obj.integer)
  Declare ClassIsClass(*ClassInfo.ClassInfo,*obj.integer)
  Declare ClassIsAccessable(*ClassInfo.ClassInfo,*obj.integer)
  Declare.s ClassGetName(*ClassInfo.ClassInfo,*obj.integer)
  DataSection
    vt_new:
    Data.i @ClassNew(),@ClassFree(),@ClassCopy(),@ClassIsClass(),@ClassIsAccessable()
    class_vt:
    Data.i ?vt_new
  EndDataSection
  
  CompilerIf #isDLL
    Procedure __Class_Init()
      class::class=?class_vt
    EndProcedure
    __Class_Init()
  CompilerElse
    class::class=?Class_vt
  CompilerEndIf
  
  Procedure ClassIsClass(*ClassInfo.ClassInfo,*obj.integer)
    ProcedureReturn Bool(*ClassInfo\vt=*obj\i)
  EndProcedure
  
  Procedure ClassIsAccessable(*ClassInfo.ClassInfo,*obj.integer)
    Protected *ObjectInfo.ClassInfo
    Protected i
    Protected ret=#False
    *ObjectInfo=PeekI(*obj\i-SizeOf(integer))
    For i=0 To ArraySize(*ObjectInfo\Uplist())
      If *ObjectInfo\Uplist(i)\vt=*ClassInfo\vt
        ret=#True
        Break
      EndIf
    Next
    ProcedureReturn ret    
  EndProcedure
  
  Procedure.s ClassGetName(*ClassInfo.ClassInfo,*obj.integer)
    ProcedureReturn class::GetName(*obj)
  EndProcedure  
  
  Procedure ClassFree(*ClassInfo.ClassInfo,*obj.integer)
    ProcedureReturn class::free(*obj)  
  EndProcedure  
  Procedure ClassCopy(*ClassInfo.ClassInfo,*obj.integer)
    ProcedureReturn class::copy(*obj)
  EndProcedure
  
  Procedure GetClassInfo(class.s,ModuleName.s="")
    Protected *ClassInfo.ClassInfo
    
    If ModuleName<>"" And FindString(class,"::")=0
      class=ModuleName+"::"+class
    EndIf
    
    *ClassInfo=GetRuntimeInteger(class+"__ClassInfo")
    If *ClassInfo=0
      ;Debug "INTIALIZE CLASS:"+class
      *classInfo=CreateTable(class)
      SetRuntimeInteger(class+"__ClassInfo",*ClassInfo)
    EndIf
    ProcedureReturn *ClassInfo
  EndProcedure
  
  Procedure CreateTable(class.s)
    Protected GetTable.GetTable
    Protected *method
    Protected constclass.s
    Protected pos,i,count
    Protected *buf.integer
    Protected ExtendClass.s,*ExtendClassInfo.ClassInfo
    Protected *ClassInfo.ClassInfo
    Protected ModuleName.s
    Protected OnlyClass.s
    Protected AllowNull
    *ClassInfo=AllocateStructure(*ClassInfo)
    
    ;NewMap functions.i()
    
    pos=FindString(class,"::")
    If pos
      pos+1
      constclass=Left(class,pos)+"#"+Mid(class,pos+1)
      OnlyClass=Mid(class,pos+1)
    Else
      constclass="#"+class
      OnlyClass=Class
    EndIf
    
    AllowNull=GetRuntimeInteger(constclass+"__AllowNull")
    ExtendClass=GetRuntimeString(constclass+"__Extends")
    
    If extendClass<>"" 
      ModuleName=GetRuntimeString(constclass+"__Module")
      If ModuleName<>"" And FindString(ExtendClass,"::")=0
        ExtendClass=ModuleName+"::"+ExtendClass
      EndIf
      
      *ExtendClassInfo=GetClassInfo(ExtendClass)
      
      CompilerIf #PB_Compiler_Debugger
        ;Debug "Check "+class+": extend "+ExtendClass
        If *ExtendClassInfo=0
          Debug class+": extend "+ExtendClass+" doesn't exist."
          CallDebugger
          End
        EndIf
      CompilerEndIf
    EndIf
    
    GetTable=GetRuntimeInteger(class+"___GetTable()")
    If GetTable=0
      FreeStructure(*ClassInfo)
      ProcedureReturn 0
    EndIf    
    
    
    
    *ClassInfo\SizeOfVT=GetRuntimeInteger(constclass+"__SizeOf")
    
    If *ClassInfo\SizeOfVT
      *buf=AllocateMemory(*ClassInfo\SizeOfVT+SizeOf(integer))
      
      *buf\i=*ClassInfo
      *ClassInfo\vt=*buf+SizeOf(integer)
      
      If *ExtendClassInfo
        CopyMemory(*ExtendClassInfo\vt,*ClassInfo\vt,*ExtendClassInfo\SizeOfVT)
        count=ArraySize(*ExtendClassInfo\Uplist())
        ReDim *ClassInfo\Uplist( count +1)
        For i=0 To Count
          *ClassInfo\Uplist(i)=*ExtendClassInfo\Uplist(i)
        Next
        *ClassInfo\Extends=*ExtendClassInfo
      EndIf
      
      GetTable(*ClassInfo\methods())
      For i=0 To ArraySize( *ClassInfo\methods())
        With *ClassInfo\methods(i)
          If \name<>""
            *method=GetRuntimeInteger(class+"_"+ \name +"()")
            If *method 
              PokeI(*ClassInfo\vt + \pos,*method)
              \method=*method
              
              CompilerIf #PB_Compiler_Debugger
              ElseIf AllowNull=#False And PeekI(*ClassInfo\vt + \pos)=0
                Debug "Missing Method (or RUNTIME): "+class+"_"+ \name+"()"
                CallDebugger
                End
              CompilerEndIf
            EndIf
          EndIf
        EndWith
      Next
      ;FreeMap(functions())      
      
      *ClassInfo\ConstructorEx  =GetRuntimeInteger(class+"__ConstructorEx()")
      If *ClassInfo\ConstructorEx=0
        *ClassInfo\ConstructorEx   =GetRuntimeInteger(class+"_"+OnlyClass+"Ex()")
        If *ClassInfo\ConstructorEx=0
          *ClassInfo\Constructor    =GetRuntimeInteger(class+"__Constructor()")
          If *ClassInfo\Constructor=0
            *ClassInfo\Constructor    =GetRuntimeInteger(class+"_"+OnlyClass+"()")
          EndIf
        EndIf
      EndIf
      
      *ClassInfo\Destructor     =GetRuntimeInteger(class+"__Destructor()")
      If *ClassInfo\Destructor=0
        *ClassInfo\Destructor     =GetRuntimeInteger(class+"_De"+OnlyClass+"()")
      EndIf
      
      *ClassInfo\CopyConstructor=GetRuntimeInteger(class+"__CopyConstructor()")
      
      *ClassInfo\Allocate   =GetRuntimeInteger(class+"___Allocate()")
      *ClassInfo\CopyObj    =GetRuntimeInteger(class+"___Copy()")
      *ClassInfo\Output     =GetRuntimeInteger(class+"___Output()")
      *ClassInfo\Name       = Class
      
      *ClassInfo\Class_VT = ?vt_new
      *ClassInfo\Uplist( ArraySize(*ClassInfo\Uplist()) )=*ClassInfo
      
    EndIf
    
    ProcedureReturn *ClassInfo
    
  EndProcedure
  
  Procedure _new(class.s,ModuleName.s,*para=0)
    Protected *ClassInfo.ClassInfo   
    Protected *obj.integer
    
    If FindString(class,"::")
      ModuleName=""
    ElseIf ModuleName<>""
      ModuleName+"::"
    EndIf
    *ClassInfo=GetClassInfo(ModuleName+class)
    If *ClassInfo
      class=ModuleName+class
    ElseIf FindString(class,"::")=0
      class=class+"::"+class
      *ClassInfo=GetClassInfo(class)
    EndIf
    
    If *ClassInfo=0
      Debug "Class not found: "+ class
      CallDebugger
      End
    EndIf
    
    *Obj=classNew(*ClassInfo,*para)
    ProcedureReturn *obj
  EndProcedure
  
  Procedure ClassNew(*ClassInfo.ClassInfo,*para=0)  
    Protected *obj.integer,i,do=#True
    *Obj=*ClassInfo\Allocate()
    If *obj=0
      ProcedureReturn 0
    EndIf
    
    class::CountObjects+1
    
    PokeI(*obj,*ClassInfo\vt)
    
    ;Call all constructors
    For i=0 To ArraySize(*ClassInfo\Uplist())
      
      If *ClassInfo\Uplist(i)\ConstructorEx 
        do=*ClassInfo\Uplist(i)\ConstructorEx(*obj,*para)
      ElseIf *classinfo\Uplist(i)\Constructor 
        do=*classinfo\Uplist(i)\Constructor(*obj)
      EndIf
      
      If do=0
        While i>0
          i-1
          If *ClassInfo\Uplist(i)\Destructor 
            *ClassInfo\Uplist(i)\Destructor(*obj)
          EndIf
        Wend
        FreeStructure(*obj)
        *obj=0
        Break
      EndIf
    Next
    
    ProcedureReturn *obj
  EndProcedure
  
  
EndModule

;-
Module Class;----class
  UseModule __class
  Procedure Copy(*obj.integer)
    Protected *ClassInfo.ClassInfo
    Protected *new.integer
    Protected i
    
    If *obj
      *ClassInfo=PeekI(*obj\i-SizeOf(integer))
      
      *new=*ClassInfo\CopyObj(*obj)
      
      If *new
        For i=0 To ArraySize( *ClassInfo\Uplist() )
          If *ClassInfo\Uplist(i)\CopyConstructor And *ClassInfo\Uplist(i)\CopyConstructor(*new)=0
            While i>0
              i-1
              If *ClassInfo\Uplist(i)\Destructor 
                *ClassInfo\Uplist(i)\Destructor(*new)
              EndIf
            Wend
            FreeStructure(*new)
            *new=0
            Break
          EndIf
        Next
      EndIf
      
    EndIf
    
    If *new
      class::CountObjects+1
    EndIf
    
    ProcedureReturn *new
  EndProcedure
  Procedure Call(*obj.integer,Method.s)
    Protected *ClassInfo.ClassInfo
    Protected *ret,i
    If *obj
      *ClassInfo=PeekI(*obj\i-SizeOf(integer))
      
      method=UCase(Method)
      
      For i=0 To ArraySize(*ClassInfo\methods())
        With *ClassInfo\methods(i)
          If UCase( \name )=method
            *ret= \method
            Break
          EndIf
        EndWith
      Next
      
      
    EndIf
    ProcedureReturn *ret
  EndProcedure
  Procedure.s GetName(*obj.integer)
    Protected *ClassInfo.ClassInfo
    If *obj
      *ClassInfo=PeekI(*obj\i-SizeOf(integer))
      ProcedureReturn *ClassInfo\Name
    EndIf
  EndProcedure
  Procedure Free(*obj.integer)
    Protected *ClassInfo.ClassInfo
    If *obj And *obj\i<>0
      class::CountObjects-1
      
      *ClassInfo=PeekI(*obj\i-SizeOf(integer))
      While *ClassInfo
        If *ClassInfo\Destructor
          *ClassInfo\Destructor(*obj)
        EndIf
        *ClassInfo=*ClassInfo\Extends
      Wend
      *obj\i=0      
      FreeStructure(*obj)
      
    EndIf
  EndProcedure
  Procedure.s Output(*obj.integer)
    Protected *ClassInfo.ClassInfo
    Protected ret.s
    *ClassInfo=PeekI(*obj\i-SizeOf(integer))
    ret=Hex(*obj)+" "+*ClassInfo\Name+" - "+*ClassInfo\Output(*obj,0)
    ProcedureReturn ret
  EndProcedure
  
  
  ;Klasse PBObject- handle sichern und wiederherstellen.
  CompilerIf #PB_Compiler_Processor=#PB_Processor_x86
    #_handlemask=$11111111
    #_handleadd= $22222222
  CompilerElse
    #_handlemask=$1111111111111111
    #_handleadd= $2222222222222222
  CompilerEndIf
  Threaded _handlestring.s
  Threaded *_g1.integer,*_g2.integer
  Procedure.s XMap(i)    
    If *_g1=0
      _handlestring=Space(SizeOf(integer))
      *_g1=@_handlestring
      *_g2=@_handlestring+SizeOf(integer)
    EndIf
    *_g1\i= (i | #_handlemask)
    *_g2\i= (i & #_handlemask) | #_handleadd
    ProcedureReturn _handlestring
  EndProcedure
  Structure handle
    Map *object.PBObject()
  EndStructure
  Global NewMap ClassObject.handle()
  
  Procedure GetPBObject(*class.ClassInfo,handle)
    If FindMapElement( ClassObject(*class\Name)\object(),xmap(handle))
      ProcedureReturn ClassObject(*class\Name)\object()
    EndIf
  EndProcedure
  
  class::Define(PBObject)
  Runtime Procedure PBObject_PBObjectEx(*self.sPBObject,handle)
    *self\handle = handle
    ClassObject(GetName(*self))\object(xmap(handle))=*self
    ProcedureReturn handle
  EndProcedure
  Runtime Procedure PBObject__CopyConstructor(*self.sPBObject)
    ;Debug "copyConstructor"
    ProcedureReturn #False
  EndProcedure
  Runtime Procedure PBObject_DePBObject(*self.sPBObject)
    If *self\handle
      DeleteMapElement( ClassObject(GetName(*self))\object(),xmap(*self\handle))
      *self\handle=0
    EndIf
  EndProcedure
  Runtime Procedure PBObject_GetPBHandle(*self.sPBObject)
    ProcedureReturn *self\handle
  EndProcedure
  Runtime Procedure PBObject_Free(*self.PBObject)
    class::free(*self)
    ProcedureReturn #Null
  EndProcedure
    
EndModule
;-
;-
;-example
CompilerIf #PB_Compiler_IsMainFile
  
  DeclareModule test
    Interface Counter
      Reset()
      Add(value.i=1)
      Set(value.i)
      Get()
    EndInterface
    
    Structure SCounter
      *__vt
      value.i
    EndStructure
    
    Interface CounterPlus Extends Counter
      Sub(value.i)
    EndInterface
    Structure sCounterPlus Extends sCounter
    EndStructure
    class::Declare(Counter)
    class::Declare(CounterPlus,Counter)
    
  EndDeclareModule
  
  Module test
    
    ;class::Init(Counter)
    ;class::init(CounterPlus)
    
    
    c2.CounterPlus=class::FastNew(CounterPlus)
    c2\Set(20)
    Debug c2\Get()
    c2\sub(2)
    Debug c2\get()
    c2\Reset()
    Debug c2\Get()
    
    class::Free(c2)
    
    c1.counter=class::new(Counter)
    c1\Set(20)
    Debug c1\Get()
    c1\Add(2)
    Debug c1\get()
    c1\Reset()
    Debug c1\Get()
    c1\add(40)
    
    c1b.counter=class::Copy(c1)
    
    
    Debug c1b\Get()
    c1b\Set(99)
    Debug c1b\get()
    Debug c1\get()
    c1\set(10)
    

    
    class::Free(c1)
    
    Debug c1b\get()
    
    
    Debug CallFunctionFast(class::Call(c1b,"get"),c1b)
    
    
    class::free(c1b)
    
    
    Runtime Procedure Counter_Reset(*self.SCounter)
      *self\value=0
    EndProcedure
    Runtime Procedure Counter_Add(*self.sCounter, Value.i)
      *self\value+value
      ProcedureReturn *self\value
    EndProcedure
    Runtime Procedure Counter_Set(*self.sCounter, Value.i)
      *self\value=value
      ProcedureReturn *self\value
    EndProcedure
    Runtime Procedure Counter_Get(*self.SCounter)
      ProcedureReturn *self\value
    EndProcedure
    Runtime Procedure Counter__Constructor(*self.sCounter)
      Debug "New Counter:"+*self
      ProcedureReturn #True
    EndProcedure
    Runtime Procedure Counter__Destructor(*self.sCounter)
      Debug "Destroy Counter:"+*self
    EndProcedure
    Runtime Procedure Counter__CopyConstructor(*self.sCounter)
      Debug "CopyConstructor:"+*self
      ProcedureReturn #True
    EndProcedure
    
    
    Runtime Procedure CounterPlus_Sub(*self.sCounterPlus,value.i)
      *self\value-Value 
    EndProcedure
    Runtime Procedure CounterPlus__Constructor(*self.sCounterPlus)
      Debug "New CounterPlus:"+*self
      ProcedureReturn #True
    EndProcedure
    Runtime Procedure CounterPlus__Destructor(*self.sCounterPlus)
      Debug "Destroy CounterPlus:"+ *self
    EndProcedure
    Runtime Procedure CounterPlus_Get(*self.sCounterPlus)
      ProcedureReturn *self\value+10000
    EndProcedure
    
    
    class::Define(CounterPlus,Counter)
    
    class::Define(Counter)
  EndModule
  
  Interface Counter Extends Test::Counter
    mul(value.i)
    OldGet()
  EndInterface
  Structure sCounter Extends Test::sCounter
    oldvalue.i
  EndStructure
  
  
  Runtime Procedure Counter_Mul(*self.sCounter,value.i)
    *self\oldvalue=*self\value
    *self\value * value
  EndProcedure
  Runtime Procedure Counter_OldGet(*self.sCounter)
    ProcedureReturn *self\oldvalue
  EndProcedure
  
  
  class::Define(Counter,Test::Counter)
  
  c1.counter=class::new(counter)
  
  c1\Set(20)
  Debug ""+c1\Get()+" "+c1\OldGet()
  c1\mul(4)
  Debug ""+c1\Get()+" "+c1\OldGet()
  
  class::Free(c1)
  
  c2.test::CounterPlus = class::new(test::CounterPlus)
  c2\set(23)
  c2\Set(4)
  Debug c2\Get()
  class::free(c2)
  
  
  Interface CounterOld Extends Counter
  EndInterface
  Structure sCounterOld Extends sCounter
  EndStructure
  
  class::Define(CounterOld,Counter)
  
  
  Runtime Procedure CounterOld_Reset(*self.sCounterOld)
    *self\oldvalue=*self\value
    *self\value=0
  EndProcedure
  Runtime Procedure CounterOld_Add(*self.sCounterOld,value.i)
    *self\oldvalue=*self\value
    *self\value +value
  EndProcedure
  Runtime Procedure CounterOld_Set(*self.sCounterOld,value.i)
    *self\oldvalue=*self\value
    *self\value=value
  EndProcedure
  Runtime Procedure CounterOld__Constructor(*self.sCounterOld)
    Debug "New CounterOld:"+*self
    ProcedureReturn #True
  EndProcedure
  Runtime Procedure CounterOld__Destructor(*self.sCounterOld)
    Debug "Free CounterOld:"+*self
    ProcedureReturn #True
  EndProcedure
  Runtime Procedure CounterOld__CopyConstructor(*self.sCounterold)
    Debug "CopyFail Counterold:"+*self
    ProcedureReturn #False
  EndProcedure
  
  c3.CounterOld=CounterOld\new()
  Debug c3
  c3\Set(56)
  Debug ""+c3\Get()+" "+c3\OldGet()
  c3\add(56)
  Debug ""+c3\Get()+" "+c3\OldGet()
  c3\mul(56)
  Debug ""+c3\Get()+" "+c3\OldGet()
  c3\reset()
  Debug ""+c3\Get()+" "+c3\OldGet()
  
  Debug "Outputtest:"+class::Output(c3)
  
  Debug class::copy(c3)
  
  
  Debug "Accessabletest"
  Debug "counterold: "+CounterOld\IsClass(C3)+" "+CounterOld\IsAccessable(c3)
  Debug "counter: "+Counter\IsClass(C3)+" "+Counter\IsAccessable(c3)
  Debug "test::counter: "+test::Counter\IsClass(C3)+" "+test::Counter\IsAccessable(c3)
  Debug "test::counterplus: "+test::CounterPlus\IsClass(C3)+" "+test::CounterPlus\IsAccessable(c3)
  
  
  class::class\free(c3)
  
  Debug class::CountObjects
  
  
CompilerEndIf

Zuletzt geändert von GPI am 01.09.2017 11:32, insgesamt 1-mal geändert.
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Interface scannen mit JSON / wieder mal eine Class.pbi

Beitrag von GPI »

ein bischen geupdated. Es wird auch automatisch nach einer classenname::classenname gesucht, wenn kein Modul angegeben ist und es in aktuellen Modul nicht
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Interface scannen mit JSON / wieder mal eine Class.pbi

Beitrag von mk-soft »

Habe es mal mit JSON bei meinen Modul ausprobiert. Funktioniert sehr gut.
Es wird aber die relative grosse LIB von 102kb dazu gelinkt.

Werde es aber mit anbieten und beide Module pflegen...
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
Josh
Beiträge: 1028
Registriert: 04.08.2009 17:24

Re: Interface scannen mit JSON / wieder mal eine Class.pbi

Beitrag von Josh »

Hab mich noch nicht damit beschäftigt, aber bleibt da durch JSON und Runtime nicht sehr viel 'Text' in der Exe stehen?
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Interface scannen mit JSON / wieder mal eine Class.pbi

Beitrag von GPI »

In Zeiten von 4 GB RAM minimum absolut zu vernachlässigen.
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Benutzeravatar
Josh
Beiträge: 1028
Registriert: 04.08.2009 17:24

Re: Interface scannen mit JSON / wieder mal eine Class.pbi

Beitrag von Josh »

GPI hat geschrieben:In Zeiten von 4 GB RAM minimum absolut zu vernachlässigen.
Es geht mir nicht um die Größe, es geht um Rückschüsse die aus den Texten gefolgert werden können und evtl. Hackern Hinweise geben könnten.
NeoChris
Beiträge: 205
Registriert: 21.11.2013 21:17
Wohnort: Schweiz
Kontaktdaten:

Re: Interface scannen mit JSON / wieder mal eine Class.pbi

Beitrag von NeoChris »

GPI hat geschrieben:In Zeiten von 4 GB RAM minimum absolut zu vernachlässigen.
4 GB RAM?! Wir leben im Zeitalter der 16 GB RAM, also kann das Programm ruhig ein paar GB verbrauchen sonst wäre der freie RAM Speicher nur eine Verschwendung wenn er nicht genutzt wird...!
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Interface scannen mit JSON / wieder mal eine Class.pbi

Beitrag von GPI »

Josh hat geschrieben:Es geht mir nicht um die Größe, es geht um Rückschüsse die aus den Texten gefolgert werden können und evtl. Hackern Hinweise geben könnten.
Ich frag mich gerade, was du programmierst, dass sowas eine Relevanz bekommt.
Ja, rein theoretisch bekommen sie so die Namen der Methoden, aber was wollen sie da groß machen?

@NeoChris
Selbst bei 2GB-Maschinen wären das einfach vernachlässigbare Größen. Ein einfaches Bild dürfte da größer sein...
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
GPI
Beiträge: 1511
Registriert: 29.08.2004 13:18
Kontaktdaten:

Re: Interface scannen mit JSON / wieder mal eine Class.pbi

Beitrag von GPI »

Kleinere Verbesserungen. Es ist jetzt ein optionaler Parameter möglich. Wenn man mehrere Parameter benötigt, füllt einfach eine Structure und übergibt diese. Von Constructor gibts dementsprechend eine *EX()-Variante, der den Parameter bekommt. Der normale Contructor() bekommt dementsprechend den Parameter nicht und ignoriert ihn.

hier noch ein Beispiel für eine File-Klasse

Code: Alles auswählen

XIncludeFile "class.pbi"

DeclareModule File
  EnableExplicit
  Macro NewCreate(files,flags=#PB_UTF8)
    file::file\new( CreateFile(#PB_Any,files,flags) )
  EndMacro
  Macro NewRead  (files,flags=#PB_UTF8)
    file::file\new( ReadFile(#PB_Any,files,flags) )
  EndMacro
  Macro NewOpen  (files,flags=#PB_UTF8)
    file::file\new( OpenFile(#PB_Any,files,flags) )
  EndMacro
  Macro NewAppend(files,flags=#PB_UTF8)
    file::file\new( OpenFile(#PB_Any,files,flags|#PB_File_Append) )
  EndMacro
                                                                          
  Interface File Extends class::PBObject
    Eof()
    BufferSize(size.i)
    Seek(pos.q,flags=#PB_Absolute)
    Flush()
    Pos.q()
    Length.q()
    Truncate()
    
    ReadA.a()
    ReadB.b()
    ReadC.c()
    ReadD.d()
    ReadF.f()
    ReadI.i()
    ReadL.l()
    ReadQ.q()
    ReadS.s(format=0,length=-1)
    ReadU.u()
    ReadW.w()
    ReadStringFormat()
    ReadData(*buf,length.q)
    WriteA(Value.a)
    WriteB(Value.b)
    WriteC(Value.c)
    WriteD(Value.d)
    WriteF(Value.f)
    WriteI(Value.i)
    WriteL(Value.l)
    WriteQ(Value.q)
    WriteS(str.s,format=0)
    WriteSn(str.s,format=0)  
    WriteU(Value.u)
    WriteW(Value.w)
    WriteData(*buf,length.q)
    WriteStringFormat(format=0)
  EndInterface
  Structure sFile Extends class::sPBObject
  EndStructure
  class::Declare(file,class::PBObject)
EndDeclareModule
Module file  
  class::Define(File)
  Runtime Procedure File_DeFile(*self.sFile)
    ;Debug "Destructor"
    CloseFile(*self\handle)
  EndProcedure
  
  Runtime Procedure File_Eof(*self.sFile)
    ProcedureReturn Eof(*self\handle)
  EndProcedure
  Runtime Procedure File_BufferSize(*self.sFile,size.i)
    FileBuffersSize(*self\handle,size)
  EndProcedure
  Runtime Procedure File_GetID(*self.sFile)
    ProcedureReturn FileID(*self\handle)
  EndProcedure
  Runtime Procedure File_Seek(*self.sFile,pos.q,flags)
    FileSeek(*self\handle,pos,flags)
  EndProcedure
  Runtime Procedure File_Flush(*self.sFile)
    ProcedureReturn FlushFileBuffers(*self\handle)
  EndProcedure
  Runtime Procedure.q File_Pos(*self.sFile)
    ProcedureReturn Loc(*self\handle)
  EndProcedure
  Runtime Procedure.q File_Length(*self.sFile)
    ProcedureReturn Lof(*self\handle)
  EndProcedure
  Runtime Procedure File_Truncate(*self.sFile)
    ProcedureReturn TruncateFile(*self\handle)
  EndProcedure
    
  Runtime Procedure.a File_ReadA(*self.sfile)
    ProcedureReturn ReadAsciiCharacter(*self\handle)
  EndProcedure
  Runtime Procedure.b File_ReadB(*self.sfile)
    ProcedureReturn ReadByte(*self\handle)
  EndProcedure
  Runtime Procedure.c File_ReadC(*self.sfile)
    ProcedureReturn ReadCharacter(*self\handle)
  EndProcedure
  Runtime Procedure.d File_ReadD(*self.sfile)
    ProcedureReturn ReadDouble(*self\handle)
  EndProcedure
  Runtime Procedure.f File_ReadF(*self.sfile)
    ProcedureReturn ReadFloat(*self\handle)
  EndProcedure
  Runtime Procedure.i File_ReadI(*self.sfile)
    ProcedureReturn ReadInteger(*self\handle)
  EndProcedure
  Runtime Procedure.l File_ReadL(*self.sfile)
    ProcedureReturn ReadLong(*self\handle)
  EndProcedure
  Runtime Procedure.q File_ReadQ(*self.sfile)
    ProcedureReturn ReadQuad(*self\handle)
  EndProcedure
  Runtime Procedure.s File_ReadS(*self.sfile,flags,length)
    If flags=0 And length=-1
      ProcedureReturn ReadString(*self\handle)
    Else
      ProcedureReturn ReadString(*self\handle,flags,length)
    EndIf
  EndProcedure
  Runtime Procedure.u File_ReadU(*self.sfile)
    ProcedureReturn ReadUnicodeCharacter(*self\handle)
  EndProcedure
  Runtime Procedure.w File_ReadW(*self.sfile)
    ProcedureReturn ReadWord(*self\handle)
  EndProcedure
  Runtime Procedure File_ReadStringFormat(*self.sfile)
    ProcedureReturn ReadStringFormat(*self\handle)
  EndProcedure
  Runtime Procedure File_ReadData(*self.sFile,*buf,length.q)
    ProcedureReturn ReadData(*self\handle,*buf,length)
  EndProcedure
  
  Runtime Procedure File_WriteA(*self.sFile,Value.a)
    ProcedureReturn WriteAsciiCharacter(*self\handle,value)
  EndProcedure
  Runtime Procedure File_WriteB(*self.sFile,Value.b)
    ProcedureReturn WriteByte(*self\handle,value)
  EndProcedure
  Runtime Procedure File_WriteC(*self.sFile,Value.c)
    ProcedureReturn WriteCharacter(*self\handle,value)
  EndProcedure
  Runtime Procedure File_WriteD(*self.sFile,Value.d)
    ProcedureReturn WriteDouble(*self\handle,value)
  EndProcedure
  Runtime Procedure File_WriteF(*self.sFile,Value.f)
    ProcedureReturn WriteFloat(*self\handle,value)
  EndProcedure
  Runtime Procedure File_WriteI(*self.sFile,Value.i)
    ProcedureReturn WriteInteger(*self\handle,value)
  EndProcedure
  Runtime Procedure File_WriteL(*self.sFile,Value.l)
    ProcedureReturn WriteLong(*self\handle,value)
  EndProcedure
  Runtime Procedure File_WriteQ(*self.sFile,Value.q)
    ProcedureReturn WriteQuad(*self\handle,value)
  EndProcedure
  Runtime Procedure File_WriteS(*self.sFile,Value.s,format)
    If format=0
      ProcedureReturn WriteString(*self\handle,value)
    Else
      ProcedureReturn WriteString(*self\handle,value,format)
    EndIf
  EndProcedure
  Runtime Procedure File_WriteSn(*self.sFile,Value.s,format)
    If format=0
      ProcedureReturn WriteStringN(*self\handle,value)
    Else
      ProcedureReturn WriteStringN(*self\handle,value,format)
    EndIf  
  EndProcedure
  Runtime Procedure File_WriteU(*self.sFile,Value.u)
    ProcedureReturn WriteUnicodeCharacter(*self\handle,Value)
  EndProcedure
  Runtime Procedure File_WriteW(*self.sFile,Value.w)
    ProcedureReturn WriteWord(*self\handle,value)
  EndProcedure
  Runtime Procedure File_WriteStringFormat(*self.sFile,format)
    ProcedureReturn WriteStringFormat(*self\handle,format)
  EndProcedure
  Runtime Procedure File_WriteData(*self.sFile,*buf,length.q)
    ProcedureReturn WriteData(*self\handle,*buf,length)
  EndProcedure
  
  
  
EndModule


CompilerIf #PB_Compiler_IsMainFile
  
  Define out.file::file = file::NewCreate("delme.txt")
  If  out
    Debug "create"
    out\writesn("Erster Eintrag")
  EndIf
  out\Free()
  
  
  Define app.file::file = file::NewAppend("delme.txt")
  If app
    Debug "append"
    app\WriteSn("zweiter Eintrag")
  EndIf
  app\Free()
  
  Debug "test here"
  Define in.file::file = file::NewRead("delme.txt")
  If in
    Debug "read"
    While Not in\Eof()
      Debug in\ReadS()
    Wend
  EndIf
  
  Debug "copy:"+Class::copy(in)
  in\Free()
 
CompilerEndIf
CodeArchiv Rebirth: Deutsches Forum Github Hilfe ist immer gern gesehen!
Antworten