XProfan

WindowTitle "TEIL I: LONG-ARRAY IN EINE BINÄRDATEI SCHREIBEN"
' (D) Demoware "ARRAYS BINÄR SPEICHERN" by P. Specht, Wien, basierend auf dem
' Trick "BEREICHSDIMENSIONIERUNG VOR STARTPOINTERUMLEITUNG" (C)2013-01 by JONATHAN
' siehe dazu: ./../../sys/?nohdr=1&u=www.paules-pc-forum.de/forum/951187-post4.html
Font 2:Randomize:Cls rnd(8^8)
' Testgröße festlegen
var n&=21
Declare Overlay#, Overlay_oldAdress&, A&[n&]
' Mit Testwerten belegen:
A&[] = n& - &Index
'======== JONATHAN's TRICK, Teil 1 v.2 =======
' Quelle: ./../../sys/?nohdr=1&u=www.paules-pc-forum.de/forum/951187-post4.html
' Bereich in Länge Testarray separat anlegen,
Dim Overlay#,@SizeOf(A&[])*4
' Beginn merken,
Overlay_oldAdress& = Overlay#
' dann Startadresse auf Testarray biegen:
Overlay# = @Addr(A&[0])
'=============================================
' Elementzahl und Bereichsgröße Mostra:
Print @SizeOf(Overlay#)
Print @SizeOf(A&[])
' Testhalber im Array einen Wert ändern:
A&[0]=1234567
' Zeigen, daß dadurch der Bereich geändert wurde:

WhileLoop 0,(@SizeOf(Overlay#)/4)-1

    Print @Long(Overlay#,&loop*4),
    EndWhile :print
    ' Testhalber ein Long in der Bereich schreiben:
    Long Overlay#,(2 +1)*Sizeof(A&[0]) = 4444444
    ' Zeigen, daß dadurch das Array geändert wurde:

    WhileLoop 0,@SizeOf(A&[])-1

        Print A&[&Loop],
        EndWhile :print
        ' Mostra der Bereichsgröße, die auf Platte geschrieben wird
        print SizeOf(Overlay#)
        ' Bereich auf Platte schreiben:
        BlockWrite getenv$("USERPROFILE")+"\\desktop\\A&.ary",OverlaY#,0,SizeOf(Overlay#)
        '======== JONATHAN's TRICK, Teil 2 v.2 =======
        ' Bereich auf alte Startadresse setzen ...
        Overlay# = Overlay_oldAdress&
        ' und den dort reservierten Speicherbereich freigeben
        Dispose Overlay#
        '=============================================
        ' Das erste Array löschen
        Clear a&[]
        print "OK"
        WaitInput
        '=============================================
        '                  TEIL II
        '=============================================
        WindowTitle "TEIL II: EINLESEN DES SO GESPEICHERTEN LONG-ARRAYS VON PLATTE"
        ' (D) Demoware 2013-01 "ARRAYS BINÄR EINLESEN" by P. Specht, Wien, basierend auf dem
        ' Trick "BEREICHSDIMENSIONIERUNG VOR STARTPOINTERUMLEITUNG" (C)2013-01 by JONATHAN
        Print
        Print " Einlesen in neues Array b&[] "
        Declare File$,LastAddress&,fs&
        File$=getenv$("USERPROFILE")+"\\desktop\\"+"A&.ary"
        fs&=FileSize(File$)
        Print " Dateiname: ";Datei$
        Print " Filesize = ";fs&
        Declare Bereich#, B&[fs&\4-1]
        '======== JONATHAN's TRICK, Teil 1 v.2 =======
        Dim Bereich#,fs&
        LastAddress&=Bereich#
        ' BEGINN DES AUSREICHEND DIMENSIONIERTEN ARRAYS AUF DAS NEUE ARRAY SETZEN
        Bereich#=addr(b&[0])
        '=============================================
        ' EINLESEN
        @BlockRead(File$,Bereich#,0,fs&)
        ' ANZEIGEN
        print fs&
        print @SizeOf(B&[])

        WhileLoop 0,@SizeOf(B&[])-1

            Print B&[&Loop],

        EndWhile

        print
        print
        Print "    ^^^ BITTE VERGLEICHEN MIT ORGINAL ^^^   "
        waitinput
        Print
        Print " Bereich wird nun manipuliert, um Array zu verändern"
        Print " und damit die Überlagerung zu beweisen:        "
        Long Bereich#,0*SizeOf(b&[0]) = n&
        Long Bereich#,3*SizeOf(b&[0]) = n&-3
        print

        WhileLoop 0,@SizeOf(B&[])-1

            Print B&[&Loop],
            EndWhile :print
            '======== JONATHAN's TRICK, Teil 2 v.2 =======
            ' Überlagerung aufheben:
            Bereich#=LastAddress&
            dispose Bereich#
            '=============================================
            clear B&[]
            Print
            Print " Danke! "
            print
            print " Testdatei löschen? J/N ";
            var jn$=""
            input jn$

            if left$(upper$(jn$),1)="J"

                Assign #4,File$
                ERASE #4
                beep
                print
                print " "+File$+" gelöscht."

            endif

            Print
            print " Man sieht sich! "
            WaitInput 10000
            END