Kleine dynamische Datenbank im Interface-Stil

Beitrag von **NicTheQuick** » 16.08.2006 15:05

Lustigerweise ist es wieder am Laufen, aber eher zufällig, da ich gerade hier
was für Verwaltung programmiere.

Komischerweise hab ich anscheinend eine veraltete Version verwendet,
weswegen ich grad die Speicher- und Ladefunktionen wieder neu geproggt
hab. Naja, jetzt sind sie eh besser.

Das Row-statt-Col-und-Line-statt-Row-Problem besteht jetzt allerdings wieder. Aber das wird kein großer Akt werden.

Gut ist jetzt allerdings auch, dass man alle neuen Datentypen verwenden
kann, also Byte, Character, Word, Long, Float, Quad, Double und String. Das
war mir jetzt mal am wichtigsten nach dem PB 4.0 Update.

Ich poste den neuen Code einfach mal hierein. Wenn ich mit dem
Umbenennen der Funktionen wieder fertig bin, ändere ich auch wieder den
Code im ersten Post.

Achtung:

Code: Alles auswählen

Interface DB
  GetName.s()
  SetName(Name.s)
  
  AddRow(Typ.l, Name.s)
  SetRowName(Name.s, NewName.s)
  SetRowNameByID(id.l, NewName.s)
  GetRowNameByID.s(id.l)
  GetRowIDByName(Name.s)
  GetRowTyp(Name.s)
  GetRowTypByID(id.l)
  CountRows()
  
  AddLine()
  SelectLine(line.l)
  SelectLineByEntryPtr(Row.l, *Entry)
  SelectLineByEntry(Row.l, Entry.l)
  SelectLineByEntryS(Row.l, Entry.s)
  FirstLine()
  LastLine()
  NextLine()
  PrevLine()
  GetSelectedLine()
  ClearLine()
  DeleteLine()
  CountLines()
  
  SetEntryPtr(Row.l, *Entry)
  SetEntry(Row.l, Entry.q)
  SetEntryD(Row.l, Entry.d)
  SetEntryS(Row.l, Entry.s)
  GetEntry.q(Row.l)
  GetEntryD.d(Row.l)
  GetEntryS.s(Row.l)
  
  WriteDB(FileID.l)
  ReadDB(FileID.l)
EndInterface

Structure DB_Entry
  StructureUnion
    b.b
    c.c
    w.w
    l.l
    f.f
    q.q
    d.d
    s.s
  EndStructureUnion
EndStructure

#DB_ChunkLines = 128

;Einträge:  4 Bytes, Spaltenanzahl
;          xx Bytes, Daten

Structure DB_Struc
  VTable.l
  
  ;Data
  Name.s              ; Name der Datenbank
  Rows.l              ; Anzahl an Spalten
  Lines.l             ; Anzahl an Einträgen
  ActLine.l           ; aktuelle Zeile
  SortedRow.l         ; Spalte, die sortiert ist zum schnelleren finden
  RowSize.l
  *pRowName.String    ; Namen der Spaltenheader (Size = 4 * Rows)
  *pRowTyp            ; Typen der Spaltenheader (Size = Rows)
  *pLines             ; Zeilen der Datenbank, enthalten Pointer zu den Einträgen (Size = Lines * 4 * Rows)
  *pRowOffset         ; Offsets zu den Spaltenheadern (Size = 4 * Rows)
EndStructure

Procedure.s DB_GetName(*DB.DB_Struc) ;Gibt den Namen der Datenbank zurück
  ProcedureReturn *DB\Name
EndProcedure
Procedure.l DB_SetName(*DB.DB_Struc, Name.s) ;Setzt den Namen der Datenbank
  *DB\Name = Name
  ProcedureReturn #True
EndProcedure
;- Break
Procedure.l DB_AddRow(*DB.DB_Struc, Typ.l, Name.s) ;Fügt eine neue Spalte hinzu
  Protected Result1.l, Result2.l, *s.String, Result3.l, a.l
  
  Typ = Typ & $FF
  
  ; Erste Spalte hinzufügen
  If *DB\Rows = 0
    *DB\pRowTyp = AllocateMemory(1)
    If *DB\pRowTyp = 0 : ProcedureReturn #False : EndIf
    *DB\pRowName = AllocateMemory(SizeOf(String))
    If *DB\pRowName = 0 : FreeMemory(*DB\pRowTyp) : ProcedureReturn #False : EndIf
    *DB\pRowOffset = AllocateMemory(4)
    If *DB\pRowOffset = 0 : FreeMemory(*DB\pRowTyp) : FreeMemory(*DB\pRowName) : ProcedureReturn #False : EndIf
    
    *DB\Rows = 1
    
    Select Typ
      Case 'b', 'c' : *DB\RowSize = 1
      Case 'w' : *DB\RowSize = 2
      Case 'l', 'f', 's' : *DB\RowSize = 4
      Case 'd', 'q' : *DB\RowSize = 8
    EndSelect
    
    PokeL(*DB\pRowOffset, 0)
    PokeC(*DB\pRowTyp, Typ)
    *DB\pRowName\s = Name
    
    ProcedureReturn #True
  
  ; Weitere Spalten hinzufügen
  Else
    Result1 = ReAllocateMemory(*DB\pRowTyp, *DB\Rows + 1)
    If Result1 = 0 : ProcedureReturn #False : EndIf
    Result2 = ReAllocateMemory(*DB\pRowName, *DB\Rows * 4 + 4)
    If Result2 = 0 : *DB\pRowTyp = Result1 : ProcedureReturn #False : EndIf
    Result3 = ReAllocateMemory(*DB\pRowOffset, *DB\Rows * 4 + 4)
    
    If Result3
      *DB\Rows + 1
      *DB\pRowTyp = Result1
      *DB\pRowName = Result2
      *DB\pRowOffset = Result3
      
      *s = *DB\pRowName + *DB\Rows * 4 - 4
      *s\s = Name
      
      PokeC(*DB\pRowTyp + *DB\Rows - 1, Typ)
      
      a = PeekL(*DB\pRowOffset + *DB\Rows * 4 - 8)
      Select PeekC(*DB\pRowTyp + *DB\Rows - 2)
        Case 'b', 'c' : a + 1 : *DB\RowSize + 1
        Case 'w' : a + 2 : *DB\RowSize + 2
        Case 'l', 'f', 's' : a + 4 : *DB\RowSize + 4
        Case 'd', 'q' : a + 8 : *DB\RowSize + 8
      EndSelect
      PokeL(*DB\pRowOffset + *DB\Rows * 4 - 4, a)
      
      ProcedureReturn #True
    Else
      *DB\pRowTyp = Result1
      *DB\pRowName = Result2
      ProcedureReturn #False
    EndIf
  EndIf  
