XProfan

Italia

H.Brill

Random Access DLL (Freeware) von MRK-Soft.
Die Bearbeitung bzw. Auslesen von Random
Access File wurde schon öfter im Foro
nachgefragt.

prf_rac.zip	13 kB

Hochgeladen:	21.03.2009

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.

21.03.2009 ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione

H.Brill

Anbei meine (X)Profan - Variante.
Die Datensätze werden immer ans Ende angehängt. Dafür kann man
aber auch Datensätze genau auf der Stelle ändern. Und was früher
bei GW-Di base & Co. nicht ging (Das physikalische Löschen) geht
durch Umkopieren auch.

Viel Divertimento damit !

Kompilieren Markieren Separieren

Declare Mem Personal, Handle btn1, btn2, btn3, btn4, btn5, grid, edit1, edit2, edit3, edit4
Declare Long satznr, anz, ende, knopf, pos
Declare String zeile, datei
Struct Mitarbeiter = Name$(30), Vorname$(30), Gehalt&, Abteilung$(256)
Dim Personal, Mitarbeiter
datei = $ProgDir + "Mitarbeiter.dat"
WindowTitle "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)
ende = 0
Assign #1, datei

WhileNot ende

    WaitInput

    If Clicked(btn1)

        ' speichern
        Clear Personal

        With Personal

            .Name$ = GetText$(edit1)
            .Vorname$ = GetText$(edit2)
            .Gehalt& = Val(GetText$(edit3))
            .Abteilung$ = GetText$(edit4)

        EndWith

        If GetText$(edit1) <> ""

            pos = GetCount(grid) + 1
            zeile = Str$(pos) + "|" + GetText$(edit1) + "|" + GetText$(edit2) + "|" + GetText$(edit3) + "|" + GetText$(edit4)
            AddString(grid, zeile)
            SetCurSel grid, GetCount(grid) - 1
            PutRecord(1, Personal)
            SetText edit1, ""
            SetText edit2, ""
            SetText edit3, ""
            SetText edit4, ""

        Else

            MessageBox("Kein Name angegeben !", "Fehler", 0)

        EndIf

    ElseIf Clicked(btn2)

        ' Lesen

        If FileExists(datei)

            anz = FileSize(datei) / SizeOf(Personal)
            ClearList grid

            WhileLoop 0, anz - 1

                GetRecord(1, &LOOP, Personal)

                With Personal

                    zeile = Str$(&LOOP + 1) + "|" + .Name$ + "|" + .Vorname$ + "|" + Str$(.Gehalt&) + "|" + .Abteilung$

                EndWith

                AddString(grid, zeile)
                Clear Personal

            EndWhile

        Else

            MessageBox("Noch keine File angelegt !", "Info", 0)

        EndIf

    ElseIf Clicked(btn3)

        ' Ändern
        Clear Personal

        With Personal

            .Name$ = GetText$(edit1)
            .Vorname$ = GetText$(edit2)
            .Gehalt& = Val(GetText$(edit3))
            .Abteilung$ = GetText$(edit4)

        EndWith

        satznr = GetCurSel(grid)
        ChangeRecord(1, satznr, Personal)
        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)
        knopf = MessageBox("Sind Sie wirklich sicher ?", "Datensatz löschen", 292)

        If knopf = 6

            DeleteString(grid, satznr)
            DeleteRecord(1, satznr + 1, Personal)' wg. 0 - Position

        EndIf

    ElseIf Clicked(btn5)

        ende = 1

    ElseIf Clicked(grid)

        pos = GetCurSel(grid)

        If pos > -1

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

        EndIf

    EndIf

    Case %Key = 2 : ende = 1

EndWhile

Dispose Personal

Proc PutRecord

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

EndProc

Proc GetRecord

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

EndProc

Proc ChangeRecord

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

    If satznr = 0

        offset = 0

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

        offset = satznr * SizeOf(bereich)

    EndIf

    Seek #kanal, offset
    BlockWrite #kanal, bereich
    Close #kanal

EndProc

Proc DeleteRecord

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

    WhileLoop 1, records

        IfNot &LOOP = satznr

            Seek #kanal, offset
            BlockRead(#kanal, bereich, 0, SizeOf(bereich))
            Seek #2, GetFileSize(#2)
            BlockWrite #2, bereich, 0, SizeOf(bereich)
            Clear Bereich

        EndIf

        Inc offset, SizeOf(bereich)

    EndWhile

    Close #kanal
    Erase #kanal
    OpenRW #kanal
    offset = 0
    records = GetFileSize(#2) / SizeOf(bereich)

    WhileLoop 1, records

        Seek #2, offset
        BlockRead(#2, bereich, 0, SizeOf(bereich))
        Seek #kanal, GetFileSize(#kanal)
        BlockWrite #kanal, bereich, 0, SizeOf(bereich)
        Inc offset, SizeOf(bereich)

    EndWhile

    Close #kanal
    Close #2
    Erase #2
    Assign #2, ""

EndProc

End

Vielleicht hat ja noch jemand 'alte Schätzchen' aus der DOS-Zeit und möchte
sie ins Windowszeitalter retten. Ich denke mal, daß das damit auch geht, zumal
die Zahlen und Buchstaben beim OEM-Zeichensatz an der gleichen Stelle stehen. Wenn nicht, müßte man mal mit OemToAnsi$() oder der Bereichsfunktion Char$() probieren. Es geht ja praktisch nur darum, daß bei DOS noch keine abschließende Nullbytes an den Strings waren.

Natürlich ist es gut, auch den GW-Di base quelltext dabei zu haben, um den
FIELD - Befehl mit seiner Struktur zu sehen. Das gleiche macht man hier
mit Struct und anschließendem Dimmen eines Bereichs. Ein Assign noch
dazu und die Vorbereitungen sind fertig.

vor 16 Tagen ▲

Vollständiges Zitat

Absatzweise Citazione Zeilenweise Citazione