PureBasic Forums - English

Posted: **Fri Sep 03, 2004 12:52 pm**

I have been struggling with DBs - could not get MyDB to work, so went back to Tsunami's horrible interface. Having come to grips with OOP while investigating MyDB, I thought this would be a good way to use Tsunami.

I hope this may be useful to someone. Thanks to blueb, ppjm99 and the.weavster, who will probably recognise their parts of the code. Disclaimer - I am fairly new to PB, so apologies may be necessary and will be immediately forthcoming. I do have a more complex example with gadgets if anyone's interested.

This is the example program to use the include file:

Code: Select all

; Author: carolight with help from code from the.weavster and blueb and ppjm99
; Date: 3rd September 2004
; Written in PB 3.90

; The Tsunami database is free and available from
; http://www.trm-ug.com
; To be able to run this example, you need TRM.DLL in your current folder

; This is the example for using the Tsunami OOPish Interface
; Limitations:
; Only 1 field for 1 index (no concatenated fields)
; Only String, Long Integer and Float fields allowed
; Floats have not been perfected to show the exact right float no (inherent difficulty with floats)
; Data Compression is not allowed.
; Tsunami allows much flexibility, as in page size, that are not (yet?) coded in the interface.
; Tsunami allows variable length fields and records.  This interface only allows fixed length.
; Indexes are case sensitive

; Quick start to creating your database interface:
; IncludeFile "TRMInterface.pb"
; Open the TRM library with TRMInitialize()