EndProcedure
Procedure.l DB_SetRowName(*DB.DB_Struc, Name.s, NewName.s) ;Setzt den Spaltennamen
  Protected a.l, *s.String
  
  *s = *DB\pRowName
  For a = 1 To *DB\Rows
    If *s\s = Name
      *s\s = NewName
      ProcedureReturn #True
    EndIf
    *s + SizeOf(String)
  Next
EndProcedure
Procedure.l DB_SetRowNameByID(*DB.DB_Struc, id.l, NewName.s) ;Setzt den Spaltennamen
  Protected *s.String
  
  If id <= 0 Or id > *DB\Rows : ProcedureReturn #False : EndIf
  *s = *DB\pRowName + id * 4 - 4
  *s\s = NewName
  ProcedureReturn #True
EndProcedure
Procedure.s DB_GetRowNameByID(*DB.DB_Struc, id.l) ;Gibt Spaltennamen zurück
  Protected *s.String
  
  If id <= 0 Or id > *DB\Rows : ProcedureReturn "" : EndIf
  *s = *DB\pRowName + id * 4 - 4
  ProcedureReturn *s\s
EndProcedure
Procedure.l DB_GetRowIDByName(*DB.DB_Struc, Name.s) ;Gibt Spaltennummer zurück
  Protected a.l, *s.String
  
  *s = *DB\pRowName
  For a = 1 To *DB\Rows
    If *s\s = Name : Break : EndIf
    *s + SizeOf(String)
  Next
  If a <= *DB\Rows : ProcedureReturn a : EndIf
  
  ProcedureReturn #False
EndProcedure
Procedure.l DB_GetRowTyp(*DB.DB_Struc, Name.s) ;Gibt den Typ einer Spalte zurück
  Protected a.l, *s.String
  
  *s = *DB\pRowName
  For a = 1 To *DB\Rows
    If *s\s = Name : Break : EndIf
    *s + SizeOf(String)
  Next
  If a <= *DB\Rows
    ProcedureReturn PeekB(*DB\pRowTyp + a - 1) & $FF
  EndIf
  
  ProcedureReturn #False
EndProcedure
Procedure.l DB_GetRowTypByID(*DB.DB_Struc, id.l) ;Gibt den Typ einer Spalte zurück
  Protected *s.String
  
  If id <= 0 Or id > *DB\Rows : ProcedureReturn #False : EndIf
  ProcedureReturn PeekC(*DB\pRowTyp + id -1) & $FF
EndProcedure
Procedure.l DB_CountRows(*DB.DB_Struc) ;Gibt die Anzahl der Spalten zurück
  ProcedureReturn *DB\Rows
