Random Access Dateien - Nostalgie läßt grüßen

H.Brill

Hallo,

Für die Nostalgiker unter euch, habe ich eine Art Random Access Datei aus Bereichen gemacht.

Etwa wie früher aus BASIC gewohnt. Statt FIELD .... geht es hier mit STRUCT.

Probiert mal aus, ob ihr noch einen Fehler findet. Ansonsten ist es mal ein Anfang.

Code

Declare Mem Personal, Handle btn1, btn2, btn3, btn4, grid, edit1, edit2, edit3, edit4
Declare Long satznr, ende
Declare String zeile
Struct Mitarbeiter = Name$(30), Vorname$(30), Gehalt&, Abteilung$(256)
Dim Personal, Mitarbeiter
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, 70, 25)
btn2 = Create("Button", %HWnd, "Lesen", 200, 80, 60, 25)
btn3 = Create("Button", %HWnd, "Ändern", 400, 80, 80, 25)
btn4 = Create("Button", %HWnd, "Ende", 500, 80, 60, 25)
grid = Create("GridBox", %HWnd, "Namen;0;180;Vornamen;0;100;Gehälter;0;80;Abteilung;0;240", 0, 10,120, 580, 200)
ende = 0
WhileNot ende
WaitInput
If Clicked(btn1)
' speichern
With Personal
.Name$ = GetText$(edit1)
.Vorname$ = GetText$(edit2)
.Gehalt& = Val(GetText$(edit3))
.Abteilung$ = GetText$(edit4)
EndWith
If GetText$(edit1) <> ""
RPut()
Else
MessageBox("Kein Name angegeben !", "Fehler", 0)
EndIf 
ElseIf Clicked(btn2)
' Lesen
RGet()
ElseIf Clicked(btn3)
' Ändern
satznr = GetCurSel(grid)
RChange(satznr)
RGet()
ElseIf Clicked(grid)
Zeile = GetString$(grid, GetCurSel(grid))
SetText edit1, SubStr$(Zeile, 1, "|")
SetText edit2, SubStr$(Zeile, 2, "|")
SetText edit3, SubStr$(Zeile, 3, "|")
SetText edit4, SubStr$(Zeile, 4, "|")
ElseIf Clicked(btn4)
ende = 1
EndIf
Case %Key = 2 : ende = 1
EndWhile
Dispose Personal
Proc RPut
Assign #1, $ProgDir + "Mitarbeiter.dat"
OpenRW #1
Seek #1, GetFileSize(#1)
BlockWrite #1, Personal
Close #1
SetText edit1, ""
SetText edit2, ""
SetText edit3, ""
SetText edit4, ""
EndProc

