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

Werbepost

Hallo!

Wenn du gerade an deiner Website arbeitest oder dein aktuelles Hosting überdenkst: Wir betreiben mit NetzLiving eine Hosting-Plattform, die speziell auf Performance, Sicherheit und einfache Verwaltung ausgelegt ist.

✔️ Schnelle Ladezeiten (optimiert für WordPress, WoltLab & Co.)
✔️ Deutsche Server & DSGVO-konform
✔️ Persönlicher Support (kein 0815-Ticket-System)

Mehr erfahren

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.

H.Brill

Hallo,

Endlich klappt auch das Löschen von Datensätzen in der Datei. Statt mit einem Array zu hantieren, wird nun einfach der Inhalt der Gridbox nach einem DeleteString(handle, nr) in die Datei neu geschrieben. Ich öffne nun auch nur einmal die Datei, lösche sie mit Erase #1 und öffne sie wieder mit OpenRW #1. Dann schreibe ich sie normal mit BlockWrite. Siehe Proc RDelete().

Woran das nun genau lag, kann ich nicht sagen. Jedenfalls funktioniert es so.

Code

Declare Mem Personal, Handle btn1, btn2, btn3, btn4, btn5, grid, edit1, edit2, edit3, edit4
Declare Long satznr, ende, knopf, pos
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, "Nr;0;40;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) <> ""
   pos = GetCount(grid) + 1
   zeile = Str$(pos) + "|" + GetText$(edit1) + "|" + GetText$(edit2) + "|" + GetText$(edit3) + "|" + GetText$(edit4)
   AddString(grid, zeile) 
   SetCurSel grid, GetCount(grid) - 1
   RPut()
Else
   MessageBox("Kein Name angegeben !", "Fehler", 0)
EndIf
ElseIf Clicked(btn2)
   ' Lesen
   If FileExists($ProgDir + "Mitarbeiter.dat")
      RGet()
   Else
      MessageBox("Noch keine Datei angelegt !", "Info", 0)
   EndIf   
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)
   If knopf = 6 
     DeleteString(grid, satznr)
     RDelete(satznr)
   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 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
 BlockRead(#1, Personal, 0, SizeOf(Personal))
 With Personal
    Zeile = Str$(&LOOP) + "|" + .Name$ + "|" + .Vorname$ + "|" + Str$(.Gehalt&) + "|" + .Abteilung$
    AddString(grid, zeile)
    Clear Personal
 EndWith
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
Assign #1, $ProgDir + "Mitarbeiter.dat"
Erase #1
OpenRW #1
WhileLoop 0, GetCount(grid) - 1
    zeile = GetString$(grid, &LOOP)
    With Personal
      .Name$ = SubStr$(zeile, 2, "|")
      .Vorname$ = SubStr$(zeile, 3, "|")
      .Gehalt& = SubStr$(zeile, 4, "|")
      .Abteilung$ = SubStr$(zeile, 5, "|")
EndWith
BlockWrite #1, Personal
EndWhile
Close #1
ClearList Grid
RGet()
EndProc
End

Alles anzeigen

H.Brill

Hier ist nochmals eine Verbesserung. Das Löschen einen Datensatzes in der Datei habe ich dadurch erreicht, daß ich alle Datensätze, außer dem zu löschenden, einzeln lese und in eine neue Datei gleichzeitig reinschreibe. Danach wird die original Datei mit Erase gelöscht und wieder geöffnet und die neue Datei gelesen und gleichzeitig wieder in die Ursprungsdatei geschrieben. Am Ende wird dann noch die temporale Datei gelöscht und das Handle mit Assig #2, "" wieder frei gegeben.

Ich habe die Proc allgemein gehalten, sodaß man im Hauptprogramm nur die Struktur erstellen und mit einem Bereich dimmen muß Ähnlich halt, wie bei GW-BASIC / Quickbasic der Field - Befehl. Anschließend muß man noch ein Assign auf die Datei machen.

Viel Spaß damit

Code

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 Datei 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) ' nr. ist nullbasiert
   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

Alles anzeigen

PS:

Was mich noch interessieren würde, ob das auch mit einer originalen GW-BASIC - Datei funktioniert. Also eine, die noch mit MS-DOS erstellt wurde. Es soll ja noch Leute geben, die ihre alten Schätze gerne in die Windowswelt retten wollen. Also, wer sowas noch hat, kann sie mir gerne mal zur Verfügung stellen. Ich will jetzt nicht unbedingt noch eine DOS-Box installieren und ein Laufwerk mounten. Kann dann sein, daß man dann noch mit OemToAnsi$(), AnsiToOem$() arbeiten muß, da damals ja noch keine abschließende Nullbytes hinter den Strings waren. Da die Zeichen und Zahlen ja an den gleichen Stellen im Zeichensatz stehen, würde evtl auch ein Char$(bereich, 0, anzahl) funktionieren. Das müßte man dann sehen.

H.Brill

Was nun ältere Dateien aus der DOS-Zeit betrifft, könnte es Probleme geben, da DOS bzw. GW-BASIC ja keine Strings mit Nullbytes kennt und da evtl. über die Offsets hinaus gelesen bzw. geschrieben wird.

Da (X)Profan mit Bereichen in Bereichen genauso gut umgehen kann, ist es besser, den Speicherbereich-Typ # statt $ zu verwenden. Ich denke, genau so verhälts es sich auch mit den Zahlen in einem DOS - 16Bit Systen (damals das neueste) . Da sollte man das & auch gegen das % vertauschen. Die Umstellung ist ja schnell gemacht :

Code

Struct Mitarbeiter = Name#(30), Vorname#(30), Gehalt%, Abteilung#(256)
With Personal
  .Name# = GetText$(edit1)
  .Vorname# = GetText$(edit2)
  .Gehalt% = Val(GetText$(edit3))
  .Abteilung# = GetText$(edit4)
EndWith

Damit würden dann die Member der Struktur immer an der richtigen Stelle stehen. Ich wollte ja zuerst die DOS-Box installieren, bin aber davon abgekommen. Die DOS-Box ist ja wohl auch mit 32Bit geschrieben worden und wird Strings mit Nullbytes verwenden. Ob das nun mit den alten Randomdateien funktioniert, wird man nur heraus bekommen, wenn man alte Dateien hat, die vom echten DOS-Betriebssystem geschrieben worden sind. Soweit mal meine Gedanken dazu.

Weiß jemand, ob der Field-Befehl damals nur mit Strings oder auch mit Zahlen bestückt werden konnte ? Soweit mir noch bewußt ist, konnte man da auch nur Strings ($) speichern, die mit RSet zurecht gerückt wurden. Das würde die Sache dann noch vereinfachen, man hätte eine Struktur nur mit Bereichen.

Jetzt mitmachen!