EndProcedure
;- Break
Procedure.l DB_AddLine(*DB.DB_Struc) ;Fügt eine neue Zeile hinzu, die zur aktuellen wird
  Protected *Line.Long

  If *DB\Rows = 0 : ProcedureReturn #False : EndIf
  If *DB\Lines = 0
    *DB\pLines = AllocateMemory(#DB_ChunkLines * 4)
    If *DB\pLines = 0 : ProcedureReturn #False : EndIf
    
    *Line = *DB\pLines
    *Line\l = AllocateMemory(4 + *DB\RowSize)
    PokeL(*Line\l, *DB\Rows)
    *DB\Lines = 1
    *DB\ActLine = 1
    ProcedureReturn #True
  
  Else
    If (*DB\Lines + 1) % #DB_ChunkLines = 0
      *DB\pLines = ReAllocateMemory(*DB\pLines, (*DB\Lines + 1) / #DB_ChunkLines * 100)
      If *DB\pLines = 0 : ProcedureReturn #False : EndIf
    EndIf
    *DB\Lines + 1
    *Line = *DB\pLines + *DB\Lines * 4 - 4
    *Line\l = AllocateMemory(*DB\RowSize + 4)
    PokeL(*Line\l, *DB\Rows)
    *DB\ActLine = *DB\Lines
  EndIf
EndProcedure
Procedure.l DB_SelectLine(*DB.DB_Struc, line.l) ;Wählt eine Zeile aus
  If line > 0 And line <= *DB\Lines
    *DB\ActLine = line
  EndIf
EndProcedure
Procedure.l DB_SelectLineByEntryPtr(*DB.DB_Struc, Row.l, *Entry.DB_Entry) ;Wählt eine Zeile aus
  Protected a.l, *Line.Long, *vEntry.DB_Entry, Typ.l, offset.l
  
  If Row > 0 And Row <= *DB\Rows
    Typ = PeekC(*DB\pRowTyp + Row - 1)
    *Line = *DB\pLines + *DB\ActLine * 4
    offset = PeekL(*DB\pRowOffset + Row * 4 - 4)
    
    For a = *DB\ActLine + 1 To *DB\Lines
      *vEntry = *Line\l + offset + 4
      If PeekL(*Line\l) >= Row
        Select Typ
          Case 'b' : If *vEntry\b = *Entry\b : Break : EndIf
          Case 'c' : If *vEntry\c = *Entry\c : Break : EndIf
          Case 'w' : If *vEntry\w = *Entry\w : Break : EndIf
          Case 'l' : If *vEntry\l = *Entry\l : Break : EndIf
          Case 'f' : If *vEntry\f = *Entry\f : Break : EndIf
          Case 'd' : If *vEntry\d = *Entry\d : Break : EndIf
          Case 'q' : If *vEntry\q = *Entry\q : Break : EndIf
          Case 's' : If *vEntry\s = PeekS(*Entry) : Break : EndIf
        EndSelect
      EndIf
      *Line + 4
    Next
    
    If a <= *DB\Lines
      *DB\ActLine = a
      ProcedureReturn #True
    EndIf
    
  EndIf
  
  ProcedureReturn #False
EndProcedure
Procedure.l DB_SelectLineByEntry(*DB.DB_Struc, Row.l, Entry.l) ;Wählt eine Zeile aus
  Protected a.l, *Line.Long, *vEntry.DB_Entry, Typ.l, offset.l
  
  If Row > 0 And Row <= *DB\Rows
    Typ = PeekC(*DB\pRowTyp + Row - 1)
    *Line = *DB\pLines + *DB\ActLine * 4
    offset = PeekL(*DB\pRowOffset + Row * 4 - 4)
    
    For a = *DB\ActLine + 1 To *DB\Lines
      *vEntry = *Line\l + offset + 4
      If PeekL(*Line\l) >= Row
        Select Typ
          Case 'b' : If *vEntry\b = Entry : Break : EndIf
          Case 'c' : If *vEntry\c = Entry : Break : EndIf
          Case 'w' : If *vEntry\w = Entry : Break : EndIf
          Case 'l' : If *vEntry\l = Entry : Break : EndIf
          Case 'f' : If *vEntry\f = Entry : Break : EndIf
          Case 'd' : If *vEntry\d = Entry : Break : EndIf
          Case 'q' : If *vEntry\q = Entry : Break : EndIf
          Case 's' : If *vEntry\s = Str(Entry) : Break : EndIf
        EndSelect
      EndIf
      *Line + 4
    Next
    
    If a <= *DB\Lines
      *DB\ActLine = a
      ProcedureReturn #True
    EndIf
    
  EndIf
  
  ProcedureReturn #False
EndProcedure
Procedure.l DB_SelectLineByEntryS(*DB.DB_Struc, Row.l, Entry.s) ;Wählt eine Zeile aus
  Protected a.l, *Line.Long, *vEntry.DB_Entry, Typ.l, offset.l
  
  If Row > 0 And Row <= *DB\Rows
    Typ = PeekC(*DB\pRowTyp + Row - 1) & $FF
    *Line = *DB\pLines + *DB\ActLine * 4
    offset = PeekL(*DB\pRowOffset + Row * 4 - 4)
    
    For a = *DB\ActLine + 1 To *DB\Lines
      *vEntry = *Line\l + offset + 4
      If PeekL(*Line\l) >= Row
        Select Typ
          Case 'b' : If *vEntry\b = Val(Entry) : Break : EndIf
          Case 'c' : If *vEntry\c = Val(Entry) : Break : EndIf
          Case 'w' : If *vEntry\w = Val(Entry) : Break : EndIf
          Case 'l' : If *vEntry\l = Val(Entry) : Break : EndIf
          Case 'f' : If *vEntry\f = ValF(Entry) : Break : EndIf
          Case 'd' : If *vEntry\d = ValD(Entry) : Break : EndIf
          Case 'q' : If *vEntry\q = ValQ(Entry) : Break : EndIf
          Case 's' : If *vEntry\s = Entry : Break : EndIf
        EndSelect
      EndIf
      *Line + 4
    Next
    
    If a <= *DB\Lines
      *DB\ActLine = a
      ProcedureReturn #True
    EndIf
    
  EndIf
  
  ProcedureReturn #False
EndProcedure
Procedure.l DB_FirstLine(*DB.DB_Struc) ;Wählt die erste Zeile aus
  If *DB\Lines = 0 : ProcedureReturn #False : EndIf
  *DB\ActLine = 1
  ProcedureReturn #True
EndProcedure
Procedure.l DB_LastLine(*DB.DB_Struc) ;Wählt die letzte Zeile aus
  If *DB\Lines = 0 : ProcedureReturn #False : EndIf
  *DB\ActLine = *DB\Lines
  ProcedureReturn #True
EndProcedure
Procedure.l DB_NextLine(*DB.DB_Struc) ;Wählt die nächste Zeile aus
  If *DB\ActLine < *DB\Lines
    *DB\ActLine + 1
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.l DB_PrevLine(*DB.DB_Struc) ;Wählt die vorherige Zeile aus
  If *DB\ActLine > 1
    *DB\ActLine - 1
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.l DB_GetSelectedLine(*DB.DB_Struc) ;Gibt die aktuelle Zeilennummer aus
  ProcedureReturn *DB\ActLine
EndProcedure
Procedure.l DB_ClearLine(*DB.DB_Struc) ;Leert die aktuelle Zeile
  Protected *Line.Long, *Entry.DB_Entry, *Typ.Character, Row.l, Rows.l

  *Line = *DB\pLines + *DB\ActLine * 4 - 4
  Rows = PeekL(*Line\l)
  *Typ = *DB\pRowTyp
  *Entry = *Line\l + 4
  For Row = 1 To Rows
    Select *Typ\c
      Case 'b' : *Entry\b = 0 : *Entry + 1
      Case 'c' : *Entry\c = 0 : *Entry + 1
      Case 'w' : *Entry\w = 0 : *Entry + 2
      Case 'l' : *Entry\l = 0 : *Entry + 4
      Case 'f' : *Entry\f = 0 : *Entry + 4
      Case 'd' : *Entry\d = 0 : *Entry + 8
      Case 'q' : *Entry\q = 0 : *Entry + 8
      Case 's' : *Entry\s = "" : *Entry + 4
    EndSelect
    *Typ + 1
  Next
  ProcedureReturn #True
EndProcedure
Procedure.l DB_DeleteLine(*DB.DB_Struc) ;Löscht die aktuelle Zeile
  Protected *Line.Long, *Entry.DB_Entry, *Typ.Character, Row.l, Rows.l

  *Line = *DB\pLines + *DB\ActLine * 4 - 4
  Rows = PeekL(*Line\l)
  *Typ = *DB\pRowTyp
  For Row = 1 To Rows
    If *Typ\c = 's'
      *Entry = *Line\l + 4 + PeekL(*DB\pRowOffset + Row * 4 - 4)
      *Entry\s = ""
    EndIf
    *Typ + 1
  Next
  FreeMemory(*Line\l)
  CopyMemory(*DB\pLines + *DB\ActLine * 4, *DB\pLines + *DB\ActLine * 4 - 4, (*DB\Lines - *DB\ActLine) * 4)
  ReAllocateMemory(*DB\pLines, *DB\Lines * 4 - 4)
  *DB\Lines - 1
  If *DB\ActLine > *DB\Lines : *DB\ActLine = *DB\Lines : EndIf
EndProcedure
Procedure.l DB_CountLines(*DB.DB_Struc) ;Gibt die Anzahl der Zeilen zurück

  ProcedureReturn *DB\Lines
EndProcedure
;- Break
Procedure.l DB_SetEntryPtr(*DB.DB_Struc, Row.l, *Entry.DB_Entry) ;Setzt einen Eintrag
  Protected Typ.l, *vEntry.DB_Entry, *Line.Long, Result1.l

  If Row > 0 And Row <= *DB\Rows
    Typ = PeekB(*DB\pRowTyp + Row - 1) & $FF
    *Line = *DB\pLines + *DB\ActLine * 4 - 4
    
    If PeekL(*Line\l) < Row
      Result1 = ReAllocateMemory(*Line\l, *DB\RowSize + 4)
      If Result1 = 0 : ProcedureReturn #False : EndIf
      *Line\l = Result1
    EndIf
    
    *vEntry = *Line\l + 4 + PeekL(*DB\pRowOffset + Row * 4 - 4)
    Select Typ
      Case 'b' : *vEntry\b = *Entry\b
      Case 'c' : *vEntry\c = *Entry\c
      Case 'w' : *vEntry\w = *Entry\w
      Case 'l' : *vEntry\l = *Entry\l
      Case 'f' : *vEntry\f = *Entry\f
      Case 'd' : *vEntry\d = *Entry\d
      Case 'q' : *vEntry\q = *Entry\q
      Case 's' : *vEntry\s = PeekS(*Entry)
    EndSelect
    ProcedureReturn #True
  EndIf
EndProcedure
Procedure.l DB_SetEntry(*DB.DB_Struc, Row.l, Entry.q) ;Setzt einen Eintrag
  Protected Typ.l, *vEntry.DB_Entry, *Line.Long, Result1.l, d.d
  
  If Row > 0 And Row <= *DB\Rows
    Typ = PeekC(*DB\pRowTyp + Row - 1) & $FF
    *Line = *DB\pLines + *DB\ActLine * 4 - 4
    
    If PeekL(*Line\l) < Row
      Result1 = ReAllocateMemory(*Line\l, *DB\RowSize + 4)
      If Result1 = 0 : ProcedureReturn #False : EndIf
      *Line\l = Result1
    EndIf
    
    *vEntry = *Line\l + 4 + PeekL(*DB\pRowOffset + Row * 4 - 4)
    Select Typ
      Case 'b' : *vEntry\b = Entry & $FF
      Case 'c' : *vEntry\c = Entry & $FF
      Case 'w' : *vEntry\w = Entry & $FFFF
      Case 'l' : *vEntry\l = Entry & $FFFFFFFF
      Case 'f' : *vEntry\f = Entry
      Case 'd' : *vEntry\d = PeekQ(@Entry) ;- Workaround ???
      Case 'q' : *vEntry\q = PeekQ(@Entry)
      Case 's' : *vEntry\s = Str(Entry)
    EndSelect
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.l DB_SetEntryD(*DB.DB_Struc, Row.l, Entry.d) ;Setzt einen Eintrag
  Protected Typ.l, *vEntry.DB_Entry, *Line.Long, Result1.l
  
  If Row > 0 And Row <= *DB\Rows
    Typ = PeekC(*DB\pRowTyp + Row - 1) & $FF
    *Line = *DB\pLines + *DB\ActLine * 4 - 4
    
    If PeekL(*Line\l) < Row
      Result1 = ReAllocateMemory(*Line\l, *DB\RowSize + 4)
      If Result1 = 0 : ProcedureReturn #False : EndIf
      *Line\l = Result1
    EndIf
    
    *vEntry = *Line\l + 4 + PeekL(*DB\pRowOffset + Row * 4 - 4)
    Select Typ
      Case 'b' : *vEntry\b = Int(Entry) & $FF
      Case 'c' : *vEntry\c = Int(Entry) & $FF
      Case 'w' : *vEntry\w = Int(Entry) & $FFFF
      Case 'l' : *vEntry\l = Int(Entry) & $FFFFFFFF
      Case 'f' : *vEntry\f = Entry
      Case 'd' : *vEntry\d = PeekD(@Entry)
      Case 'q' : *vEntry\q = Int(Entry)
      Case 's' : *vEntry\s = StrD(Entry)
    EndSelect
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.l DB_SetEntryS(*DB.DB_Struc, Row.l, Entry.s) ;Setzt einen Eintrag
  Protected Typ.l, *vEntry.DB_Entry, *Line.Long, Result1.l
  
  If Row > 0 And Row <= *DB\Rows
    Typ = PeekC(*DB\pRowTyp + Row - 1) & $FF
    *Line = *DB\pLines + *DB\ActLine * 4 - 4
    
    If PeekL(*Line\l) < Row
      Result1 = ReAllocateMemory(*Line\l, *DB\RowSize + 4)
      If Result1 = 0 : ProcedureReturn #False : EndIf
      *Line\l = Result1
    EndIf
    
    *vEntry = *Line\l + 4 + PeekL(*DB\pRowOffset + Row * 4 - 4)
    Select Typ
      Case 'b' : *vEntry\b = Val(Entry)
      Case 'c' : *vEntry\c = Val(Entry)
      Case 'w' : *vEntry\w = Val(Entry)
      Case 'l' : *vEntry\l = Val(Entry)
      Case 'f' : *vEntry\f = ValF(Entry)
      Case 'd' : *vEntry\d = ValD(Entry)
      Case 'q' : *vEntry\q = ValQ(Entry)
      Case 's' : *vEntry\s = Entry
    EndSelect
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure.q DB_GetEntry(*DB.DB_Struc, Row.l) ;Gibt einen Eintrag zurück
  Protected Typ.l, *vEntry.DB_Entry, *Line.Long
  
  If Row > 0 And Row <= *DB\Rows
    Typ = PeekC(*DB\pRowTyp + Row - 1) & $FF
    *Line = *DB\pLines + *DB\ActLine * 4 - 4
    
    If PeekL(*Line\l) < Row : ProcedureReturn #False : EndIf
    
    *vEntry = *Line\l + 4 + PeekL(*DB\pRowOffset + Row * 4 - 4)
    Select Typ
      Case 'b' : ProcedureReturn *vEntry\b
      Case 'c' : ProcedureReturn *vEntry\c
      Case 'w' : ProcedureReturn *vEntry\w
      Case 'l' : ProcedureReturn *vEntry\l
      Case 'f' : ProcedureReturn *vEntry\f
      Case 'd' : ProcedureReturn *vEntry\d
      Case 'q' : ProcedureReturn *vEntry\q
      Case 's' : ProcedureReturn ValQ(*vEntry\s)
    EndSelect
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.d DB_GetEntryD(*DB.DB_Struc, Row.l) ;Gibt einen Eintrag zurück
  Protected Typ.l, *vEntry.DB_Entry, *Line.Long
  
  If Row > 0 And Row <= *DB\Rows
    Typ = PeekC(*DB\pRowTyp + Row - 1) & $FF
    *Line = *DB\pLines + *DB\ActLine * 4 - 4
    
    If PeekL(*Line\l) < Row : ProcedureReturn #False : EndIf
    
    *vEntry = *Line\l + 4 + PeekL(*DB\pRowOffset + Row * 4 - 4)
    Select Typ
      Case 'b' : ProcedureReturn *vEntry\b
      Case 'c' : ProcedureReturn *vEntry\c
      Case 'w' : ProcedureReturn *vEntry\w
      Case 'l' : ProcedureReturn *vEntry\l
      Case 'f' : ProcedureReturn *vEntry\f
      Case 'd' : ProcedureReturn *vEntry\d
      Case 'q' : ProcedureReturn *vEntry\q
      Case 's' : ProcedureReturn ValD(*vEntry\s)
    EndSelect
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure
Procedure.s DB_GetEntryS(*DB.DB_Struc, Row.l) ;Gibt einen Eintrag zurück
  Protected Typ.l, *vEntry.DB_Entry, *Line.Long
  
  If Row > 0 And Row <= *DB\Rows
    Typ = PeekC(*DB\pRowTyp + Row - 1) & $FF
    *Line = *DB\pLines + *DB\ActLine * 4 - 4
    
    If PeekL(*Line\l) < Row : ProcedureReturn "" : EndIf
    
    *vEntry = *Line\l + 4 + PeekL(*DB\pRowOffset + Row * 4 - 4)
    Select Typ
      Case 'b' : ProcedureReturn Str(*vEntry\b)
      Case 'c' : ProcedureReturn Str(*vEntry\c)
      Case 'w' : ProcedureReturn Str(*vEntry\w)
      Case 'l' : ProcedureReturn Str(*vEntry\l)
      Case 'f' : ProcedureReturn StrF(*vEntry\f)
      Case 'd' : ProcedureReturn StrD(*vEntry\d)
      Case 'q' : ProcedureReturn StrQ(*vEntry\q)
      Case 's' : ProcedureReturn *vEntry\s
    EndSelect
  EndIf
  ProcedureReturn ""
EndProcedure
;- Break
Procedure.l DB_WriteDB(*DB.DB_Struc, FileID.l) ;Schreibt die Datenbank in eine geöffnete Datei
  Protected a.l, Row.l, *Line.Long, Rows.l, *Entry.DB_Entry, *Typ.Character
  
  WriteLong(FileID, Len(*DB\Name))
  WriteString(FileID, *DB\Name)
  WriteLong(FileID, *DB\Lines)
  WriteLong(FileID, *DB\Rows)
  *Entry = *DB\pRowName
  For a = 1 To *DB\Rows
    WriteLong(FileID, Len(*Entry\s))
    WriteString(FileID, *Entry\s)
    *Entry + 4
  Next
  
  WriteData(FileID, *DB\pRowTyp, *DB\Rows)
  WriteData(FileID, *DB\pRowOffset, *DB\Rows * 4)
  
  *Line = *DB\pLines
  For a = 1 To *DB\Lines
    *Entry = *Line\l
    Rows = *Entry\l
    *Entry + 4
    *Typ = *DB\pRowTyp
    WriteLong(FileID, Rows)
    For Row = 1 To Rows
      Select *Typ\c
        Case 'b' : WriteByte(FileID, *Entry\b) : *Entry + 1
        Case 'c' : WriteCharacter(FileID, *Entry\c) : *Entry + 1
        Case 'w' : WriteWord(FileID, *Entry\w) : *Entry + 2
        Case 'l' : WriteLong(FileID, *Entry\l) : *Entry + 4
        Case 'f' : WriteFloat(FileID, *Entry\f) : *Entry + 4
        Case 'q' : WriteQuad(FileID, *Entry\q) : *Entry + 8
        Case 'd' : WriteDouble(FileID, *Entry\d) : *Entry + 8
        Case 's' : WriteLong(FileID, Len(*Entry\s)) : WriteString(FileID, *Entry\s) : *Entry + 4
      EndSelect
      *Typ + 1
    Next
    *Line + 4
  Next
EndProcedure

Procedure.s DB_ReadString(FileID.l)
  Protected l.l, s.s
  l = ReadLong(FileID)
  s = Space(l)
  ReadData(FileID, @s, l)
  ProcedureReturn s
EndProcedure
Procedure.l DB_ReadDB(*DB.DB_Struc, FileID.l)
  Protected *DBI.DB = *DB, Row.l, *s.String, *Entry.DB_Entry, Rows.l, *Line.Long, *c.Character
  
  If *DB\Lines Or *DB\Rows : ProcedureReturn #False : EndIf
  
  *DB\Name = DB_ReadString(FileID)
  *DB\Lines = ReadLong(FileID)
  *DB\Rows  = ReadLong(FileID)
  
  *DB\pRowTyp = AllocateMemory(*DB\Rows)
  If *DB\pRowTyp = 0 : ProcedureReturn #False : EndIf
  *DB\pRowOffset = AllocateMemory(*DB\Rows * 4)
  If *DB\pRowOffset = 0 : FreeMemory(*DB\pRowTyp) : ProcedureReturn #False : EndIf
  *DB\pRowName = AllocateMemory(*DB\Rows * 4)
  If *DB\pRowName = 0 : FreeMemory(*DB\pRowTyp) : FreeMemory(*DB\pRowOffset) : ProcedureReturn #False : EndIf
  *DB\pLines = AllocateMemory(*DB\Lines * 4)
  If *DB\pLines = 0 : FreeMemory(*DB\pRowTyp) : FreeMemory(*DB\pRowOffset) : FreeMemory(*DB\pRowName) : ProcedureReturn #False : EndIf
  
  *s = *DB\pRowName
  For Row = 1 To *DB\Rows
    *s\s = DB_ReadString(FileID)
    *s + 4
  Next
  
  ReadData(FileID, *DB\pRowTyp, *DB\Rows)
  *DB\RowSize = 0 : *c = *DB\pRowTyp
  For a = 1 To *DB\Rows
    Select *c\c
      Case 'b', 'c' : *DB\RowSize + 1
      Case 'w' : *DB\RowSize + 2
      Case 'l', 'f', 's' : *DB\RowSize + 4
      Case 'q', 'd' : *DB\RowSize + 8
    EndSelect
    *c + 1
  Next
  ReadData(FileID, *DB\pRowOffset, *DB\Rows * 4)
  
  *Line = *DB\pLines
  For a = 1 To *DB\Lines
    Rows = ReadLong(FileID)
    *Line\l = AllocateMemory(*DB\RowSize + 4)
    If *Line\l
      *Entry = *Line\l
      *Entry\l = Rows
      *Entry + 4
      *c = *DB\pRowTyp
      For Row = 1 To Rows
        Select *c\c
          Case 'b' : *Entry\b = ReadByte(FileID) : *Entry + 1
          Case 'c' : *Entry\c = ReadCharacter(FileID) : *Entry + 1
          Case 'w' : *Entry\w = ReadWord(FileID) : *Entry + 2
          Case 'l' : *Entry\l = ReadLong(FileID) : *Entry + 4
          Case 'f' : *Entry\f = ReadFloat(FileID) : *Entry + 4
          Case 'q' : *Entry\q = ReadQuad(FileID) : *Entry + 8
          Case 'd' : *Entry\d = ReadDouble(FileID) : *Entry + 8
          Case 's' : *Entry\s = DB_ReadString(FileID) : *Entry + 4
        EndSelect
        *c + 1
      Next
    EndIf
    *Line + 4
  Next
  
  If *DB\Lines : *DB\ActLine = 1 : Else : *DB\ActLine = 0 : EndIf
EndProcedure


;- Break
DataSection ;{
  DB_VT:
    Data.l @DB_GetName(), @DB_SetName()
    
    Data.l @DB_AddRow(), @DB_SetRowName(), @DB_SetRowNameByID()
    Data.l @DB_GetRowNameByID(), @DB_GetRowIDByName(), @DB_GetRowTyp(), @DB_GetRowTypByID(), @DB_CountRows()
    
    Data.l @DB_AddLine(), @DB_SelectLine(), @DB_SelectLineByEntryPtr(), @DB_SelectLineByEntry()
    Data.l @DB_SelectLineByEntryS(), @DB_FirstLine(), @DB_LastLine(), @DB_NextLine(), @DB_PrevLine(), @DB_GetSelectedLine()
    Data.l @DB_ClearLine(), @DB_DeleteLine(), @DB_CountLines()
    
    Data.l @DB_SetEntryPtr(), @DB_SetEntry(), @DB_SetEntryD(), @DB_SetEntryS()
    Data.l @DB_GetEntry(), @DB_GetEntryD(), @DB_GetEntryS()
    
    Data.l @DB_WriteDB(), @DB_ReadDB()
EndDataSection ;}
Procedure.l DB_Create(Name.s = "")
  Protected *DB.DB_Struc
  
  *DB = AllocateMemory(SizeOf(DB_Struc))
  *DB\VTable = ?DB_VT
  
  If *DB = 0 : ProcedureReturn #False : EndIf
  *DB\Name = Name
  *DB\Rows = 0
  *DB\RowSize = 0
  *DB\Lines = 0
  *DB\ActLine = 0
  *DB\SortedRow = 0
  
  ProcedureReturn *DB
EndProcedure

;Neue Datenbank erstellen
*DB.DB = DB_Create("Personen")
*DB\AddRow('l', "ID")
*DB\AddRow('s', "Vorname")
*DB\AddRow('s', "Nachname")

;Datenbank namen ermitteln
Debug "Datenbank: " + *DB\GetName()

;Anzahl an Spalten ausgeben
Debug "Spalten: " + Str(*DB\CountRows())

;Spaltennamen auflisten
For a = 1 To *DB\CountRows()
  Debug Str(a) + " - " + *DB\GetRowNameByID(a)
Next

;Erstelle fünf Einträge
*DB\AddLine()
  *DB\SetEntryD(1, 1)
  *DB\SetEntryS(2, "Thomas")
  *DB\SetEntryS(3, "Henry")
*DB\AddLine()
  *DB\SetEntry(1, 2)
  *DB\SetEntryS(2, "Jessica")
  *DB\SetEntryS(3, "Alba")
*DB\AddLine()
  *DB\SetEntry(1, 3)
  *DB\SetEntryS(2, "Tom")
  *DB\SetEntryS(3, "Wichtigtuer")
*DB\AddLine()
  *DB\SetEntry(1, 4)
  *DB\SetEntryS(2, "Franz")
  *DB\SetEntryS(3, "Guckindieluft")
*DB\AddLine()
  *DB\SetEntry(1, 5)
  *DB\SetEntryS(2, "Sebastian")
  *DB\SetEntryS(3, "Koch")

;Gib die Anzahl der Einträge aus
Debug "Einträge: " + Str(*DB\CountLines())

Debug ""
*DB\FirstLine()
;Such den Eintrag mit Vornamen 'Jessica"
*DB\SelectLineByEntryS(2, "Jessica")

;Gib ID und Nachname aus
Debug "ID: " + *DB\GetEntryS(1)
Debug "Nachname: " + *DB\GetEntryS(3)

Debug ""

;Such den Eintrag mit ID '4'
*DB\SelectLineByEntry(1, 4)

;Gib Vorname und Nachname aus:
Debug "Vorname: " + *DB\GetEntryS(2)
Debug "Nachname: " + *DB\GetEntryS(3)

Debug ""
;Leere die aktuelle Zeile
*DB\ClearLine()

;Gib ID, Vorname und Nachname nochmal aus
Debug "ID: " + *DB\GetEntryS(1)
Debug "Vorname: " + *DB\GetEntryS(2)
Debug "Nachname: " + *DB\GetEntryS(3)

Debug ""
;Lösche den Eintrag komplett
*DB\DeleteLine()

;Liste nochmal die komplette Tabelle auf
If *DB\FirstLine()
  Repeat
    Debug *DB\GetEntryS(1) + ", " + *DB\GetEntryS(2) + ", " + *DB\GetEntryS(3)
  Until *DB\NextLine() = #False
EndIf

;Speichere die Tabelle
If CreateFile(0, "c:\testdatenbank.db")
  *DB\WriteDB(0)
  CloseFile(FileID)
EndIf

;Lade die Tabelle
If ReadFile(0, "c:\testdatenbank.db")
  *DB2.DB = DB_Create()
  *DB2\ReadDB(0)
  CloseFile(0)
EndIf

;Liste nochmal die komplette Tabelle auf
Debug ""
If *DB2\FirstLine()
  Repeat
    Debug *DB2\GetEntryS(1) + ", " + *DB2\GetEntryS(2) + ", " + *DB2\GetEntryS(3)
  Until *DB2\NextLine() = #False
EndIf

ts-soft · Beitrag von **ts-soft** » 16.08.2006 19:21

Schöne Sache

Könnte man irgendwie noch einen Mem da rein basteln, für Bilder usw.

PS: Alex hört sich auch gut an, kommt selten vor, das ich mir akt. Musik mal
zuende anhöre

//Edit
Datentyp M sollte dank MemorySize eigentlich einfach umzusetzen sein. In
der Structure braucht ja nur der Pointer gespeichert werden. Beim schreiben
müßte dann aber auch die Länge vermerkt werden.

Gruß
Thomas

Beitrag von **NicTheQuick** » 17.08.2006 12:05

Hab jetzt einen Memory-Typ reingebastelt, aber noch nicht getestet. Aber
fürs Hardcore-Testing seid ja sowieso ihr zuständig.

So, ich baue jetzt nochmal alles etwas um, damit man on-the-fly Spalten
löschen, dazwischenschieben und vertauschen kann. Bin mal gespannt, ob
alles so klappt, wie ich das will.

Achja, der neue Code ist jetzt wieder im ersten Post.

Beitrag von **Kiffi** » 17.08.2006 12:30

NicTheQuick hat geschrieben:Aber
fürs Hardcore-Testing seid ja sowieso ihr zuständig.

ist zwar kein Hardcore-Testing, aber 'nen Bug habe ich schon gefunden

Code: Alles auswählen

;Neue Datenbank erstellen
Global *DB.DB
*DB = DB_Create("Personen")
*DB\AddCol('l', "ID")
*DB\AddCol('s', "Vorname")
*DB\AddCol('s', "Nachname")

Define.l Counter

For Counter = 0 To 1000
  *DB\AddRow()
  *DB\SetEntryD(1, Counter)
  *DB\SetEntryS(2, "Thomas" + Str(Counter))
  *DB\SetEntryS(3, "Henry" + Str(Counter))
Next

Bei Counter = 444 knallt's bei mir mit einem 'Invalid memory access' in der Zeile

Code: Alles auswählen

*Row\l = AllocateMemory(*DB\ColSize + 4)

in DB_AddRow()

Grüße ... Kiffi

Beitrag von **NicTheQuick** » 17.08.2006 13:37

Geht jetzt bei mir. Nimm dir aber den Code aus dem ersten Post.

Ich weiß jetzt nicht, woran es gelegen hat, aber es geht jetzt. Hab schon
Sachen verbessert, bevor ich deinen Post gesehen hab. Vielleicht war das
dann da dabei.

Beitrag von **Kiffi** » 17.08.2006 13:40

> Hab schon Sachen verbessert, bevor ich deinen Post gesehen hab.
> Vielleicht war das dann da dabei.

yupp, war dabei

Prima, dann kann ich ja jetzt weiter testen.

Danke & Grüße ... Kiffi

ts-soft · Beitrag von **ts-soft** » 17.08.2006 18:44

>> Hab jetzt einen Memory-Typ reingebastelt

Beitrag von **Kiffi** » 17.08.2006 18:58

Hallo Nic,

... und da habe ich auch schon ein Feature-Request

Man kann ja mittels DB_SelectLineByEntryS() eine Zeile mit dem
angegebenen Pattern auswählen.

Code: Alles auswählen

;Such den Eintrag mit Vornamen 'Jessica"
*DB\DB_SelectLineByEntryS(2, "Jessica")

Was aber, wenn es mehrere Treffer für dieses Pattern gibt?

Code: Alles auswählen

;Such den Eintrag mit Nachnamen 'Müller"
*DB\DB_SelectLineByEntryS(2, "Müller")

(es gibt ja nicht gerade wenige Müllers)

Könntest Du in diesem Fall eine Liste mit den gefundenen Treffern
zurückliefern (beispielsweise eine LinkedList oder was auch immer)?

Super, wenn das überdies auch noch mit Wildcards (*, ?) gehen würde.

Code: Alles auswählen

*DB\DB_SelectLineByEntryS(2, "M?ller")

(findet beispielsweise Müller und Möller)

Ich weiss, dass das nicht gerade 'easy stuff' ist, aber vielleicht kriegstes
ja hin

Danke & Grüße ... Kiffi

Beitrag von **bobobo** » 17.08.2006 19:04

Find ich ja jetzt doof dass ich SQL gelernt hab
Wo es doch so einfach geht

ts-soft · Beitrag von **ts-soft** » 17.08.2006 19:09

Wenn dann noch das indizieren über mehrere geöffnete Datenbanken
(Tabellen) gehen würde, wäre es bald perfekt

Mit der neuen Cheetah4.dll komme ich nämlich gerade nicht klar