Sub ButFirst_Click () JUMP_FIRST_Click End Sub Sub ButLast_Click () JUMP_LAST_Click End Sub Sub ButNext_Click () JUMP_NEXT_Click End Sub Sub ButPrev_Click () JUMP_PREV_Click End Sub Sub EDIT_DELETE_Click () Dim Res As Integer, Status As Integer Record.Vorname = VName.Text Record.name = NName.Text Record.Straße = Straße.Text Record.Plz = Plz.Text Record.Ort = Ort.Text Record.Telefon = Telefon.Text If (Record.address <> 0) Then Res = db_reclock(Db, Record.address) Res = db_delete(Db, TBL_LEUTE, Record.address, Status) Res = TestBase(Db) End If VName.Text = "" NName.Text = "" Straße.Text = "" Plz.Text = "" Ort.Text = "" Telefon.Text = "" End Sub Sub EDIT_FIND_Click () Dim Res As Integer Record.name = NName.Text Record.Plz = Plz.Text Record.Ort = Ort.Text If SearchIndex <> 0 Then If db_search(Db, TBL_LEUTE, SearchIndex, ASCENDING, DbCursor, Record, 0) = 0 Then MsgBox "Datensatz '" & SearchString & "' nicht gefunden!", 48, Title End If Res = ReadAndGetLeute(Record) End If Res = TestBase(Db) End Sub Sub EDIT_INSERT_Click () Dim Res As Integer, Status As Integer Res = SetAndInsertLeute(Record, Status) VName.Text = "" NName.Text = "" Straße.Text = "" Plz.Text = "" Ort.Text = "" Telefon.Text = "" End Sub Sub EDIT_NEW_Click () VName.Text = "" NName.Text = "" Straße.Text = "" Plz.Text = "" Ort.Text = "" Telefon.Text = "" Record.address = 0 End Sub Sub EDIT_UPDATE_Click () Dim Res As Integer, Status As Integer Res = SetAndUpdateLeute(Record, Status) End Sub Sub FILE_CLOSE_Click () Dim Res As Integer If Db <> 0 Then db_freecursor Db, DbCursor Res = db_close(Db) FILE_CLOSE.Caption = "&Öffnen" Db = 0 ED.Enabled = False JUMP.Enabled = False INFO_TABLE.Enabled = False ButFirst.Enabled = False ButPrev.Enabled = False ButLast.Enabled = False ButNext.Enabled = False VName.Text = "" NName.Text = "" Straße.Text = "" Plz.Text = "" Ort.Text = "" Telefon.Text = "" Record.address = 0 Else Db = db_open(basename, basepath, OpenFlags, OpenCache, OpenDbCursors, username, password) Res = TestBase(Db) If Db = 0 Then MsgBox "Das Programm wird beendet.", 16, Title End Else DbCursor = db_newcursor(Db) FILE_CLOSE.Caption = "&Schließen" ED.Enabled = True JUMP.Enabled = True JUMP_FIRST_Click End If End If End Sub Sub FILE_QUIT_Click () Dim Res As Integer If Db <> 0 Then Beep Res = MsgBox("Soll die Datenbank geschlossen und das Programm verlassen werden?", 36, Title) If Res = 6 Then Res = db_close(Db) End End If Else End End If End Sub Sub FILE_REORG_Click () Dim I As Integer, Ret As Integer Dim reorgresult As REORG_RESULT Screen.MousePointer = 11 ' Busy ED.Enabled = False JUMP.Enabled = False INFO_TABLE.Enabled = False ButFirst.Enabled = False ButPrev.Enabled = False ButLast.Enabled = False ButNext.Enabled = False If Db <> 0 Then Ret = db_close(Db) Db = 0 End If Ret = db_reorg(basename, basepath, OpenCache, False, 0&, reorgresult) If Ret = False Then Ret = TestBase(Db) Else Db = db_open(basename, basepath, OpenFlags, OpenCache, OpenDbCursors, username, password) Ret = TestBase(Db) If Db = 0 Then MsgBox "Das Programm wird beendet.", 16, Title End Else DbCursor = db_newcursor(Db) Screen.MousePointer = 0 ' Default FILE_CLOSE.Caption = "&Schließen" ED.Enabled = True JUMP.Enabled = True JUMP_FIRST_Click MsgBox "Datenbank erfolgreich reorganisiert und wieder geöffnet.", 64, Title End If End If End Sub Sub Form_Load () Dim Res As Integer Record.address = 0 basepath = App.Path basename = "LEUTE" If Right$(basepath, 1) <> "\" Then ' if not the root path basepath = basepath + "\" End If Db = db_open(basename, basepath, OpenFlags, OpenCache, OpenDbCursors, username, password) Res = TestBase(Db) If Db = 0 Then MsgBox "Das Programm wird beendet.", 16, Title End Else DbCursor = db_newcursor(Db) JUMP_FIRST_Click End If End Sub Sub Form_Unload (Cancel As Integer) Dim Ret As Integer If Db <> 0 Then Ret = db_close(Db) End If End End Sub Sub INFO_INFO_Click () InfoForm.Show 1 End Sub Sub INFO_TABLE_Click () TableInfoForm.Show 1 End Sub Sub JUMP_FIRST_Click () Dim Res As Integer If db_initcursor(Db, TBL_LEUTE, 1, ASCENDING, DbCursor) Then If db_movecursor(Db, DbCursor, 1) Then Res = ReadAndGetLeute(Record) End If End If Res = TestBase(Db) End Sub Sub JUMP_LAST_Click () Dim Res As Integer If db_initcursor(Db, TBL_LEUTE, 1, DESCENDING, DbCursor) Then If db_movecursor(Db, DbCursor, -1) Then Res = ReadAndGetLeute(Record) End If End If Res = TestBase(Db) End Sub Sub JUMP_NEXT_Click () Dim Res As Integer If db_movecursor(Db, DbCursor, 1) Then Res = ReadAndGetLeute(Record) End If Res = TestBase(Db) End Sub Sub JUMP_PREV_Click () Dim Res As Integer If db_movecursor(Db, DbCursor, -1) Then Res = ReadAndGetLeute(Record) End If Res = TestBase(Db) End Sub Sub NName_Change () If SearchIndex = 1 Then SearchString = NName.Text End If End Sub Sub NName_GotFocus () SearchIndex = 1 SearchString = NName.Text SelLine NName End Sub Sub Ort_Change () If SearchIndex = 3 Then SearchString = Ort.Text End If End Sub Sub Ort_GotFocus () SearchIndex = 3 SearchString = Ort.Text SelLine Ort End Sub Sub Plz_Change () If SearchIndex = 2 Then SearchString = Plz.Text End If End Sub Sub Plz_GotFocus () SearchIndex = 2 SearchString = Plz.Text SelLine Plz End Sub Function ReadAndGetLeute (Record As LEUTE) As Integer Dim Ret As Integer, Res As Integer Ret = db_read(Db, TBL_LEUTE, DbBuffer(0), DbCursor, 0, False) If Ret <> False Then Record.address = DbBuffer(0) 'set DbAddress Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_VORNAME, DbBuffer(0), Record.Vorname) Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_NAME, DbBuffer(0), Record.name) Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_STRASSE, DbBuffer(0), Record.Straße) Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_PLZ, DbBuffer(0), Record.Plz) Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_ORT, DbBuffer(0), Record.Ort) Res = db_getstr(Db, TBL_LEUTE, COL_LEUTE_TELEFON, DbBuffer(0), Record.Telefon) VName.Text = Record.Vorname NName.Text = Record.name Straße.Text = Record.Straße Plz.Text = Record.Plz Ort.Text = Record.Ort Telefon.Text = Record.Telefon TestFirstLast Db, DbCursor End If Res = TestBase(Db) ReadAndGetLeute = Ret End Function Function SetAndInsertLeute (Record As LEUTE, Status As Integer) As Integer Dim Ret As Integer, Res As Integer Record.Vorname = VName.Text Record.name = NName.Text Record.Straße = Straße.Text Record.Plz = Plz.Text Record.Ort = Ort.Text Record.Telefon = Telefon.Text Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_VORNAME, DbBuffer(0), Record.Vorname) Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_NAME, DbBuffer(0), Record.name) Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_STRASSE, DbBuffer(0), Record.Straße) Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_PLZ, DbBuffer(0), Record.Plz) Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_ORT, DbBuffer(0), Record.Ort) Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_TELEFON, DbBuffer(0), Record.Telefon) Ret = db_insert(Db, TBL_LEUTE, DbBuffer(0), Status) Res = TestBase(Db) Record.address = DbBuffer(0) 'set DbAddress SetAndInsertLeute = Ret End Function Function SetAndUpdateLeute (Record As LEUTE, Status As Integer) As Integer Dim Ret As Integer, Res As Integer Record.Vorname = VName.Text Record.name = NName.Text Record.Straße = Straße.Text Record.Plz = Plz.Text Record.Ort = Ort.Text Record.Telefon = Telefon.Text Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_VORNAME, DbBuffer(0), Record.Vorname) Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_NAME, DbBuffer(0), Record.name) Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_STRASSE, DbBuffer(0), Record.Straße) Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_PLZ, DbBuffer(0), Record.Plz) Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_ORT, DbBuffer(0), Record.Ort) Res = db_setstr(Db, TBL_LEUTE, COL_LEUTE_TELEFON, DbBuffer(0), Record.Telefon) If (Record.address <> 0) Then Res = db_reclock(Db, Record.address) Ret = db_update(Db, TBL_LEUTE, DbBuffer(0), Status) Res = TestBase(Db) End If SetAndUpdateLeute = Ret End Function Sub Straße_GotFocus () SelLine Straße End Sub Sub Telefon_GotFocus () SelLine Telefon End Sub Sub TestFirstLast (Db As Long, DbCursor As Long) Dim FirstLast As Integer If (db_isfirst(Db, DbCursor) = 0) Then FirstLast = True Else FirstLast = False End If ButFirst.Enabled = FirstLast JUMP_FIRST.Enabled = FirstLast ButPrev.Enabled = FirstLast JUMP_PREV.Enabled = FirstLast If (db_islast(Db, DbCursor) = 0) Then FirstLast = True Else FirstLast = False End If ButLast.Enabled = FirstLast JUMP_LAST.Enabled = FirstLast ButNext.Enabled = FirstLast JUMP_NEXT.Enabled = FirstLast End Sub Sub VName_GotFocus () SelLine VName End Sub