Jabaco Source

' globals - globale Variable

Dim dbfilename As String = "c:/Testdaten/formula1.db4o" ' DB-Datei
Dim DB     As com#db4o#ObjectContainer
Dim oSet   As com#db4o#ObjectSet
Dim osResult   As com#db4o#ObjectSet

Dim pilot1 As New Pilot()
Dim pilot2 As New Pilot()
Dim proto  As New Pilot()
Dim p  As New Pilot()


Public Sub main(ByJava args() As String)
   Dim myArgs() As String
   myArgs = args
   ' [Your Source]
   
   On Error Goto ErrOut
   ' open database
   Println()
   Println("Open DB")  
   DB = db4o.openFile(dbfilename)
   
   ' create pilots
   Println()
   Println("Create pilots")
   CreatePilots()

   ' store pilots
   Println()   
   Println("Store pilots")
   StorePilots()
   
   ' read all pilots
   ' query by example: 
   '  Search all objects of a class which the same field values as the sample.
   '  An empty prototype has in all fields Null or 0
   proto.Name = Null
   proto.Points = 0   
   Println()
   Println("Read all pilots")
   osResult = DB.get(proto)   
   ' a shorter way
   ' osResult = DB.get(Pilot.class)
   Println()
   ListResult(osResult)
   
   ' find pilot by name
   Dim name As String = "Michael Schumacher"
   Println()
   Println("Find pilot by name: " & name)
   FindPilotsByName(name)
   
   ' find pilot by points
   Dim points As Integer = 90
   Println()
   Println("Find pilot by points: " & points)
   FindPilotsByPoints(points)

   ' update pilot
   Println()
   Println("Update pilot")
   UpdatePilotsByName("Michael Schumacher", 5)  
   osResult = DB.get(Pilot.class)
   Println()
   ListResult(osResult)  
   
   ' delete pilot by name
   Println()
   Println("Delete pilot: " & name)
   DeletePilotsByName(name)
   osResult = DB.get(Pilot.class)
   Println()
   ListResult(osResult)  

   ' delete pilot by points
   Println()
   Println("Delete pilot: " & points)
   DeletePilotsByPoints(points)
   osResult = DB.get(Pilot.class)
   Println()
   ListResult(osResult)  

   ' close db - DB schließen
   DB.close()
   Println()
   Println("Close DB")

   Println()
   Println("Enter ends the programm")
   Readln()  
   Exit Sub

ErrOut:
   MsgBox Err.toString()
End Sub

Public Sub CreatePilots()
   pilot1.Name = "Michael Schumacher"
   pilot1.Points = 100
   Println(pilot1.toString())
  
   pilot2.Name = "Rubens Barricello"
   pilot2.Points = 90
   Println(pilot2.toString())
End Sub

Sub StorePilots()
   DB.set(pilot1)
   Println(pilot1.toString())
   DB.set(pilot2)
   Println(pilot2.toString())
End Sub

Sub FindPilotsByName(name As String)
   proto.Name = name
   proto.Points = 0   
   osResult = DB.get(proto)
   Println()
   ListResult(osResult)
End Sub

Sub FindPilotsByPoints(points As Integer)
   proto.Name = Null
   proto.Points = points   
   osResult = DB.get(proto)
   Println()
   ListResult(osResult)   
End Sub

Sub UpdatePilotsByName(name As String, points As Integer)
   proto.Name = name
   proto.Points = 0   
   osResult = DB.get(proto)   
   Do While osResult.hasNext()
  p = Cast(osResult.next(), Pilot)
  p.AddPoints(points)  
  DB.set(p)
  Println(points & " points added to " + p.Name)
   Loop
End Sub

Sub DeletePilotsByName(name As String)
   proto.Name = name
   proto.Points = 0
   osResult = DB.get(proto)
   Do While osResult.hasNext()
  p = Cast(osResult.next(), Pilot)
  DB.delete(p)
  Println(p.Name & " deleted")
   Loop
End Sub

Sub DeletePilotsByPoints(points As Integer)
   proto.Name = Null
   proto.Points = points
   osResult = DB.get(proto)
   Do While osResult.hasNext()
  p = Cast(osResult.next(), Pilot)
  DB.delete(p)
  Println(p.toString() & " deleted")
   Loop
End Sub

Sub ListResult(oSet As com#db4o#ObjectSet)
   Dim p As Pilot
   Println(oSet.size() & " Objekte in der DB.")
   Do While oSet.hasNext()
  p = Cast(oSet.next(), Pilot)
  Println(p.toString())
   Loop
End Sub

Sub Println(Optional text As String)
   system.out.println(text)
End Sub

Function Readln()
   Readln = system.in.read()
End Function

Jabaco Source

Private m_name As String
Private m_points As Integer

Public Property Get Name() As String
   Name = m_name
End Property

Public Property Let Name(value As String)
   m_name = value
End Property

Public Property Get Points() As String
   Points = m_points
End Property

Public Property Let Points(value As Integer)
   m_points = value
End Property

Public Sub AddPoints(value As Integer)
   m_points = m_points + value
End Sub

Public Function toString()
   toString = m_name & " / " & m_points
End Function