Database Using Binary File

BackupUser · Post by **BackupUser** » Wed Oct 23, 2002 9:56 pm

Restored from previous forum. Originally posted by Berikco.

Here a simple example how to use a binary file to store records.
Routine to compact database not yet included...

Code: Select all

; Simple dataBase snippet with binary file; By Berikco
;
;


Structure Record
  Deleted.l
  Locked.l
  Naam.b[50]
  Straat.b[50]
  Nummer.b[6]
  PostNr.b[6]
  Stad.b[40]
EndStructure

Structure DbHeader
  Numrecords.l
  NumDeleted.l
  RecordLen.l
EndStructure

Global RecBuf.Record
Global Header.DbHeader

Header\RecordLen=SizeOf(Record)

#DataBase="PBaseIV.dat"
If FileSize(#DataBase)>0
  OpenFile(1,#DataBase)
  ReadData(@Header,SizeOf(DBHeader))
  CloseFile(1)
Else
  CreateFile(1,#DataBase)
  WriteData(@Header,SizeOf(DBHeader))
  CloseFile(1)
EndIf


Global Hwnd, Activ, Wit, Selected, Current
Current=-1
Hwnd=OpenWindow(0,100,150,600,400,#PB_Window_SystemMenu,"PBase IV")


Activ = CreateSolidBrush_($D3FAFF)
Wit=CreateSolidBrush_($FFFFFF)

Procedure myCallback(WindowID, Message, wParam, lParam)
  Result = #PB_ProcessPureBasicEvents
  Select Message
  Case #WM_CTLCOLOREDIT
    Select lparam
    Case GadgetID(selected)
      SetBkMode_(wParam,#TRANSPARENT)
      Result = Activ
    EndSelect
  EndSelect
  ProcedureReturn Result
EndProcedure

Procedure clear_record()
  For r=0 To SizeOf(Record)-1
    PokeB(@RecBuf\Deleted+r,0)
  Next r
EndProcedure

Procedure Update()
  If RecBuf\Deleted=1
    clear_record()
    RecBuf\Deleted=1
  EndIf
  
  SetGadgetText(11,PeekS(@RecBuf\Naam[0]))
  SetGadgetText(12,PeekS(@RecBuf\Straat[0]))
  SetGadgetText(13,PeekS(@RecBuf\Nummer[0]))
  SetGadgetText(14,PeekS(@RecBuf\PostNr[0]))
  SetGadgetText(15,PeekS(@RecBuf\Stad[0]))
  
  SetGadgetText(30,"Records: "+Str(Header\Numrecords))
  SetGadgetText(31,"Deleted: "+Str(Header\NumDeleted))
  SetGadgetText(32,"DelFlag: "+Str(RecBuf\Deleted))
EndProcedure

If hwnd
  SetWindowCallback(@myCallback())
  CreateGadgetList(Hwnd)
  TextGadget(1, 10, 10, 60, 18, "Naam",#PB_Text_Right)
  TextGadget(2, 10, 30, 60, 18, "Straat",#PB_Text_Right)
  TextGadget(3, 300, 30, 60, 18, "Nummer",#PB_Text_Right)
  TextGadget(4, 10, 50, 60, 18, "PostNr",#PB_Text_Right)
  TextGadget(5, 100, 50, 60, 18, "Stad",#PB_Text_Right)
  
  StringGadget(11, 75, 10, 390, 18, "")
  StringGadget(12, 75, 30, 240, 18, "")
  StringGadget(13, 365, 30, 60, 18, "")
  StringGadget(14, 75, 50, 60, 18, "")
  StringGadget(15, 165, 50, 300, 18, "")
  
  ButtonGadget(21, 10, 180, 80, 25, "" )
  ButtonGadget(23, 170, 180, 80, 25, "Add" )
  ButtonGadget(24, 250, 180, 80, 25, "Delete" )
  ButtonGadget(25, 330, 180, 80, 25, "New" )
  
  TextGadget(30, 500, 10, 60, 18, "")
  TextGadget(31, 500, 30, 60, 18, "")
  TextGadget(32, 500, 50, 60, 18, "")
  
  update()
  Repeat
    Evt= WaitWindowEvent()
    If Evt = #PB_EventGadget
      Selected = EventGadgetID()
      
      If selected > 10 And selected  selected
          sendmessage_(GadgetID(selected),#WM_SIZE,0,0)
          If oldselection
            sendmessage_(GadgetID(oldselection),#WM_SIZE,0,0)
          EndIf
          oldselection=selected
        EndIf
      Else
        Select selected
        Case 21 ; 0
            If OpenFile(1,#DataBase)
              Current-1
              FileSeek(SizeOf(DBHeader)+Current*SizeOf(Record))
              ReadData(@RecBuf,SizeOf(Record))
              CloseFile(1)
              update()
            EndIf
          EndIf
        Case 22 ; >
          If  Current =0
            If OpenFile(1,#DataBase)
              RecBuf\Deleted=1  ; Set Deleted Flag
              a$=Left(GetGadgetText(11),49)
              CopyMemory(@a$,@RecBuf\Naam[0],Len(a$))
              a$=Left(GetGadgetText(12),49)
              CopyMemory(@a$,@RecBuf\Straat[0],Len(a$))
              a$=Left(GetGadgetText(13),5)
              CopyMemory(@a$,@RecBuf\Nummer[0],Len(a$))
              a$=Left(GetGadgetText(14),5)
              CopyMemory(@a$,@RecBuf\PostNr[0],Len(a$))
              a$=Left(GetGadgetText(15),39)
              CopyMemory(@a$,@RecBuf\Stad[0],Len(a$))
              
              FileSeek(SizeOf(DBHeader)+Current*SizeOf(Record))
              WriteData(@RecBuf,SizeOf(Record))
              
              Header\RecordLen=SizeOf(Record)
              Header\Numrecords-1
              Header\NumDeleted+1
              FileSeek(0)
              WriteData(@Header,SizeOf(DBHeader))
              CloseFile(1)
              update()
            EndIf
          EndIf
        Case 25 ; new
          clear_record()
          update()
          
        EndSelect
      EndIf
    EndIf
  Until Evt = #PB_EventCloseWindow
EndIf
End

Regards,

Berikco

http://www.benny.zeb.be

BackupUser · Post by **BackupUser** » Thu Oct 24, 2002 7:36 am

Restored from previous forum. Originally posted by Rings.

good work berikco!
(i 've noticed that you code for a longer time)

Its a long way to the top if you wanna .....CodeGuru

BackupUser · Post by **BackupUser** » Thu Oct 24, 2002 9:49 am

Restored from previous forum. Originally posted by Berikco.

Originally posted by Rings

good work berikco!
(i 've noticed that you code for a longer time)

Yep, i'm coding since 1985, there was absolutely zero database support in a programming language those days
So programmer had to do everyting himself, creating index files for fast searching, compacting database, search routines, etc...
http://www.benny.zeb.be/biography.htm

Regards,

Berikco

http://www.benny.zeb.be

BackupUser · Post by **BackupUser** » Thu Oct 24, 2002 11:47 am

Restored from previous forum. Originally posted by fred.

To gain even more in speed and compactness, you can use PokeS() instead of CopyMemory()

.

Fred - AlphaSND

BackupUser · Post by **BackupUser** » Fri Oct 25, 2002 1:17 am

Restored from previous forum. Originally posted by Fangbeast.

Thanks to Bericko, my programs are about to get better. I have reworded his example in English, used constants, stripped the colourising sections and added extra flags/routines where I needed them and any/all procedures and gosubs for speed. I won't explain what I did, all you expert programmers will know far better than me from the code below:):)

Code: Select all

; Simple dataBase snippet with binary file
; By Berikco
;
;
; Additions, changes and errors by FangBeast/FarDarker (25/10/2002)
;- Structures ---------------------------------------------------------------------------

Structure record
  deleted.l
  locked.l
  name.b[50]
  street.b[50]
  number.b[6]
  postcode.b[6]
  state.b[40]
EndStructure

Structure dbheader
  numrecords.l
  numdeleted.l
  recordlen.l
EndStructure

;- global data --------------------------------------------------------------------------

Global recbuf.record, header.dbheader, hwnd, current

;- precalculated variables --------------------------------------------------------------

header\recordlen = sizeof(record)

;- constants ----------------------------------------------------------------------------

#database = "pbaseiv.dat"

#forward = 1
#backward = 2
#first = 3
#last = 4

#addrec = 5
#newrec = 6
#delrec = 7
#updrec = 8

#namelabel = 10
#streetlabel = 11
#numberlabel = 12
#postcodelabel = 13
#statelabel = 14

#name = 15
#street = 16
#number = 17
#postcode = 18
#state = 19

#records = 20
#delrecd = 21
#delflag = 22
#recnum = 23

;- open the database or create it if it doesn't exist -----------------------------------

If FileSize(#database) > 0
  OpenFile(1, #database)
  ReadData(@header, SizeOf(dbheader))
  CloseFile(1)
Else
  CreateFile(1, #database)
  WriteData(@header, SizeOf(dbheader))
  CloseFile(1)
EndIf

;- current record pointer ---------------------------------------------------------------

current = - 1

;- open the program window --------------------------------------------------------------

hwnd = OpenWindow(0, 100, 180, 560, 140, #pb_window_systemmenu, "pbase iv")

  CreateGadgetList(hwnd)

  TextGadget(#namelabel, 10, 10, 60, 18, "name", #pb_text_right)
  TextGadget(#streetlabel, 10, 30, 60, 18, "street", #pb_text_right)
  TextGadget(#numberlabel, 300, 30, 60, 18, "number", #pb_text_right)
  TextGadget(#postcodelabel, 10, 50, 60, 18, "pcode", #pb_text_right)
  TextGadget(#statelabel, 100, 50, 60, 18, "state", #pb_text_right)

  StringGadget(#name, 75, 10, 390, 18, "")
  StringGadget(#street, 75, 30, 240, 18, "")
  StringGadget(#number, 365, 30, 60, 18, "")
  StringGadget(#postcode, 75, 50, 60, 18, "")
  StringGadget(#state, 165, 50, 300, 18, "")

  ButtonGadget(#backward, 40, 100, 40, 25, "")
  ButtonGadget(#first, 120, 100, 40, 25, ">")
  
  ButtonGadget(#addrec, 224, 100, 60, 25, "Add")
  ButtonGadget(#delrec, 284, 100, 60, 25, "Delete")
  ButtonGadget(#newrec, 344, 100, 60, 25, "New")
  ButtonGadget(#updrec, 404, 100, 60, 25, "Update")

  TextGadget(#records, 500, 10, 60, 18, "")
  TextGadget(#delrecd, 500, 30, 60, 18, "")
  TextGadget(#delflag, 500, 50, 60, 18, "")
  TextGadget(#recnum,  500, 70, 60, 18, "")

  DisableGadget(#addrec, 1)
  
  Gosub update
  Gosub firstrecord
  
  Repeat
  
    eventid =  WaitWindowEvent()
    
    If eventid  =  #pb_eventgadget
    
        Select EventGadgetID()
        ;--------------------------------------------------------------------------------
        Case #backward  : Gosub backwards
        Case #first     : Gosub firstrecord
        Case #forward   : Gosub forwards
        Case #last      : Gosub lastrecord
        ;--------------------------------------------------------------------------------
        Case #addrec    : Gosub addrecord
        Case #delrec    : Gosub deleterecord
        Case #newrec    : Gosub newrecord
        Case #updrec    : Gosub updaterecord
        ;--------------------------------------------------------------------------------
        EndSelect
    EndIf
  Until eventid  =  #pb_eventclosewindow
End

;- update a record's details ------------------------------------------------------------

update:

  If recbuf\deleted = 1
    For r = 0 To SizeOf(record) - 1
      PokeB(@recbuf\deleted + r, 0)
    Next r
    recbuf\deleted = 1
  EndIf

  SetGadgetText(#name, PeekS(@recbuf\name[0]))
  SetGadgetText(#street, PeekS(@recbuf\street[0]))
  SetGadgetText(#number, PeekS(@recbuf\number[0]))
  SetGadgetText(#postcode, PeekS(@recbuf\postcode[0]))
  SetGadgetText(#state, PeekS(@recbuf\state[0]))

  SetGadgetText(#records, "records: " + Str(header\numrecords))
  SetGadgetText(#delrecd, "deleted: " + Str(header\numdeleted))
  SetGadgetText(#delflag, "delflag: " + Str(recbuf\deleted))
  SetGadgetText(#recnum,  "Recnum : " + Str(current))

Return

;- Go backwards one record --------------------------------------------------------------

backwards:

  If current > 0
    If OpenFile(1, #database)
      DisableGadget(#addrec, 1)
      current - 1
      FileSeek(SizeOf(dbheader) + current * SizeOf(record))
      ReadData(@recbuf, SizeOf(record))
      CloseFile(1)
      Gosub update
    EndIf
  EndIf
  
Return

;- Go forwards one record ---------------------------------------------------------------

forwards:
        
  If  current  = 0
    If OpenFile(1, #database)
      DisableGadget(#addrec, 1)               ; Disable add until new is clicked again
      recbuf\deleted = 1                      ; Set deleted flag
              
      a$ = Left(GetGadgetText(#name), 49)     : CopyMemory(@a$, @recbuf\name[0], Len(a$))
      a$ = Left(GetGadgetText(#street), 49)   : CopyMemory(@a$, @recbuf\street[0], Len(a$))
      a$ = Left(GetGadgetText(#number), 5)    : CopyMemory(@a$, @recbuf\number[0], Len(a$))
      a$ = Left(GetGadgetText(#postcode), 5)  : CopyMemory(@a$, @recbuf\postcode[0], Len(a$))
      a$ = Left(GetGadgetText(#state), 39)    : CopyMemory(@a$, @recbuf\state[0], Len(a$))

      FileSeek(SizeOf(dbheader) + current * SizeOf(record))
      WriteData(@recbuf, SizeOf(record))

      header\recordlen = SizeOf(record)
      header\numrecords - 1
      header\numdeleted + 1
      FileSeek(0)
      WriteData(@header, SizeOf(dbheader))
      CloseFile(1)
      Gosub update
    EndIf
  EndIf

Return

;- Update the current visible record and reset it's deleted status if deleted -----------

updaterecord:

  If OpenFile(1, #database)

    DisableGadget(#addrec, 1)                 ; Disable add until new is clicked again

    a$ = Left(GetGadgetText(#name), 49)       : CopyMemory(@a$, @recbuf\name[0], Len(a$))
    a$ = Left(GetGadgetText(#street), 49)     : CopyMemory(@a$, @recbuf\street[0], Len(a$))
    a$ = Left(GetGadgetText(#number), 5)      : CopyMemory(@a$, @recbuf\number[0], Len(a$))
    a$ = Left(GetGadgetText(#postcode), 5)    : CopyMemory(@a$, @recbuf\postcode[0], Len(a$))
    a$ = Left(GetGadgetText(#state), 39)      : CopyMemory(@a$, @recbuf\state[0], Len(a$))

    FileSeek(SizeOf(dbheader) + current * SizeOf(record))
    WriteData(@recbuf, SizeOf(record))        ; Write the record to disk

    header\recordlen = SizeOf(record)         ; Compute the length of the record
    
    If recbuf\deleted = 1                     ; If we update a deleted record, change status to undeleted
      recbuf\deleted = 0                      ;
      header\numrecords + 1                   ; Add it back to live record status
      header\numdeleted - 1                   ; Subtract one from the number of deleted records
    EndIf
    
    FileSeek(0)                               ; Seek to the start of the file
           
    WriteData(@header, SizeOf(dbheader))      ; Write the header details (file length, records)
            
    CloseFile(1)                              ; Close the file
            
    For r = 0 To SizeOf(record) - 1          ; Clear the record buffer
      PokeB(@recbuf\deleted + r, 0)
    Next r
            
    Gosub update                             ; Update the current record display
    
Return

;- Create a new, blank record field -----------------------------------------------------

newrecord:

  DisableGadget(#addrec, 0)
  
  For r = 0 To SizeOf(record) - 1
    PokeB(@recbuf\deleted + r, 0)
  Next r
  
  Gosub update

Return

Fangles woz ear orright den?

BackupUser · Post by **BackupUser** » Fri Oct 25, 2002 1:29 am

Restored from previous forum. Originally posted by Franco.

Well done Fangles

Only one thing:
The Subroutine 'updaterecord' is not finished.
'EndIf' is missing (can't compile without it).

Have a nice day...

Franco

BackupUser · Post by **BackupUser** » Fri Oct 25, 2002 2:31 am

Restored from previous forum. Originally posted by Fangbeast.

Originally posted by Franco

Well done Fangles

Only one thing:
The Subroutine 'updaterecord' is not finished.
'EndIf' is missing (can't compile without it).

Have a nice day...

Franco

Like the code header said ; Additions, changes and errors by FangBeast/FarDarker (25/10/2002)

MUAHAHAHAHAH

:)

Fangles woz ear orright den?

BackupUser · Post by **BackupUser** » Fri Oct 25, 2002 7:54 am

Restored from previous forum. Originally posted by Fangbeast.

To answer my last post, I fixed a heap of bugs that I introduced. Record counters (live and deleted now work. I can update previous records and brind deleted records back from the dead. I still need a compact routine and a 'skip deleted records from display' flag

Code: Select all

; Simple dataBase snippet with binary file
; By Berikco
;
;
; Additions, changes and errors by FangBeast/FarDarker (25/10/2002)
;- Structures -------------------------------------------------------------------------------------

Structure record
  deleted.l
  locked.l
  name.b[50]
  street.b[50]
  number.b[6]
  postcode.b[6]
  state.b[40]
EndStructure

Structure dbheader
  numrecords.l
  numdeleted.l
  recordlen.l
EndStructure

;- global data ------------------------------------------------------------------------------------

Global recbuf.record, header.dbheader, hwnd, current

;- precalculated variables ------------------------------------------------------------------------

header\recordlen = SizeOf(record)

;- constants --------------------------------------------------------------------------------------

#database = "pbaseiv.dat"

#forward = 1
#backward = 2
#first = 3
#last = 4

#addrec = 5
#newrec = 6
#delrec = 7
#updrec = 8

#namelabel = 10
#streetlabel = 11
#numberlabel = 12
#postcodelabel = 13
#statelabel = 14

#name = 15
#street = 16
#number = 17
#postcode = 18
#state = 19

#records = 20
#delrecd = 21
#delflag = 22
#recnum = 23

;- open the database or create it if it doesn't exist ---------------------------------------------

If FileSize(#database) > 0
  OpenFile(1, #database)
  ReadData(@header, SizeOf(dbheader))
  CloseFile(1)
Else
  CreateFile(1, #database)
  WriteData(@header, SizeOf(dbheader))
  CloseFile(1)
EndIf

;- current record pointer -------------------------------------------------------------------------

current = - 1

;- open the program window ------------------------------------------------------------------------

hwnd = OpenWindow(0, 100, 180, 560, 140, #pb_window_systemmenu, "pbase iv")

  CreateGadgetList(hwnd)

  TextGadget(#namelabel, 10, 10, 60, 18, "name", #pb_text_right)
  TextGadget(#streetlabel, 10, 30, 60, 18, "street", #pb_text_right)
  TextGadget(#numberlabel, 300, 30, 60, 18, "number", #pb_text_right)
  TextGadget(#postcodelabel, 10, 50, 60, 18, "pcode", #pb_text_right)
  TextGadget(#statelabel, 100, 50, 60, 18, "state", #pb_text_right)

  StringGadget(#name, 75, 10, 390, 18, "")
  StringGadget(#street, 75, 30, 240, 18, "")
  StringGadget(#number, 365, 30, 60, 18, "")
  StringGadget(#postcode, 75, 50, 60, 18, "")
  StringGadget(#state, 165, 50, 300, 18, "")

  ButtonGadget(#backward, 40, 100, 40, 25, "")
  ButtonGadget(#first, 120, 100, 40, 25, ">")
  
  ButtonGadget(#addrec, 224, 100, 60, 25, "Add")
  ButtonGadget(#delrec, 284, 100, 60, 25, "Delete")
  ButtonGadget(#newrec, 344, 100, 60, 25, "New")
  ButtonGadget(#updrec, 404, 100, 60, 25, "Update")

  TextGadget(#records, 480, 10, 60, 18, "")
  TextGadget(#delrecd, 480, 30, 60, 18, "")
  TextGadget(#delflag, 480, 50, 60, 18, "")
  TextGadget(#recnum,  480, 70, 60, 18, "")

  DisableGadget(#addrec, 1)
  
  Gosub firstrecord
  Gosub update
  
  Repeat
  
    eventid =  WaitWindowEvent()
    
    If eventid  =  #pb_eventgadget
    
        Select EventGadgetID()
        ;------------------------------------------------------------------------------------------
        Case #backward  : Gosub backwards
        Case #first     : Gosub firstrecord
        Case #forward   : Gosub forwards
        Case #last      : Gosub lastrecord
        ;------------------------------------------------------------------------------------------
        Case #addrec    : Gosub addrecord
        Case #delrec    : Gosub deleterecord
        Case #newrec    : Gosub newrecord
        Case #updrec    : Gosub updaterecord
        ;------------------------------------------------------------------------------------------
        EndSelect
    EndIf
  Until eventid  =  #pb_eventclosewindow
End

;- update a record's details ----------------------------------------------------------------------

update:

  If recbuf\deleted = 1
    For r = 0 To SizeOf(record) - 1                       ; Must start at 0 and end at record - 1
      PokeB(@recbuf\deleted + r, 0)                        ; Poke 0's at position (r)
    Next r
    recbuf\deleted = 1
  EndIf

  SetGadgetText(#name, PeekS(@recbuf\name[0]))
  SetGadgetText(#street, PeekS(@recbuf\street[0]))
  SetGadgetText(#number, PeekS(@recbuf\number[0]))
  SetGadgetText(#postcode, PeekS(@recbuf\postcode[0]))
  SetGadgetText(#state, PeekS(@recbuf\state[0]))

  SetGadgetText(#records, "records: " + Str(header\numrecords))
  SetGadgetText(#delrecd, "deleted: " + Str(header\numdeleted))
  SetGadgetText(#delflag, "delflag: " + Str(recbuf\deleted))
  SetGadgetText(#recnum,  "recnum : " + Str(current))

Return

;- Go backwards one record ------------------------------------------------------------------------

backwards:

  If current > 0
    If OpenFile(1, #database)
      DisableGadget(#addrec, 1)
      current - 1
      FileSeek(SizeOf(dbheader) + current * SizeOf(record))
      ReadData(@recbuf, SizeOf(record))
      CloseFile(1)
      Gosub update
    EndIf
  EndIf
  
Return

;- Go forwards one record -------------------------------------------------------------------------

forwards:
        
  If  current  = 0
    If OpenFile(1, #database)
      DisableGadget(#addrec, 1)               ; Disable add until new is clicked again
      ;--------------------------------------------------------------------------------------------
      FileSeek(0)
      
      FileSeek(SizeOf(dbheader) + current * SizeOf(record))
      
      If recbuf\deleted = 1
        CloseFile(1)
        Return
      EndIf
      ;--------------------------------------------------------------------------------------------
      a$ = Left(GetGadgetText(#name), 49)     : CopyMemory(@a$, @recbuf\name[0], Len(a$))
      a$ = Left(GetGadgetText(#street), 49)   : CopyMemory(@a$, @recbuf\street[0], Len(a$))
      a$ = Left(GetGadgetText(#number), 5)    : CopyMemory(@a$, @recbuf\number[0], Len(a$))
      a$ = Left(GetGadgetText(#postcode), 5)  : CopyMemory(@a$, @recbuf\postcode[0], Len(a$))
      a$ = Left(GetGadgetText(#state), 39)    : CopyMemory(@a$, @recbuf\state[0], Len(a$))

      recbuf\deleted = 1                      ; Set deleted flag

      FileSeek(SizeOf(dbheader) + current * SizeOf(record))

      WriteData(@recbuf, SizeOf(record))
      ;--------------------------------------------------------------------------------------------
      header\recordlen = SizeOf(record)       ; Size of the record
      header\numrecords - 1                   ; How many live records there are
      header\numdeleted + 1                   ; How many deleted records there are
      FileSeek(0)                             ; Go to start of file
      WriteData(@header, SizeOf(dbheader))    ; Write the new header data
      CloseFile(1)                            ; Close the file
      Gosub update                           ; Update the screen
    EndIf
  EndIf

Return

;- Update the current visible record and reset it's deleted status if deleted ---------------------

updaterecord:

  If OpenFile(1, #database)

    DisableGadget(#addrec, 1)                 ; Disable add until new is clicked again

    a$ = Left(GetGadgetText(#name), 49)       : CopyMemory(@a$, @recbuf\name[0], Len(a$))
    a$ = Left(GetGadgetText(#street), 49)     : CopyMemory(@a$, @recbuf\street[0], Len(a$))
    a$ = Left(GetGadgetText(#number), 5)      : CopyMemory(@a$, @recbuf\number[0], Len(a$))
    a$ = Left(GetGadgetText(#postcode), 5)    : CopyMemory(@a$, @recbuf\postcode[0], Len(a$))
    a$ = Left(GetGadgetText(#state), 39)      : CopyMemory(@a$, @recbuf\state[0], Len(a$))

    If recbuf\deleted = 1                     ; If we update a deleted record, change status to undeleted
      recbuf\deleted = 0                      ;
      header\numdeleted - 1                   ; Subtract one from the number of deleted records  
      header\numrecords + 1                    ; Add it back to live record status
    EndIf

    FileSeek(SizeOf(dbheader) + current * SizeOf(record))
    WriteData(@recbuf, SizeOf(record))        ; Write the record to disk

    header\recordlen = SizeOf(record)         ; Compute the length of the record

    FileSeek(0)                               ; Seek to the start of the file
           
    WriteData(@header, SizeOf(dbheader))      ; Write the header details (file length, records)
            
    CloseFile(1)                              ; Close the file
            
;    For r = 0 To SizeOf(record) - 1          ; Clear the record buffer
;      PokeB(@recbuf\deleted + r, 0)
;    Next r
  
  EndIf
  
    Gosub update                             ; Update the current record display
    
Return

;- Create a new, blank record field ---------------------------------------------------------------

newrecord:

  DisableGadget(#addrec, 0)
  
  For r = 0 To SizeOf(record) - 1
    PokeB(@recbuf\deleted + r, 0)
  Next r
  
  Gosub update

Return

Fangles woz ear orright den?

BackupUser · Post by **BackupUser** » Fri Oct 25, 2002 4:52 pm

Restored from previous forum. Originally posted by Midebor.

Thanks for the code.
There is a problem with the update button:
- cerrecting a previously entered record in the middle of the string
works fine with update button

- if the correction consists in deleting the last character of a previously entered info, update shows the deleted character again...

BackupUser · Post by **BackupUser** » Fri Oct 25, 2002 11:51 pm

Restored from previous forum. Originally posted by Fangbeast.

My standard disckaimer first
; Additions, changes and ERRORS by FangBeast/FarDarker (25/10/2002)

No..DOH!! I was having a blonde day and forgot to clear the red/write buffer before I did the next job. I need more sleep and less coding

:)

Stick this update routine in instead of the old one. You will see that after the disablegadget I have added 3 lines to clear the record buffer.

And thank Berickco, not me. I would have never though of these additions without his additional code, I just don't think this way after 15 years of forgettign !!!!!

Code: Select all

;- Update the current visible record and reset it's deleted status if deleted ---------------------

updaterecord:

  If OpenFile(1, #database)

    DisableGadget(#addrec, 1)                                       ; Disable add until new is clicked again

    For r = 0 To SizeOf(record) - 1                                 ; Clear the record buffer
      PokeB(@recbuf\deleted + r, 0)
    Next r

    a$ = Left(GetGadgetText(#name), 49)       : CopyMemory(@a$, @recbuf\name[0], Len(a$))
    a$ = Left(GetGadgetText(#street), 49)     : CopyMemory(@a$, @recbuf\street[0], Len(a$))
    a$ = Left(GetGadgetText(#number), 5)      : CopyMemory(@a$, @recbuf\number[0], Len(a$))
    a$ = Left(GetGadgetText(#postcode), 5)    : CopyMemory(@a$, @recbuf\postcode[0], Len(a$))
    a$ = Left(GetGadgetText(#state), 39)      : CopyMemory(@a$, @recbuf\state[0], Len(a$))

    If recbuf\deleted = 1                                           ; If we update a deleted record, change status to undeleted
      recbuf\deleted = 0                                            ;
      header\numdeleted - 1                                         ; Subtract one from the number of deleted records  
      header\numrecords + 1                                         ; Add it back to live record status
    EndIf

    FileSeek(SizeOf(dbheader) + current * SizeOf(record))
    WriteData(@recbuf, SizeOf(record))                              ; Write the record to disk

    header\recordlen = SizeOf(record)                               ; Compute the length of the record

    FileSeek(0)                                                     ; Seek to the start of the file
           
    WriteData(@header, SizeOf(dbheader))                            ; Write the header details (file length, records)
            
    CloseFile(1)                                                    ; Close the file
            
  EndIf

  Gosub update                                                      ; Update the current record display
    
Return

Fangles woz ear orright den?