; For each file:
; 1.  Create a structure (+ associated variable) with 
;     all the fields you need. (book.book_Record)
; 2.  Create a structure variable using structure Tsunami (BookFile.Tsunami)
;     This variable will hold the tsunami interface
; 3.  Initialize the interface variable with TRMCreate(Fields Structure, Filename)
;     (BookFile.Tsunami = TRMCreate(BookRec, "Books.sdb")
; 4   Set up the data definitions:
;     For each field in the structure you need to describe the 
;     Field Name, Field Type, Field Length, and Index Type
;     Call TRMCreateField(FieldName, FieldType, FieldLen, IndexType)
;     (BookFile\TRMCreateField("ISBN", #FIELD_STRING, #FldLen_ISBN, INDEX_UNIQUE)
;  Once you have done this, you can use all the functions in the Tsunami Interface

; To change the data, use the Fields structure (eg book.book_record)
; To use Functions, use the Interface structure (eg BookFile)

; These are the only constants you need to know:
; #TRM_INDEX_NONE
; #TRM_INDEX_UNIQUE
; #TRM_INDEX_DUPLICATES
; #TRM_FIELD_INTEGER 
; #TRM_FIELD_FLOAT
; #TRM_FIELD_STRING

; Functions available:
; TRMCreateField(FieldName.s, FieldType.b, FieldLength.l, Index.l)
; TRMInsert()
; TRMCreate()
; TRMOpen()
; TRMGetFirst()
; TRMGetLast()
; TRMGetNext()
; TRMGetPrev()
; TRMGetEqual()
; TRMDelete()
; TRMUpdate()
; TRMCount()
; TRMSetKeyPath(Index.l)
; TRMClose()
; TRMGetEqualOrGreater()
; TRMGetEqualOrLess()

IncludeFile "TRMInterface.pb"
If TRMInitialize() = 0
  MessageRequester("Error", "Library not found")
  End
EndIf

Structure book_record
  ISBN.s
  Title.s
  Price.f
  QtyAvail.l
  dummy.l    ; Bug? need to create a last field, otherwise QtyAvail is not updated properly
EndStructure
#FldLen_ISBN = 25
#FldLen_Title = 40

book.book_record

BookFile.Tsunami = TRMCreateInstance(book, "Books.sdb")
BookFile\TRMCreateField("ISBN", #TRM_FIELD_STRING, #FldLen_ISBN, #TRM_INDEX_UNIQUE)
BookFile\TRMCreateField("Title", #TRM_FIELD_STRING, #FldLen_Title, #TRM_INDEX_DUPLICATES)
BookFile\TRMCreateField("Price", #TRM_FIELD_FLOAT, 4, #TRM_INDEX_NONE)
BookFile\TRMCreateField("QtyAvail", #TRM_FIELD_INTEGER, 4, #TRM_INDEX_NONE)
BookFile\TRMCreateField("dummy", #TRM_FIELD_INTEGER, 4, #TRM_INDEX_NONE)  

;Open or Create Book File
Result = BookFile\TRMOpen()
If Result = 1 ; not a Tsunami file
  Result = BookFile\TRMCreate()
  Result = BookFile\TRMOpen()
EndIf

; Put data into the file

book\ISBN = "1234.1234.1234"
book\Title = "How to write PB in 24 minutes"
book\Price = 2.50
book\QtyAvail = 1000
BookFile\TRMInsert()

book\ISBN = "2344.9999.2222."
book\Title = "Programming Explained"
book\Price = 199.00
book\QtyAvail = 40

BookFile\TRMInsert()

BookFile\TRMGetFirst()
Debug book\ISBN
Debug book\Title
Debug StrF(book\Price, 2)
Debug book\QtyAvail

BookFile\TRMGetNext()
Debug book\ISBN
Debug book\Title
Debug StrF(book\Price, 2)
Debug book\QtyAvail

BookFile\TRMClose()
MessageRequester("End", "End of Program")
End

This is the include file, which is totally incomprehensible, but you don't need to understand it to use it!:

Code: Select all

Global TRMLibNo.l  ; Library No. for #FIELD_STRING = 1
Global KeySegCount.l
KeySegCount = 0

Enumeration
  #TRM_INDEX_NONE
  #TRM_INDEX_UNIQUE
  #TRM_INDEX_DUPLICATES
  #TRM_FIELD_INTEGER 
  #TRM_FIELD_FLOAT
  #TRM_FIELD_STRING
  #TRM_DATA_INSERT
  #TRM_DATA_RETRIEVE
EndEnumeration

;Tsunami Constants 
#TRM_NO_DUPLICATES  = 2 
#TRM_BINARY_KEY     = 8 

; These are the Tsunami Operation Codes used.  Only about half the codes are implemented.
; The other codes are listed in the Tsunami manual.

#Trm_Close             =  1 ;
#Trm_Count             = 17 
#Trm_Create            = 14 
#Trm_Delete            =  4 
#Trm_GetEqual          =  5 
#Trm_GetEqualOrGreater =  9 
#Trm_GetEqualOrLess    = 11 
#Trm_GetFirst          = 12 
#Trm_GetGreater        =  8 
#Trm_GetLast           = 13 
#Trm_GetLess           = 10 
#Trm_GetNext           =  6 
#Trm_GetPrev           =  7 
#Trm_Insert            =  2 
#Trm_Open              =  0 
#Trm_SetKeyPath        = 30 
#Trm_Update            =  3 

Interface Tsunami
  TRMCreateField.l(FieldName.s, FieldType.b, FieldLen.l, Index.l)
  TRMInsert.l()
  TRMCreate.l()
  TRMOpen.l()
  TRMGetFirst.l()
  TRMGetLast.l()
  TRMGetNext.l()
  TRMGetPrev.l()
  TRMGetEqual.l()
  TRMDelete.l()
  TRMUpdate.l()
  TRMCount.l()
  TRMSetKeyPath.l(Index.l)
  TRMClose.l()
  TRMGetEqualOrGreater.l()
  TRMGetEqualOrLess.l()
EndInterface

Structure FieldStructure
  FieldFileNo.l
  FieldName.s
  FieldType.b
  FieldLen.l
  FieldIndex.l
  FieldStringData.l
  *FieldNext.FieldStructure
  *FieldPrev.FieldStructure
EndStructure

Structure Tsunami_Record
  vTable.l
  Functions.l[SizeOf(Tsunami)/4]
  DataBuffer.l                    ; Pointer to Data Record
  DBBuffer.l                      ; Pointer to memory allocated for data
  datalen.l                       ; Length of DBBuffer
  DBhandle.l                      ; File No
  FieldList.l                     ; Pointer to Fields list
  FileName.s
  CurrentIndex.l
EndStructure

Structure TsunamiStructure 
  op.l        ; Tsunami operation number 
  file.l      ; Tsunami file handle 
  dataptr.l   ; Address of data buffer 
  datalen.l   ; Length of data buffer 
  keyptr.l    ; Address of key buffer 
  keylen.l    ; Length of key buffer 
  keyno.l     ; Key number 
EndStructure 

Structure TsunamiKeySegment 
  keysegname.b[25] 
  keyno.b 
  keypos.w 
  keylen.b 
  keyflags.b 
EndStructure 

Structure TsunamiFileDef 
  PageSize.b 
  compression.b 
  Segments.b 
  segment.TsunamiKeySegment[128] 
EndStructure 

Global TFD.TsunamiFileDef 
Global Tsu.TsunamiStructure

; Declare functions used internally by TRMInterface.pb
Declare TRMProcessFields(*self.Tsunami_Record, action.l)
Declare TRMGet(*self.Tsunami_Record)
Declare TRMGetIndexNo(*self.Tsunami_Record)

Procedure TRMOperation()
  Result = CallFunction(TRMLibNo, "trm_udt", @Tsu)
  ProcedureReturn Result
EndProcedure

Procedure TRMInitialize()
  TRMLibNo = OpenLibrary(#PB_Any, "TRM.DLL")
  ProcedureReturn TRMLibNo
EndProcedure

Procedure TRMCreateField(*self.Tsunami_Record, FieldName.s, FieldType.b, FieldLen.l, FieldIndex.l)
  *p.FieldStructure = AllocateMemory(SizeOf(FieldStructure))
  *p\FieldName = FieldName
  *p\FieldType = FieldType
  *p\FieldLen = FieldLen
  *p\FieldIndex = FieldIndex
  If FieldType = #TRM_FIELD_STRING
    *p\FieldStringData = AllocateMemory(FieldLen)   ; To hold string data
  EndIf
  *p\FieldNext = -1
  *p\FieldPrev = -1
  *m.FieldStructure = *self\FieldList ;*self\FieldList holds first field address
  If *m > 0
    While *m\FieldNext > 0
      *m = *m\FieldNext
    Wend
    *m\FieldNext = *p
    *p\FieldPrev = *m
  EndIf
  If *self\FieldList <= 0
    *self\FieldList = *p  
  EndIf
EndProcedure

Procedure TRMInsert(*self.Tsunami_Record)
  TRMProcessFields(*self, #TRM_DATA_INSERT)
  Tsu\op = #Trm_Insert 
  Tsu\file = *self\DBhandle 
  Tsu\dataptr = *self\DBBuffer
  Tsu\datalen =  *self\datalen
  Result = TRMOperation()
  ProcedureReturn Result
EndProcedure

Procedure TRMUpdate(*self.Tsunami_Record)
  TRMProcessFields(*self, #TRM_DATA_INSERT)
  Tsu\op   = #Trm_Update
  Tsu\file = *self\DBhandle 
  Tsu\dataptr = *self\DBBuffer
  Tsu\datalen =  *self\datalen
  Result = TRMOperation()
  ProcedureReturn Result
  
EndProcedure

Procedure TRMOpen(*self.Tsunami_Record)
  ; set up databuffer
  *self\datalen = 0
  *m.FieldStructure = *self\FieldList
  If *m > 0
    While *m\FieldNext > 0
      *self\datalen = *self\datalen + *m\FieldLen  ; keep running total to allocate enough memory
      *m = *m\FieldNext
    Wend
  EndIf
  *self\DBBuffer = AllocateMemory(*self\datalen) ; this will hold data to be updated in DB
  *self\CurrentIndex = 1  ; Default Index
  
  Tsu\op = #Trm_Open 
  FileName.s = *self\FileName
  Tsu\keyptr = @FileName 
  Tsu\keylen = Len(FileName) 
  Tsu\keyno = 0 ; single user 
  Result = TRMOperation()
  *self\DBhandle = Tsu\file
  ProcedureReturn Result
EndProcedure

Procedure TRMClose(*self.Tsunami_Record)
  Tsu\op = #Trm_Close
  Tsu\file = *self\DBhandle
  Result = TRMOperation()
  ProcedureReturn Result
EndProcedure

Procedure TRMCreate(*self.Tsunami_Record)
  *self\datalen = 0
  KeyNum.l = 1
  CurrOffset.l = 1
  ;Set up indices
  *m.FieldStructure = *self\FieldList
  If *m > 0
    While *m\FieldNext > 0
      *self\datalen = *self\datalen + *m\FieldLen  ; keep running total to allocate enough memory
      If *m\FieldIndex <> #TRM_INDEX_NONE
        keysegname.s = LSet(*m\FieldName,25) 
        TFD\segment[KeySegCount]\keysegname = @keysegname
        TFD\segment[KeySegCount]\keyno = KeyNum 
        KeyNum  = KeyNum + 1
        TFD\segment[KeySegCount]\keypos = CurrOffset 
        TFD\segment[KeySegCount]\keylen = *m\FieldLen
        If *m\FieldType <> #TRM_FIELD_STRING
          TFD\segment[KeySegCount]\keyflags = #TRM_BINARY_KEY
        EndIf
        If *m\FieldIndex = #TRM_INDEX_UNIQUE
          TFD\segment[KeySegCount]\keyflags = TFD\segment[KeySegCount]\keyflags | #TRM_NO_DUPLICATES
        EndIf
        KeySegCount = KeySegCount + 1 
        CurrOffset = CurrOffset + *m\FieldLen
      EndIf
      *m = *m\FieldNext
    Wend
  EndIf
  *self\DBBuffer = AllocateMemory(*self\datalen) ; this will hold data to be updated in DB
  
  ; Set up File Header
  TFD\PageSize = 1 
  TFD\compression = 1 
  TFD\Segments = KeySegCount
  ; now set up Tsu structure 
  Tsu\op = #Trm_Create 
  Tsu\file = 0
  Tsu\dataptr = TFD 
  Tsu\datalen =  3 + (30 * TFD\Segments) 
  FileName.s = *self\FileName
  Tsu\keyptr = @FileName
  Tsu\keylen = Len(FileName) 
  Tsu\keyno = 1 ; Overwrite file if it already exists
  Result = TRMOperation()
  Result = 0
  ProcedureReturn Result  
EndProcedure

Procedure TRMGetFirst(*self.Tsunami_Record)
  Tsu\op = #Trm_GetFirst
  Result = TRMGet(*self)
  ProcedureReturn Result
EndProcedure

Procedure TRMGetNext(*self.Tsunami_Record)
  Tsu\op = #Trm_GetNext
  Result = TRMGet(*self)
  ProcedureReturn Result
EndProcedure

Procedure TRMGetPrev(*self.Tsunami_Record)
  Tsu\op = #Trm_GetPrev
  Result = TRMGet(*self)
  ProcedureReturn Result
EndProcedure

Procedure TRMGetLast(*self.Tsunami_Record)
  Tsu\op = #Trm_GetLast
  Result = TRMGet(*self)
  ProcedureReturn Result
EndProcedure

Procedure TRMGetEqual(*self.Tsunami_Record)
  Tsu\op = #Trm_GetEqual
  Tsu\keyptr = *self\DataBuffer
  Tsu\keylen = 4
  Result = TRMGet(*self)
  ProcedureReturn Result
EndProcedure

Procedure TRMGetEqualOrGreater(*self.Tsunami_Record)
  Tsu\op = #Trm_GetEqualOrGreater
  ; set Tsu\keyptr and Tsu\keylen
  TRMGetIndexNo(*self)
  Result = TRMGet(*self)
  ProcedureReturn Result
EndProcedure

Procedure TRMGetEqualOrLess(*self.Tsunami_Record)
  Tsu\op = #Trm_GetEqualOrLess
  TRMGetIndexNo(*self)
  Result = TRMGet(*self)
  ProcedureReturn Result
EndProcedure

Procedure TRMDelete(*self.Tsunami_Record)
  Tsu\op = #Trm_Delete
  Tsu\file = *self\DBhandle
  Result = TRMOperation()
  ProcedureReturn Result
EndProcedure

Procedure TRMCount(*self.Tsunami_Record)
  Tsu\op  = #Trm_Count
  Tsu\file = *self\DBhandle
  Result = TRMOperation()
  ProcedureReturn Tsu\keyno
EndProcedure

Procedure TRMSetKeyPath(*self.Tsunami_Record, Index.l)
  *self\CurrentIndex = Index
  Tsu\op = #Trm_SetKeyPath
  Tsu\file = *self\DBhandle
  Tsu\keyno = Index
  Result = TRMOperation()
  ProcedureReturn Result
EndProcedure

Procedure.s TRMErrorText(ErrCode)
    Text$ = "Unknown Error" 
    Select ErrCode 
      Case 1 : Text$ = "Not A Tsunami File" 
      Case 2 : Text$ = "I/O Error" 
      Case 3 : Text$ = "File Not Open" 
      Case 4 : Text$ = "Key Not Found" 
      Case 5 : Text$ = "Duplicate Key" 
      Case 6 : Text$ = "Invalid Key Number" 
      Case 7 : Text$ = "File Corrupt" 
      Case 8 : Text$ = "No Current Position" 
      Case 9 : Text$ = "End Of File" 
      Case 10 : Text$ = "Invalid Page Size" 
      Case 11 : Text$ = "Invalid Number Of Key Segments" 
      Case 12 : Text$ = "Invalid File Definition String" 
      Case 13 : Text$ = "Invalid Key Segment Postion" 
      Case 14 : Text$ = "Invalid Key Segment Length" 
      Case 15 : Text$ = "Inconsistent Key Segment Definitions" 
      Case 20 : Text$ = "Invalid Record Length" 
      Case 21 : Text$ = "Invalid Record Pointer" 
      Case 22 : Text$ = "Lost Record Position" 
      Case 30 : Text$ = "Access Denied" 
      Case 31 : Text$ = "File Already Exists" 
      Case 32 : Text$ = "No More File Handles" 
      Case 33 : Text$ = "Max Files Open" 
      Case 40 : Text$ = "Accelerated Access Denied" 
      Case 41 : Text$ = "Acceleration Cache Error" 
      Case 46 : Text$ = "Access To File Denied" 
      Case 50 : Text$ = "Data Buffer Too Small" 
      Case 51 : Text$ = "Record Deleted Successfuly"
      Case 99 : Text$ = "Time Out" 
    EndSelect 
  ProcedureReturn Text$ 
EndProcedure

Procedure TRMCreateInstance(*DataBuffer, FileName.s)
  *TsuRec.Tsunami_Record = AllocateMemory(SizeOf(Tsunami_Record))
  *TsuRec\vTable = *TsuRec + OffsetOf(Tsunami_Record, Functions)
  *TsuRec\Functions[0] = @TRMCreateField()
  *TsuRec\Functions[1] = @TRMInsert()
  *TsuRec\Functions[2] = @TRMCreate()
  *TsuRec\Functions[3] = @TRMOpen()
  *TsuRec\Functions[4] = @TRMGetFirst()
  *TsuRec\Functions[5] = @TRMGetLast()
  *TsuRec\Functions[6] = @TRMGetNext()
  *TsuRec\Functions[7] = @TRMGetPrev()
  *TsuRec\Functions[8] = @TRMGetEqual()
  *TsuRec\Functions[9] = @TRMDelete()
  *TsuRec\Functions[10] = @TRMUpdate()
  *TsuRec\Functions[11] = @TRMCount()
  *TsuRec\Functions[12] = @TRMSetKeyPath()
  *TsuRec\Functions[13] = @TRMClose()
  *TsuRec\Functions[14] = @TRMGetEqualOrGreater()
  *TsuRec\Functions[15] = @TRMGetEqualOrLess()
  *TsuRec\DataBuffer = *DataBuffer
  *TsuRec\FieldList = -1
  *TsuRec\FileName = FileName
  *TsuRec\datalen = 0
  ProcedureReturn *TsuRec
EndProcedure

Procedure TRMProcessFields(*self.Tsunami_Record, action.l)
  *m.FieldStructure = *self\FieldList
  CurrOffset.l = 0
  DBOffset.l = 0
  Repeat
    If *m > 0
      Select *m\FieldType
        Case #TRM_FIELD_INTEGER
          If action = #TRM_DATA_INSERT
            PokeL(*self\DBBuffer + DBOffset, PeekL(*self\DataBuffer + CurrOffset))
          Else
            PokeL(*self\DataBuffer + CurrOffset , PeekL(*self\DBBuffer + DBOffset))
          EndIf
          CurrOffset = CurrOffset + 4
          DBOffset = DBOffset + 4
        Case #TRM_FIELD_STRING
          If action = #TRM_DATA_INSERT
            PokeS(*self\DBBuffer + DBOffset, LSet(PeekS(*PeekL(*self\DataBuffer +CurrOffset)), *m\FieldLen))
          Else
            PokeL(*self\DataBuffer + CurrOffset, *m\FieldStringData)
          EndIf
          If *m\FieldStringData > 0
            FreeMemory(*m\FieldStringData)
          EndIf
          *m\FieldStringData = AllocateMemory(*m\FieldLen)
          PokeS(*m\FieldStringData, LSet(PeekS(*self\DBBuffer + DBOffset), *m\FieldLen))
          CurrOffset = CurrOffset + 4
          DBOffset = DBOffset + *m\FieldLen
        Case #TRM_FIELD_FLOAT
          If action = #TRM_DATA_INSERT
            PokeF(*self\DBBuffer + DBOffset, PeekF(*self\DataBuffer + CurrOffset))
          Else
            PokeF(*self\DataBuffer + CurrOffset, PeekF(*self\DBBuffer + DBOffset))
          EndIf
          CurrOffset = CurrOffset + 4
          DBOffset = DBOffset + 4
      EndSelect
    EndIf
    *m = *m\FieldNext
  Until *m <= 0
  
EndProcedure

Procedure TRMGet(*self.Tsunami_Record)
  Tsu\file = *self\DBhandle
  Tsu\keyno = *self\CurrentIndex
  Tsu\dataptr = *self\DBBuffer
  Tsu\datalen = *self\datalen
  Result = TRMOperation()
  If Result = 0
    TRMProcessFields(*self, #TRM_DATA_RETRIEVE)
  EndIf
  ProcedureReturn Result  
EndProcedure

Procedure TRMGetIndexNo(*self.Tsunami_Record)
  *m.FieldStructure = *self\FieldList
  CurrOffset.l = 0
  DBOffset.l = 0
  CurrentIndex = 0
  Repeat
    If *m > 0
      If *m\FieldIndex <> #TRM_INDEX_NONE
        CurrentIndex = CurrentIndex + 1
        If CurrentIndex = *self\CurrentIndex
          If *m\FieldType = #TRM_FIELD_STRING
            Tsu\keyptr = PeekL(*self\DataBuffer + CurrOffset)
          Else
            Tsu\keyptr = *self\DataBuffer + CurrOffset
          EndIf
          Tsu\keylen = *m\FieldLen
          ProcedureReturn
        EndIf
      EndIf
      CurrOffset = CurrOffset + 4
    EndIf
    *m = *m\FieldNext
  Until *m <= 0
EndProcedure

Posted: **Sat Sep 04, 2004 3:17 pm**

Thanks carolight.

I checked out the Books.sdb file with another Tsunami program and it works fine.

I'm going to read your posted program and see where I can apply it. So far it looks pretty good. I agree, Tsunami is hard to get an initial grasp of... but it's so fast and so small, it's worth spending some time with.

If you've got more I'd certainly be interested in seeing it.
All is appreciated.

(Sorry, but I've been spending time studying Firebird SQL)

Best Regards,
--blueb

Posted: **Sun Sep 05, 2004 5:43 am**

Blueb - Thanks for checking out my file.

Tsunami is great - it's such a small dll, with apparently good reliability. And lots of features, that I don't need, and that's reflected in my somewhat simplistic interface.
I didn't want to go into an SQL type language because of messing with ODBC drivers. I just want to be able to distribute a small stand-alone application.

This is an example of looking at a database with gadgets. I was having problems with memory mapping after going through the db a few times, which I put down to the PB reallocation of structure / string memory problem. I made them fixed with LSet, and it seems to be fine now.

Code: Select all

; TRMExample.pb
; Author carolight with code from blueb, the.weavster and ppjm99
; More detailed example of using TRMInterface.pb.
; See documentation at top of simpler example.

Declare DisplayFields()
Declare ClearFields()
Declare UpdateFields()

IncludeFile "TRMInterface.pb"
If TRMInitialize() = 0
  MessageRequester("Error", "Library not found")
  End
EndIf

Structure Customer_Record
  code.l
  name.s
  street.s
  city.s
  balance.f
  dummy.l    ; Bug? need to create a last field, otherwise balance is not updated properly
EndStructure

; These constants are needed due to a lack of fixed length strings in PB
#FldLen_name = 30
#FldLen_street = 30
#FldLen_city = 20

CustRec.Customer_Record

;Set up Data Definition
CustFile.Tsunami = TRMCreateInstance(CustRec, "Customer.sdb")
CustFile\TRMCreateField("Code", #TRM_FIELD_INTEGER, 4, #TRM_INDEX_UNIQUE)
CustFile\TRMCreateField("Name", #TRM_FIELD_STRING, #FldLen_name, #TRM_INDEX_DUPLICATES)
CustFile\TRMCreateField("Street", #TRM_FIELD_STRING, #FldLen_street, #TRM_INDEX_NONE)
CustFile\TRMCreateField("City", #TRM_FIELD_STRING, #FldLen_city, #TRM_INDEX_NONE)
CustFile\TRMCreateField("Balance", #TRM_FIELD_FLOAT, 4, #TRM_INDEX_NONE)
CustFile\TRMCreateField("Dummy", #TRM_FIELD_INTEGER, 4, #TRM_INDEX_NONE)  ; create dummy last field

;Open or Create Customer File
Result = CustFile\TRMOpen()
If Result = 1 ; not a Tsunami file
  Result = CustFile\TRMCreate()
  Result = CustFile\TRMOpen()
EndIf

;Now Create Window to hold Gadgets
Enumeration
  #Title
  #TxtCustomerCode
  #CustomerCode
  #TxtCustomerName
  #CustomerName
  #TxtCustomerStreet
  #CustomerStreet
  #TxtCustomerCity
  #CustomerCity
  #TxtCustomerBalance
  #CustomerBalance
  #BtnNext
  #BtnPrev
  #BtnFirst
  #BtnLast
  #BtnUpdate
  #BtnInsert
  #BtnDelete
  #BtnSearch
  #BtnClear
  #TxtCurrentIndex
  #CboCurrentIndex
EndEnumeration

; Find First Customer Record:
CustFile\TRMGetFirst(1)
CurrentIndex.l = 1

Font0 = LoadFont(0, "Arial", 12, #PB_Font_Bold)

If OpenWindow(0, 100, 200, 640, 480, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "Customer Database")
  CreateStatusBar(0, WindowID())
  AddStatusBarField(500)
  AddStatusBarField(140)
  If CreateGadgetList(WindowID())
    TextGadget(#Title, 220, 50, 280, 30, "CUSTOMER DATABASE")
    SetGadgetFont(#Title, Font0)
    TextGadget(#TxtCustomerCode, 100, 100, 80, 30, "Code:")
    StringGadget(#CustomerCode, 170, 100, 60, 30, Str(CustRec\code), #PB_String_Numeric)
    ButtonGadget(#BtnSearch, 250, 100, 70, 30, "Search")
    TextGadget(#TxtCustomerName, 100, 150, 90, 30, "Name:")
    StringGadget(#CustomerName, 170, 150, 100, 30, Trim(CustRec\name))
    TextGadget(#TxtCustomerStreet,100, 200, 80, 30, "Street:")
    StringGadget(#CustomerStreet, 170, 200, 100, 30, Trim(CustRec\street))
    TextGadget(#TxtCustomerCity, 100, 250, 80, 30, "City:")
    StringGadget(#CustomerCity, 170, 250, 100, 30, Trim(CustRec\city))
    TextGadget(#TxtCustomerBalance, 100, 300, 80, 30, "Balance:")
    StringGadget(#CustomerBalance, 170, 300, 60, 30, StrF(CustRec\balance, 2), #PB_String_Numeric)
    ButtonGadget(#BtnNext, 400, 100, 70,30, "Next")
    ButtonGadget(#BtnPrev, 400, 132, 70, 30, "Previous")
    ButtonGadget(#BtnFirst , 400, 164, 70, 30, "First")
    ButtonGadget(#BtnLast, 400, 196,70, 30, "Last")
    ButtonGadget(#BtnUpdate, 400, 226, 70, 30, "Update")
    ButtonGadget(#BtnInsert, 400, 258, 70, 30, "Insert")
    ButtonGadget(#BtnDelete, 400, 290, 70, 30, "Delete")
    ButtonGadget(#BtnClear, 400, 322, 70, 30, "Clear")
    TextGadget(#TxtCurrentIndex, 100, 400, 80, 30, "Current Index:")
    ComboBoxGadget(#CboCurrentIndex, 170, 400, 140, 130)
  EndIf
  StatusBarText(0, 1, "  No. Of Records: " + Str(CustFile\TRMCount()))
  AddGadgetItem(#CboCurrentIndex, -1, "Index 1:- Customer Code")
  AddGadgetItem(#CboCurrentIndex, -1, "Index 2:- Customer Name")
  SetGadgetState(#CboCurrentIndex, 0)
  Repeat
    RecStatus.l = 0
    EventID = WaitWindowEvent()
    If EventID = #PB_EventGadget
      RecStatus = -1;
      EventGID.l = EventGadgetID()
      Select EventGID
        Case #BtnSearch:
          If CurrentIndex = 1
            CustRec\code = Val(GetGadgetText(#CustomerCode))
          Else
            If CurrentIndex = 2
              CustRec\name = LSet(GetGadgetText(#CustomerName), #FldLen_name)
            EndIf
          EndIf
          RecStatus = CustFile\TRMGetEqualOrGreater()
        Case #BtnFirst : 
          RecStatus = CustFile\TRMGetFirst()
        Case #BtnNext:
          RecStatus = CustFile\TRMGetNext()
        Case #BtnPrev:
          RecStatus = CustFile\TRMGetPrev()
        Case #BtnLast:
          RecStatus = CustFile\TRMGetLast()
        Case #BtnClear:
          RecStatus = 8 ; No Current Position
        Case #BtnDelete :
          RecStatus = CustFile\TRMDelete()
          If RecStatus = 0
            RecStatus = 51
          EndIf
      EndSelect
      If RecStatus = 0
        DisplayFields()
        StatusBarText(0,0, "Customer Code " + GetGadgetText(#CustomerCode) + " Displayed")
      EndIf
      If RecStatus > 0
        ClearFields()
        DisplayFields()
        StatusBarText(0, 0, TRMErrorText(RecStatus))
        ActivateGadget(#CustomerCode)
      EndIf
      If EventGID = #BtnInsert Or EventGID = #BtnUpdate
        UpdateFields()
        If CustRec\code <= 0
          StatusBarText(0,0, "Cannot Insert a Zero Customer Code")
        Else
          If EventGID = #BtnInsert
            Result = CustFile\TRMInsert()
            text.s = " Inserted."
          Else
            Result = CustFile\TRMUpdate()
            text.s = " Updated."
          EndIf
          If Result = 0
            StatusBarText(0,0 ,"Customer Code: " + GetGadgetText(#CustomerCode) + text)
          Else
            StatusBarText(0,0, "Error - " +  TRMErrorText(Result))
          EndIf
        EndIf
      EndIf
      If EventGID = #CboCurrentIndex
        If GetGadgetState(#CboCurrentIndex) + 1 <> CurrentIndex
          Result = CustFile\TRMSetKeyPath(GetGadgetState(#CboCurrentIndex) + 1)
          If Result <> 0
            StatusBarText(0, 0, TRMErrorText(Result))
          Else
            StatusBarText(0,0, "Current Index Changed to: " + Str(GetGadgetState(#CboCurrentIndex)+1))
          EndIf
          CurrentIndex = GetGadgetState(#CboCurrentIndex) + 1
        EndIf
      EndIf
      StatusBarText(0, 1, "  No. Of Records: " + Str(CustFile\TRMCount()))
    EndIf
  Until EventID = #PB_EventCloseWindow
EndIf
CustFile\TRMClose()
End 

Procedure DisplayFields()
  Shared CustRec
  SetGadgetText(#CustomerCode, Trim(Str(CustRec\code)))
  SetGadgetText(#CustomerName, Trim(CustRec\name))
  SetGadgetText(#CustomerStreet, Trim(CustRec\street))
  SetGadgetText(#CustomerCity, Trim(CustRec\city))
  SetGadgetText(#CustomerBalance, Trim(StrF(CustRec\balance, 2)))
EndProcedure

; The Space(#FldLen_name) is needed in the following function, due to lack of fixed strings, 
; and a PB memory problem with dynamically allocating strings within structures.  The
; LSet in the next function is the same.  If the PB memory problem with strings
; is fixed, or there is a fixed string feature, then they can be changed to:
; CustRec\name = "".

Procedure ClearFields()
  Shared CustRec
  CustRec\code = 0
  CustRec\name = Space(#FldLen_name)
  CustRec\street = Space(#FldLen_street)
  CustRec\city = Space(#FldLen_city)
  CustRec\balance = 0
EndProcedure

Procedure UpdateFields()
  Shared CustRec
  CustRec\code = Val(GetGadgetText(#CustomerCode))
  CustRec\name = LSet(GetGadgetText(#CustomerName), #FldLen_name)
  CustRec\street = LSet(GetGadgetText(#CustomerStreet), #FldLen_street)
  CustRec\city = LSet(GetGadgetText(#CustomerCity), #FldLen_city)
  CustRec\balance = ValF(GetGadgetText(#CustomerBalance))
EndProcedure

I hope this is of interest.

Posted: **Sun Sep 05, 2004 6:58 am**

Hi Carolight.

Firstly, nice code. Neat and well done.

I have never used tsunami but decided to give it a try. Ran your code from the first example. It created the database then and hit a "memory could not be read" error in the callfunction below:

Code: Select all

Procedure TRMOperation()
  Result = CallFunction(TRMLibNo, "trm_udt", @Tsu)
  ProcedureReturn Result
EndProcedure

Wondering if you could give me a clue as to how to overcome this. I am using win2k.

Thanks. Props again on the neat code!

EDIT:

PS: This happens ( call to TRMOperation ) via TRMGet from TRMGetFirst

Posted: **Sun Sep 05, 2004 11:15 am**

Thanks for the nice comments, Dare, but if a program doesn't work, it doesn't matter what the code's like!

I only have XP, and it's worked fine here, and one tends to assume it will be the same for all computers.

It sounds as if the memory allocation under win2k may be different. I did find this topic:

viewtopic.php?t=7041

where GPI says:

But, what i have changed:
* NEVER USE STRINGS AS BUFFER
(something like this: String.s=space(1000): adr=@string ....)
This can crash your code on some systems, on other not.
(And yes, i use in japbe strings as buffers, but not as much as in my mods)
* When you allocate memory, every procedure should get his own memory-block.
Don't share them, you can get in conflict with it. When you don't need them anymore, give them free.

I use a lot of strings as buffers, and I also allocate memory that I assume will be globally allocated.

He does suggest rather than using AllocateMemory, to use AllocGlobal_(API). There are 6 places that I use AllocateMemory, so it may be worth replacing these and see if that works. I'll give it a go here, and see if I can raise my win98 computer from the dead to see if it will work on that.

I'm sorry I can't be of more help - I would be grateful for your feedback on this, though, as I was hoping the code was fairly robust, so that I can use it in distributable applications.

Posted: **Sun Sep 05, 2004 11:35 am**

Hi Carolight,

Thanks for the response.

I am trying a few things with this and intend to write a simple no-oop emulation of your code to see if that highlights anything. Will respond when/if I find anything.

Keep winning.

Posted: **Sun Sep 05, 2004 2:57 pm**

Another nice example carolight and it works well with XP Pro (SP1).

You might be correct in assuming a memory allocation problem with Win2k

Tsunami has been very stable (over a year) with no reports of major glitches, so I'd suspect it's the way Purebasic creates structures that causes the need for the 'dummy' field. I'll see if I can narrow it down a little.

--blueb

Posted: **Mon Sep 06, 2004 9:44 am**

Thanks for checking it out blueb.

Dare - I don't believe it's an OOP problem - it feels like memory allocation. Tsunami is really fussy about the memory sent to it's dll function trm_udt. (I'd put it down to a Bigpond problem if I could

)

But do let me know if you find anything.

Posted: **Mon Sep 06, 2004 11:55 am**

carolight wrote:(I'd put it down to a Bigpond problem if I could )

LOL.

I'm still going through a learning curve with the TRM commands. And I've still got to get past the open in my own code. Can create. Can't open. lol. Greased lightning here.

Posted: **Mon Sep 06, 2004 5:50 pm**

it doesn't works with XP Pro-sp1. (Fujitsu siemens Notebook, and I have no problem)

I think memory problem with TRM.

HAnil

Posted: **Tue Sep 07, 2004 4:01 am**

That's interesting, hanil - back to the drawing board. I'll have to check it out on various machines first next time.

Posted: **Wed Sep 08, 2004 3:23 pm**

I'm stuck on this (the crash on my box) and haven't come up with anything workable (even without the oop-ish interface) let alone elegant.

Scrubbed everything and back to the drawing board. Anyone made any advances?

Posted: **Thu Sep 09, 2004 9:43 am**

Well, my (non-)progress is this:

I ran it on XP home, XP pro, win 98 and the 2 examples I gave were fine. So then I transferred the interface to a much more complicated program that opens multiple files. It crashed on an AllocateMemory statement. I put in a plain vanilla AllocateMemory(5), and it crashed on that statement. I thought that was interesting, as it implies that the memory is getting messed up internally in PB, not that incorrect memory is being sent to the Tsunami dll.(?)

Although, to contradict that, if I comment out the CallFunction to the Tsunami dll it works fine. So my next step, I guess, will be to examine the memory I am sending to the dll, because it most likely is a fault somewhere in all those asterisks in my incomprehensible code.

Sorry I raised it Dare - thanks for looking at it - I guess a concern for you might be the fact that those examples worked for me on XP and 98.

Posted: **Thu Sep 09, 2004 11:23 am**

Hi carolight.

Actually I am wondering if I have a system glitch as I'm also crashing on another program that "everyone else" can run.

I am glad you raised the tsunami banner.

It interests me quite a bit. If a good workable marriage can be arranged between PB and Tsunami I think I will adopt it. (Or is that be adopted in).

Anyhow, I'll keep dabbling - but low profile.

PureBasic Forums - English

OOPish Interface to Tsunami

OOPish Interface to Tsunami