DLLs | | | | H.Brill | Random Access DLL (Freeware) von MRK-Soft. Die Bearbeitung bzw. Auslesen von Random Access Dateien wurde schon öfter im Forum nachgefragt. |
| | | 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 ▲ |
| |
| | 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-BASIC & Co. nicht ging (Das physikalische Löschen) geht durch Umkopieren auch.
Viel Spaß damit !
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)' 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-BASIC 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. |
| | | 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. | vor 26 Tagen ▲ |
| |
|
Zur DLLThemenoptionen | 5.561 Betrachtungen |
ThemeninformationenDieses Thema hat 1 Teilnehmer: |