XProfan

English

H.Brill

Random Access DLL (Freeware) of MRK-Soft.
The edit or. Reading of Random
Access Files watts already often in the Forum
nachgefragt.

prf_rac.zip	13 kB

Hochgeladen:	03/21/09

Downloadcounter:
		Download

Benutze XPROFAN X3 + FREEPROFAN
Wir sind die XProfaner.
Sie werden von uns assimiliert.
Widerstand ist zwecklos!
Wir werden alle ihre Funktionen und Algorithmen den unseren hinzufügen.

Was die Borg können, können wir schon lange.

03/21/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

H.Brill

enclosed my (X)Profan - Variante.
The Datensätze go always ans end appended. For this can
but too Datensätze very on the place Change. and what former
with GW-BASIC & Co. not went (the physikalische Delete) goes
through Umkopieren too.

plenty Fun so !

Compile Mark Separation

Declare Mem personnel, lever btn1, btn2, btn3, btn4, btn5, grid, edit1, edit2, edit3, edit4
Declare Long satznr, anz, end, button, pos
Declare String row, File
Struct colleagues = name$(30), First name$(30), Gehalt&, section$(256)
Dim personnel, colleagues
File = $PROGDIR + "Mitarbeiter.dat"
Window Title "Personal"
Window 620, 400
Create("Text", %HWnd, "Name   : ", 10, 10, 80, 25)
edit1 = Create("Edit", %HWnd, "", 100, 10, 120, 25)
Create("Text", %HWnd, "Vorname", 230, 10, 80, 25)
edit2 = Create("Edit", %HWnd, "", 310, 10, 80, 25)
Create("Text", %HWnd, "Gehalt : ", 10, 40, 80, 25)
edit3 = Create("Edit", %HWnd, "", 100, 40, 80, 25)
Create("Text", %HWnd, "Abteilung : ", 230, 40, 80, 25)
edit4 = Create("Edit", %HWnd,  "", 310, 40, 250, 25)
btn1 = Create("Button", %HWnd, "Speichern", 10, 80, 80, 25)
btn2 = Create("Button", %HWnd, "Lesen", 100, 80, 80, 25)
btn3 = Create("Button", %HWnd, "Ändern", 200, 80, 80, 25)
btn4 = Create("Button", %HWnd, "Löschen", 300, 80, 80, 25)
btn5 = Create("Button", %HWnd, "Ende", 500, 80, 60, 25)
grid = Create("GridBox", %HWnd, "Nr;0;40;Namen;0;180;Vornamen;0;100;Gehälter;0;80;Abteilung;0;240", 0, 10,120, 580, 200)
end = 0
Assign #1, File

WhileNot end

    WaitInput

    If Clicked(btn1)

        ' Save
        Clear personnel

        With personnel

            .name$ = GetText$(edit1)
            .First name$ = GetText$(edit2)
            .Gehalt& = Val(GetText$(edit3))
            .section$ = GetText$(edit4)

        EndWith

        If GetText$(edit1) <> ""

            pos = GetCount(grid) + 1
            row = Str $(pos) + "|" + GetText$(edit1) + "|" + GetText$(edit2) + "|" + GetText$(edit3) + "|" + GetText$(edit4)
            AddStrings(grid, row)
            SetCurSel grid, GetCount(grid) - 1
            PutRecord(1, personnel)
            SetText edit1, ""
            SetText edit2, ""
            SetText edit3, ""
            SetText edit4, ""

        Else

            MessageBox("No name indicated !", "Fehler", 0)

        EndIf

    ElseIf Clicked(btn2)

        ' reading

        If FileExists(File)

            anz = FileSize(File) / SizeOf(personnel)
            ClearList grid

            WhileLoop 0, anz - 1

                GetRecord(1, &LOOP, personnel)

                With personnel

                    row = Str $(&LOOP + 1) + "|" + .name$ + "|" + .First name$ + "|" + Str $(.Gehalt&) + "|" + .section$

                EndWith

                AddStrings(grid, row)
                Clear personnel

            EndWhile

        Else

            MessageBox("Noch no File laid out !", "Info", 0)

        EndIf

    ElseIf Clicked(btn3)

        ' Change
        Clear personnel

        With personnel

            .name$ = GetText$(edit1)
            .First name$ = GetText$(edit2)
            .Gehalt& = Val(GetText$(edit3))
            .section$ = GetText$(edit4)

        EndWith

        satznr = GetCurSel(grid)
        ChangeRecord(1, satznr, personnel)
        satznr = GetCurSel(grid)
        SetText grid, satznr, 1, GetText$(edit1)
        SetText grid, satznr, 2, GetText$(edit2)
        SetText grid, satznr, 3, GetText$(edit3)
        SetText grid, satznr, 4,GetText$(edit4)

    ElseIf Clicked(btn4)

        ' Delete record
        satznr = GetCurSel(grid)
        button = MessageBox("Sind tappt im dunkeln really sure ?", "Datensatz löschen", 292)

        If button = 6

            DeleteString(grid, satznr)
            DeleteRecord(1, satznr + 1, personnel)' wg. 0 - position

        EndIf

    ElseIf Clicked(btn5)

        end = 1

    ElseIf Clicked(grid)

        pos = GetCurSel(grid)

        If pos > -1

            row = GetString$(grid, GetCurSel(grid))
            SetText edit1, SubStr$(row, 2, "|")
            SetText edit2, SubStr$(row, 3, "|")
            SetText edit3, SubStr$(row, 4, "|")
            SetText edit4, SubStr$(row, 5, "|")

        EndIf

    EndIf

    Case %Key = 2 : end = 1

