DLL | | | | H.Brill | Random Access DLL (Freeware) de MRK-Soft. El Bearbeitung o. Auslesen de Random Access Archivos wurde ya öfter en el Foro 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 mi (X)Profano - Variante. El Datensätze voluntad siempre ans Ende angehängt. Dafür puede ser aber auch Datensätze genau en el Punto ändern. Und qué früher en GW-BASIC & Co. no ging (Das physikalische Löschen) va por Umkopieren auch.
Viel Spaß así !
Declarar Mem Personal, Handle btn1, btn2, btn3, btn4, btn5, grid, edit1, edit2, edit3, edit4
Declarar Largo satznr, anz, ende, knopf, pos
Declarar String zeile, datei
Struct Mitarbeiter = Name$(30), Vorname$(30), Gehalt&, Abteilung$(256)
Dim Personal, Mitarbeiter
datei = $PROGDIR + "Mitarbeiter.dat"
Título de la ventana "Personal"
Ventana 620, 400
Crear("Text", %HWnd, "Name : ", 10, 10, 80, 25)
edit1 = Crear("Edit", %HWnd, "", 100, 10, 120, 25)
Crear("Text", %HWnd, "Vorname", 230, 10, 80, 25)
edit2 = Crear("Edit", %HWnd, "", 310, 10, 80, 25)
Crear("Text", %HWnd, "Gehalt : ", 10, 40, 80, 25)
edit3 = Crear("Edit", %HWnd, "", 100, 40, 80, 25)
Crear("Text", %HWnd, "Abteilung : ", 230, 40, 80, 25)
edit4 = Crear("Edit", %HWnd, "", 310, 40, 250, 25)
btn1 = Crear("Button", %HWnd, "Speichern", 10, 80, 80, 25)
btn2 = Crear("Button", %HWnd, "Lesen", 100, 80, 80, 25)
btn3 = Crear("Button", %HWnd, "Ändern", 200, 80, 80, 25)
btn4 = Crear("Button", %HWnd, "Löschen", 300, 80, 80, 25)
btn5 = Crear("Button", %HWnd, "Ende", 500, 80, 60, 25)
grid = Crear("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
Asignar #1, datei
Sinestar encargado ende
WaitInput
If Clicked(btn1)
' speichern
Claro 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)
AddStrings(grid, zeile)
SetCurSel grid, GetCount(grid) - 1
PutRecord(1, Personal)
SetText edit1, ""
SetText edit2, ""
SetText edit3, ""
SetText edit4, ""
Más
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
AddStrings(grid, zeile)
Claro Personal
EndWhile
Más
MessageBox("Noch no Expediente creado !", "Info", 0)
EndIf
ElseIf Clicked(btn3)
' Cambio
Claro 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)' ca. 0 - Position
EndIf
ElseIf Clicked(btn5)
ende = 1
ElseIf Clicked(grid)
pos = GetCurSel(grid)
If pos > -1
Línea = GetString$(grid, GetCurSel(grid))
SetText edit1, Substr$(Línea, 2, "|")
SetText edit2, Substr$(Línea, 3, "|")
SetText edit3, Substr$(Línea, 4, "|")
SetText edit4, Substr$(Línea, 5, "|")
EndIf
EndIf
Case %Key = 2 : ende = 1
EndWhile
Disponer Personal
Proc PutRecord
Parámetros Largo kanal, Memory bereich
Declarar Largo pos
OpenRW #kanal
Seek #kanal, GetFileSize(#kanal)
BlockWrite #kanal, bereich, 0, SizeOf(bereich)
Cerrar #kanal
ENDPROC
Proc GetRecord
Parámetros Largo kanal, satznr, Memory bereich
Declarar Largo size, offset, records
OpenRW #kanal
offset = satznr * SizeOf(bereich)
Seek #kanal, offset
BlockRead(#kanal, bereich, 0, SizeOf(bereich))
Cerrar #kanal
ENDPROC
Proc ChangeRecord
Parámetros Largo kanal, satznr, Memory bereich
Declarar Largo 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
Cerrar #kanal
ENDPROC
Proc DeleteRecord
Parámetros Largo kanal, satznr, Memory bereich
Declarar Largo offset, records
Asignar #2, $PROGDIR + "Datei2.dat"
OpenRW #kanal
OpenRW #2
offset = 0
records = GetFileSize(#kanal) / SizeOf(bereich)
Claro bereich
WhileLoop 1, records
Caso negativo &LOOP = satznr
Seek #kanal, offset
BlockRead(#kanal, bereich, 0, SizeOf(bereich))
Seek #2, GetFileSize(#2)
BlockWrite #2, bereich, 0, SizeOf(bereich)
Claro Zona
EndIf
Inc offset, SizeOf(bereich)
EndWhile
Cerrar #kanal
Borrar #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
Cerrar #kanal
Cerrar #2
Borrar #2
Asignar #2, ""
ENDPROC
End
Tal vez ha sí todavía alguien 'alte Schätzchen' de el DOS-Tiempo y möchte ellos en el Windowszeitalter retten. Yo denke veces, daß el así auch va, especialmente los números y Buchstaben beim OEM-Zeichensatz a el gleichen Punto posición. Wenn no, müßte uno veces con OemToAnsi$() oder el Bereichsfunktion Char$() probieren. Lo va sí praktisch sólo por lo tanto, daß en DOS todavía no abschließende Nullbytes a el Cuerdas waren.
Natürlich es bien, auch el GW-BASIC quelltext esta a haben, en el FIELD - Befehl con su Struktur a sehen. Das gleiche macht uno hier con Struct y anschließendem Dimmen uno Bereichs. Ein Asignar todavía dazu y el Vorbereitungen son 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 6 Tagen ▲ |
| |
|
Zur DLLThemeninformationenDieses Thema ha 1 subscriber: |