Proc RGet
Declare Long size, ofset, records
Assign #1, $ProgDir + "Mitarbeiter.dat"
OpenRW #1
size = GetFileSize(#1)
ofset = 0
records = size / 323 ' siehe Struct (hier müssen die Chr$(0) der Stringvariablen mitgezählt werden). Also 3 Bytes mehr.
ClearList grid
WhileLoop 1, records
Seek #1, ofset
BlockRead(#1, Personal, 0, SizeOf(Personal))
With Personal
Zeile = .Name$ + "|" + .Vorname$ + "|" + Str$(.Gehalt&) + "|" + .Abteilung$
AddString(grid, zeile)
EndWith
Inc ofset, 323
EndWhile
Close #1
EndProc
Proc RChange
Parameters Long dsatz
Declare Long ofset, records
With Personal
.Name$ = GetText$(edit1)
.Vorname$ = GetText$(edit2)
.Gehalt& = Val(GetText$(edit3))
.Abteilung$ = GetText$(edit4)
EndWith
Assign #1, $ProgDir + "Mitarbeiter.dat"
OpenRW #1
records = GetFileSize(#1) / 323
If dsatz = 0
ofset = 0
ElseIf (dsatz > 0) And (dsatz <= records)
ofset = dsatz * 323
EndIf 
Seek #1, ofset
BlockWrite #1, Personal
Close #1
EndProc
End

Alles anzeigen

H.Brill

Ich habe das Programm noch um eine Löschfunktion erweitert.

Wenn man im Grid einen Eintrag wählt, soll dieser gelöscht werden.

Die Datensätze stehen in einem Array mit Structur. Gelöscht wird mit

ArrDel ..... Die Datei wird Erase #1 gelöscht und dann neu eingelesen.

Der Eintrag scheint auch im Array gelöscht zu werden, aber beim Neueinlesen

stimmt was nicht.

Kann jemand meinen Denkfehler (Knoten) lösen ?

Code

Declare Mem Personal, Handle btn1, btn2, btn3, btn4, btn5, grid, edit1, edit2, edit3, edit4
Declare Long satznr, ende, knopf
Declare String zeile
Struct Mitarbeiter = Name$(30), Vorname$(30), Gehalt&, Abteilung$(256)
Dim Personal, Mitarbeiter
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, "Namen;0;180;Vornamen;0;100;Gehälter;0;80;Abteilung;0;240", 0, 10,120, 580, 200)
ende = 0
WhileNot ende
 WaitInput
 If Clicked(btn1)
    ' speichern
 With Personal
   .Name$ = GetText$(edit1)
   .Vorname$ = GetText$(edit2)
   .Gehalt& = Val(GetText$(edit3))
   .Abteilung$ = GetText$(edit4)
 EndWith
 If GetText$(edit1) <> ""
    RPut()
 Else
    MessageBox("Kein Name angegeben !", "Fehler", 0)
 EndIf
 ElseIf Clicked(btn2)
    ' Lesen
    RGet()
 ElseIf Clicked(btn3)
    ' Ändern
    satznr = GetCurSel(grid)
    RChange(satznr)
    RGet()
 ElseIf Clicked(btn4)
    ' Delete record
    satznr = GetCurSel(grid)
    knopf = MessageBox("Sind Sie wirklich sicher ?", "Datensatz löschen", 292)
    Case knopf = 6 : RDelete(satznr)
 ElseIf Clicked(btn5)
    ende = 1
 ElseIf Clicked(grid)
    Zeile = GetString$(grid, GetCurSel(grid))
    SetText edit1, SubStr$(Zeile, 1, "|")
    SetText edit2, SubStr$(Zeile, 2, "|")
    SetText edit3, SubStr$(Zeile, 3, "|")
    SetText edit4, SubStr$(Zeile, 4, "|")
 EndIf
 Case %Key = 2 : ende = 1
EndWhile
Dispose Personal
Proc RPut
Assign #1, $ProgDir + "Mitarbeiter.dat"
OpenRW #1
Seek #1, GetFileSize(#1)
BlockWrite #1, Personal
Close #1
SetText edit1, ""
SetText edit2, ""
SetText edit3, ""
SetText edit4, ""
EndProc

Proc RGet
Declare Long size, ofset, records
Assign #1, $ProgDir + "Mitarbeiter.dat"
OpenRW #1
size = GetFileSize(#1)
ofset = 0
records = size / 323 ' siehe Struct (hier müssen die Chr$(0) der Stringvariablen mitgezählt werden). Also 3 Bytes mehr.
ClearList grid
WhileLoop 1, records
  'Seek #1, ofset
  BlockRead(#1, Personal, 0, SizeOf(Personal))
  With Personal
     Zeile = .Name$ + "|" + .Vorname$ + "|" + Str$(.Gehalt&) + "|" + .Abteilung$
     AddString(grid, zeile)
  EndWith
  Inc ofset, 323
EndWhile
Close #1
EndProc
Proc RChange
Parameters Long dsatz
Declare Long ofset, records
With Personal
 .Name$ = GetText$(edit1)
 .Vorname$ = GetText$(edit2)
 .Gehalt& = Val(GetText$(edit3))
 .Abteilung$ = GetText$(edit4)
EndWith
Assign #1, $ProgDir + "Mitarbeiter.dat"
OpenRW #1
records = GetFileSize(#1) / 323
If dsatz = 0
 ofset = 0
ElseIf (dsatz > 0) And (dsatz <= records)
 ofset = dsatz * 323
EndIf
Seek #1, ofset
BlockWrite #1, Personal
Close #1
EndProc
Proc RDelete
Parameters Long dsatz
Declare Memory RecListe[], records
Dim RecListe[], Mitarbeiter
Assign #1, $ProgDir + "Mitarbeiter.dat"
OpenRW #1
records = GetFileSize(#1) / 323
SetSize RecListe[], records 
WhileLoop 0, records - 1
  BlockRead(#1, RecListe[&LOOP], 0,  SizeOf(RecListe[&LOOP]))
EndWhile
ArrDel RecListe[], dsatz, 1
Erase #1
Close #1
Assign #1, $ProgDir + "Mitarbeiter.dat"
OpenRW #1
WhileLoop 0, SizeOf(RecListe[]) - 1
   BlockWrite #1, RecListe[&LOOP]
EndWhile
Close #1
RGet()
Dispose RecListe[]
EndProc
End

Alles anzeigen

H.Brill

Ich habe das Problem mal nachvollziehbar gemacht.

Offensichtlich löscht Erase #|datei nicht richtig. Der letzte Eintrag der Datei

kommt dann immer zweimal. Auch ein Rewrite hilft da nicht.

Code

Declare Long datei, Memory Waren[]
Set("Decimals", 2)
Struct Artikel = Name$(30), Preis!
Dim Waren[], Artikel
SetSize Waren[], 3
datei = Assign($ProgDir + "Waren.dat")
OpenRW datei
With Waren[0]
  Waren[0].Name$ = "Milch"
  Waren[0].Preis! = 0.99
EndWith
With Waren[1]
  Waren[1].Name$ = "Butter"
  Waren[1].Preis! = 2.25
EndWith
With Waren[2]
  Waren[2].Name$ = "Käse"
  Waren[2].Preis! = 3.55
EndWith
Print "\nAus dem Array gelesen :"
WhileLoop 0, SizeOf(Waren[]) - 1
 With Waren[&LOOP]
    Print "Artikel : ", Waren[&LOOP].Name$, "Preis :", Waren[&LOOP].Preis!
 EndWith
EndWhile
Speichern()
Print "\nTaste für Dateiausgabe..."
WaitKey
Ausgabe()
Print "\nDelete Satz Nr. 2 in Datei"
WaitKey
Arrdel Waren[], 1, 1
Speichern()
Ausgabe()
WaitKey
Proc Speichern
Assign datei, ""
datei = Assign($ProgDir + "Waren.dat")
Erase datei
OpenRW datei
Seek datei, 0
WhileLoop 0, SizeOf(Waren[]) - 1
 BlockWrite datei, Waren[&LOOP]
EndWhile
Close datei
EndProc
Proc Ausgabe
Declare Long Records
Assign datei, ""
datei = Assign($ProgDir + "Waren.dat")
OpenRW datei
Records = GetFileSize(datei) / 34
Clear Waren[]
SetSize Waren[], Records
Seek datei, 0
WhileLoop 0, Records - 1
 BlockRead(datei, Waren[&LOOP], 0, SizeOf(Waren[&LOOP]))
 With Waren[&LOOP]
     Print "Artikel :", .Name$, "Preis : ", .Preis!
 EndWith
EndWhile
Close datei
EndProc
End

Alles anzeigen

Wenn man mit einem Texteditor die Datei anschaut, ist der Datensatz mit "Käse"

auch zweimal vorhanden, aber wieso ? Der ist doch nur einmal geschrieben worden.

Auch ein Assign datei, "", das das Dateihandle löscht, brachte nichts.

Mache ich da jetzt was falsch oder ist meine Vermutung richtig ?

SvenB

Mit den Datei-Funktionen habe ich letztens auch gekämpft. Bei mir war es das Problem, dass bei Rewrite durch weniger Daten als zuvor eben nicht (wie gewünscht und erwartet) der bisherige Dateiinhalt verloren ging sondern der Überhang übrig blieb, weshalb ich dann auch so Erase gewechselt bin.

In deinem Fall scheint es Folgendes zu sein:
Erase möchte nicht mit jedem Dateimodus (OpenRW?) zusammenarbeiten. Folgendes hilft:
Schließe die Datei, wenn du mit Lesen oder schreiben fertig bist und lösche sie dann erst mit einem eigenen Assign:

Code

 Assign #1, $ProgDir + "Mitarbeiter.dat"
 Erase #1
 Close #1

Da ich bei mir irgendwie den Debugger nie zum Laufen bringe, arbeite ich normalerweise mit einer eigenen Konsolenausgabe oder in einfachen Fällen auch mal mit messageboxes als Breakpoints, so konnte man relativ schnell feststellen, dass die Datei zu keinem Zeitpunkt gelöscht wurde.

H.Brill

Das scheint auch nicht zu funktionieren. Hatte auch schon mit Set("FileMode", N)

rum gespielt. Früher gab es mal in Turbo Pascal den Befehl TRUNCATE, der eine

angebene Anzahl Bytes hinten an der Datei abschnitt. Wenn man vorher durch geschicktes

Umsortieren den zu löschenden Datensatz ans Ende schob, wurde der dann gelöscht.

Wenn man denn auch ein richtiges FileHandle hätte, könnte man mit der Kernel32.dll

und der File-Api das End Of File neu setzen. Geht aber wegen des echten fehlenden Handle

nicht. Es gibt ja nur Kanal-Nummern von 1-99. Auch die Funktion Assign() gibt nur eine

solche zurück. Und alle Dateioperationen mit API machen, möchte ich auch nun wieder nicht.

Ich vermute mal, daß RGH einen profaninternen Speicher nicht freigibt, bzw. beim

wiederholten Schreiben nicht dementsprechend neu dimensioniert. Somit bleiben auch

Reste, wenn der neu zu schreibende Bereich, den wir dann neu dimensionieren, halt

kleiner, als der alte profaninterne ist. Ob RGH vergessen hat, dies zu berücksichtigen,

oder ob es gar nicht vorgesehen war, bleibt halt offen. Wir haben ja mehrer Bereiche,

wie RegEx, Json, openGL usw., die nur rudimentär implementiert sind.

SvenB

Hm... bei mir wurde die Datei vorher nicht gelöscht und nach dem Fix wurde sie gelöscht. Dann musst du etwas granularer debuggen. Das Löschen des Array Eintrages hatte ich zumindest validieren können, das hatte geklappt.

Random Access Dateien - Nostalgie läßt grüßen

Jetzt mitmachen!

Benutzer online in diesem Thema