EndWhile

Dispose personnel

Proc PutRecord

    Parameters Long channel, Memory area
    Declare Long pos
    OpenRW #channel
    Seek #channel, GetFileSize(#channel)
    BlockWrite #channel, area, 0, SizeOf(area)
    Close #channel

ENDPROC

Proc GetRecord

    Parameters Long channel, satznr, Memory area
    Declare Long size, offset, records
    OpenRW #channel
    offset = satznr * SizeOf(area)
    Seek #channel, offset
    BlockRead(#channel, area, 0, SizeOf(area))
    Close #channel

ENDPROC

Proc ChangeRecord

    Parameters Long channel, satznr, Memory area
    Declare Long offset, records
    OpenRW #channel
    records = GetFileSize(#channel) / SizeOf(area)

    If satznr = 0

        offset = 0

    ElseIf (satznr > 0) And (satznr <= records)

        offset = satznr * SizeOf(area)

    EndIf

    Seek #channel, offset
    BlockWrite #channel, area
    Close #channel

ENDPROC

Proc DeleteRecord

    Parameters Long channel, satznr, Memory area
    Declare Long offset, records
    Assign #2, $PROGDIR + "Datei2.dat"
    OpenRW #channel
    OpenRW #2
    offset = 0
    records = GetFileSize(#channel) / SizeOf(area)
    Clear area

    WhileLoop 1, records

        Ifnot &LOOP = satznr

            Seek #channel, offset
            BlockRead(#channel, area, 0, SizeOf(area))
            Seek #2, GetFileSize(#2)
            BlockWrite #2, area, 0, SizeOf(area)
            Clear area

        EndIf

        Inc offset, SizeOf(area)

    EndWhile

    Close #channel
    Erase #channel
    OpenRW #channel
    offset = 0
    records = GetFileSize(#2) / SizeOf(area)

    WhileLoop 1, records

        Seek #2, offset
        BlockRead(#2, area, 0, SizeOf(area))
        Seek #channel, GetFileSize(#channel)
        BlockWrite #channel, area, 0, SizeOf(area)
        Inc offset, SizeOf(area)

    EndWhile

    Close #channel
    Close #2
    Erase #2
    Assign #2, ""

ENDPROC

End

Perhaps has Yes yet someone 'alte Schätzchen' from the DOS-Time and would like
tappt im dunkeln in that Windowszeitalter saving. i think time, that the so too goes, especially since
the numbers and letters at OEM-Zeichensatz on the equal place stand. unless, should one time with OemToAnsi$() or the Bereichsfunktion Char$() try. It's all right Yes useful only therefore, that with DOS yet no abschließende Nullbytes on whom Strings were.

naturally is it well, too whom GW-BASIC quelltext thereby to have, around the
FIELD - commands with his structure To see. the same power one here
with Struct and anschließendem Dimmen one Bereichs. One Assign yet
moreover and the Vorbereitungen are ready.

vor 4 Tagen ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote