to Nages: test for tdatabase

[TimStone]

James,

I used to have issues with some of the FWH classes until Nages suggested I do it this way to be sure the code didn't confuse the class. I don't remember which ones created issues for me, but this is such an easy solution, and for the more complex classes, it's really a way to work within longer methods knowing the object you are referencing.

Tim

[Silvio.Falconi]

James, Tim, Nages

Maybe I did not say it clear enough .
for now I must not make an Invoice

After customer management.

When a customer takes an umbrella it generally takes up to 4 people, or La Palma takes it up to 10 people, generally the names and surnames of the people are not saved but my client has asked me to insert an archive where he could insert the names of the guests that are hosted in the umbrella or in the palms.

It is like when in a hotel the reception has to register all the guests room by room.

Until last year no one had asked me for something like this but this year it seems that everyone is asking me the same thing, namely to insert the names of the guests, an identification document and their cell phone.

So I have to enter the guest by taking the customer code, for example Falconi Silvio is the customer with code 0005 and topolino, pluto, and minni are Silvio's guests.

You talk to me about relational brooms but I've never done it and for me it's a difficult thing. in the single user version I simply did:

SELECT PA
PA -> (DbSetOrder (1))
PA -> (OrdScope (0, {|| alltrim ((cNumCli))}))
PA -> (OrdScope (1, {|| alltrim ((cNumCli))}))
PA -> (DbGoTop ())
xbrowse ...

[James Bott]

Silvio,

Maybe I did not say it clear enough .
for now I must not make an Invoice

After customer management.

When a customer takes an umbrella it generally takes up to 4 people, or La Palma takes it up to 10 people, generally the names and surnames of the people are not saved but my client has asked me to insert an archive where he could insert the names of the guests that are hosted in the umbrella or in the palms.

Maybe "invoice" was the wrong term. A reservation is like a sales order, and sales orders get converted into invoices. Reservations get converted into bills--same thing.

So I have to enter the guest by taking the customer code, for example Falconi Silvio is the customer with code 0005 and topolino, pluto, and minni are Silvio's guests.

Logically the guests need to be attached to the reservation not the customer. The customer is the owner of the reservation. The same customer could get more than one reservation and thus have more than one group of guests. So the guests need to be connected to the reservation (which is connected to the customer).

So you just need a guests file with the reservation number, guest name, ID number, and cell phone number.

The reservation has to contain a single customer object, one or more item objects, and one or more guest objects.

Reservation object
Customer: Silvio Falconi
Items: umbrella, chair, lounge - These need to be stored in an item file related by reservation ID
Guests: topolino, pluto, minni - These need to be stored in a guests file related by reservation ID

Later the reservation object will be used to create a bill object (invoice). The bill object is basically just a reservation printout. It may, or may not, contain all the info in the reservation object.

[Silvio.Falconi]

Logically the guests need to be attached to the reservation not the customer.

the guest must be attached to the customer, I am a customer and rent umbrella number FIve

On my Umbrella I have my mother Edwige , my father Giuseppe, my friends ( Antonio Linares and James Bott)

a beautiful sunny day comes from America, the wife of James, and asks the management of the beach "Where is my husband?"

The management inserts "James Bott" on the search field, the procedure makes a search on all the umbrellas active on that day: the procedure goes to look first for the names of the customers who have rented the umbrellas that day and for each customer check if it is a friend (or relative) of the client

the procedure after much searching finds the nominative "James bott" under the friends of "Falconi Silvio" who is a customer and that day has booked the umbrella number 5.

The procedure makes a tooltip appear on the umbrella with the word "James Bott" or the procedure makes appear (if the application is windows 10) a desktopAlert at the bottom with the data of the umbrella where he looked for the nominative "James Bott". Nothing could be easier

Reservation object
Customer: Silvio Falconi
Items: umbrella, chair, lounge - These need to be stored in an item file related by reservation ID
Guests: topolino, pluto, minni - These need to be stored in a guests file related by reservation ID

all right only this is wrong

Guests: topolino, pluto, minni - These need to be stored in a guests file related by reservation ID

Guests: topolino, pluto, minni - These need to be stored in a guests file related by Customer ID

Because On Planning of the beach I show umbrellas and select the day or a Intervall of day






Because if I link the guest on reservation id and that day I not have that reservation ( where is topolino guest) I cannot never found it !!!!!

So you just need a guests file with the reservation number, guest name, ID number, and cell phone number.

I need a guest archive as I built it:



for each guest I need Name,Surname, Type of guest (parent or friend) and 4 type of telephones (telephone, mobile, handheld, fax) and in future aldo the type of document and the number of document

Code: Select all  Expand view

Function BuildDbf(cDir)

   FIELD NUMCLI,NOMEINTERO,CITTA,TIPO

   local oDbf,oDbf2,oDbf3

   local aCols       := {{'Numcli' ,'C',4  ,0 }  ,;
                         {'Cognome','C',30 ,0 }  ,;
                         {'Nome','C',30 ,0 }  ,;
                         {'Indirizzo' ,'C',50 ,0 }  ,;
                         {'Citta'     ,'C',30 ,0 }  ,;
                         {'Provincia' ,'C',2  ,0 }  ,;
                         {'Cap'       ,'C',5  ,0 }  ,;
                         {'Stato'     ,'C',30 ,0 }  ,;
                         {'Email'     ,'C',50 ,0 }  ,;
                         {'Codfiscale','C',16 ,0 }  ,;
                         {'Partiva'   ,'C',11 ,0 }  ,;
                         {'Appunti'   ,'C',200,0 }  ,;
                         {'Telefono1' ,'C',20 ,0 }  ,;
                         {'Telefono2' ,'C',20 ,0 }  ,;
                         {'Telefono3' ,'C',20 ,0 }  ,;
                         {'Telefono4' ,'C',20 ,0 }  ,;
                         {'TeleTipo1' ,'C',10 ,0 }  ,;
                         {'Teletipo2' ,'C',10 ,0 }  ,;
                         {'Teletipo3' ,'C',10 ,0 }  ,;
                         {'Teletipo4' ,'C',10 ,0 }  ,;
                         {'TipoCli'   ,'C',25 ,0 }  ,;
                         {'Islock'    ,'L', 1 ,0 }   }

   local aColsTipo       := {{'TipoCli' ,'C',25  ,0 } ,;
                             {'ImgCli'  ,'C', 120 ,0 } }


   local aDataTipo:={{"Cliente abituale",".\bitmaps\hat1.bmp"},;
                     {"Hotel",           ".\bitmaps\hat2.bmp"},;
                     {"Convenzione",     ".\bitmaps\hat3.bmp"},;
                     {"Altro",           ".\bitmaps\hat4.bmp" }}



   local aColsOspite := {{'Numcli' ,'C',4  ,0 }  ,;
                         {'Cognome','C',30 ,0 }  ,;
                         {'Nome','C',30 ,0 }  ,;
                         {'TipoOspite','C',20 ,0 }  ,;
                         {'Telefono1' ,'C',20 ,0 }  ,;
                         {'Telefono2' ,'C',20 ,0 }  ,;
                         {'Telefono3' ,'C',20 ,0 }  ,;
                         {'Telefono4' ,'C',20 ,0 }  ,;
                         {'TeleTipo1' ,'C',10 ,0 }  ,;
                         {'Teletipo2' ,'C',10 ,0 }  ,;
                         {'Teletipo3' ,'C',10 ,0 }  ,;
                         {'Teletipo4' ,'C',10 ,0 }   }




   IF !file(cDir+"CLIENTI.DBF")
          oDbf  := TDatabase():Create( cDir+"CLIENTI.DBF", aCols, "DBFCDX"  ) //"*"
            oDbf:Append()
            oDbf:numcli:= "0001"
            oDbf:Cognome:= "<< Cliente Generico >>"
            oDbf:Islock:= .t.
            oDbf:save()



            INDEX ON NUMCLI TAG CL001 FOR !Deleted()
            INDEX ON upper(COGNOME)+UPPER(NOME) TAG CL002 FOR !Deleted()
            INDEX ON upper(TIPOCLI) TAG CL003 FOR !Deleted()
            INDEX ON upper(CITTA) TAG CL004 FOR !Deleted()

            oDbf:Close()

       ENDIF

       //type of cliente
   IF !file(cDir+"TIPOCLI.DBF")
          oDbf2:= TDatabase():Create( cDir+"TIPOCLI.DBF", aColsTipo, "DBFCDX"  )
          oDbf2:ArrayToDbf(aDataTipo  )
          INDEX ON TIPOCLI TAG TC001 FOR !Deleted()
          oDbf2:Close()
       ENDIF



       IF !file(cDir+"Ospiti.DBF")
          oDbf3:= TDatabase():Create( cDir+"Ospiti.DBF", aColsOspite, "DBFCDX"  )
          INDEX ON NUMCLI TAG OS001 FOR !Deleted()
           INDEX ON upper(COGNOME)+UPPER(NOME) TAG OS002 FOR !Deleted()
          oDbf3:Close()
       ENDIF




   RETURN NIL
 

[Silvio.Falconi]

on my test with tdatabase I made

oDDom:= TDatabase():Open( , cPath+"OSPITI", "DBFCDX", .T. )
oDDom:Seek(cCli)

xbrowse oBrd

oBrd:bGoTop :={|| GoToTop(oDDom,cCli)}
oBrd:bGoBottom:={|| GoToBot(oDDom,cCli)}
oBrd:bSkip :={|n| MovePtr(oDDom,cCli,n)}

Code: Select all  Expand view

FUNCTION GoToTop(cAlias,cKey)
   DbSelectArea(cAlias)
   (cAlias)->(DbSeek(cKey))
RETURN (NIL)

FUNCTION GoToBot(cAlias,cKey)
   LOCAL cTem:=STUFF(cKey,Len(cKey),1,Chr(Asc(Right(cKey,1))+1))
   DbSelectArea(cAlias)
   (cAlias)->(DbSeek(cTem,.T.))
   (cAlias)->(DbSkip(-1))
   IF &((cAlias)->(IndexKey(0)))=cKey
      (cAlias)->(DbSkip(0))
   ELSE
      (cAlias)->(DbSeek(cKey))
   ENDIF
RETURN (NIL)

FUNCTION MovePtr(cAlias,cKey,nReg)
   LOCAL nNext:=0
   DbSelectArea(cAlias)
   IF nReg=0 .OR. (cAlias)->(LastRec())=0 .OR. !(&((cAlias)->(IndexKey(0)))=cKey)
      (cAlias)->(DbSkip(0))
   ELSEIF nReg>0 .AND. (cAlias)->(RecNo())<>(cAlias)->(LastRec())+1
      DO WHILE nNext<=nReg .AND. !(cAlias)->(EoF()) .AND. &((cAlias)->(IndexKey(0)))=cKey
         (cAlias)->(DbSkip())
         nNext++
      ENDDO
      (cAlias)->(DbSkip(-1))
      nNext--
   ELSEIF nReg<0
      DO WHILE nNext>=nReg .AND. !(cAlias)->(BoF()) .AND. &((cAlias)->(IndexKey(0)))=cKey
         (cAlias)->(DbSkip(-1))
         nNext--
      ENDDO
      IF !(cAlias)->(BoF())
         (cAlias)->(DbSkip())
      ENDIF
      nNext++
   ENDIF
RETURN (nNext)

it seem to run ok here

[Silvio.Falconi]

First of all I have to specify one thing:
For the management of customers, the system (the test) that Rao did as well for other archives is fine for me.
the only thing I asked for was to use only a control.dbf file for all the archives and to have different types of lengths for example 4-digit customers, 10-digit orders

Nages
on the test I add a new Method to duplicate a record ( seem run ok)

I have implemented your requirements. This is the program to test.

Code: Select all  Expand view

#include "fivewin.ch"

REQUEST DBFCDX

static cPath      // give here your path

static l3BtnStyle := .t.

//----------------------------------------------------------------------------//

function Main()

   DEFAULT cPath  := cFilePath( ExeName() )

   TClients():New():Browse():Close()
   TItems():New():Browse():Close()

   // View Raw Tables
   SET DELETED OFF
   XBROWSER cPath + "SCLIENTS.DBF"
   XBROWSER cPath + "SITEMS.DBF"

return nil

//----------------------------------------------------------------------------//

INIT PROCEDURE PrgInit

   RDDSETDEFAULT( "DBFCDX" )
   SET DELETED ON

   SET DATE ITALIAN
   SET CENTURY ON
   SET TIME FORMAT TO "HH:MM:SS"

   FWNumFormat( "E", .t. )
   SetGetColorFocus()

return

//----------------------------------------------------------------------------//
//----------------------------------------------------------------------------//
// TCLIENTS CLASS DERIVED FROM TDATASEQ in TSEQ.PRG
//----------------------------------------------------------------------------//

CLASS TClients FROM TDataSEQ

   METHOD New() CONSTRUCTOR
   METHOD Browse()
   METHOD EditDlg( oRec )
   METHOD ValidRec( oRec )
   METHOD CreateDBF( cName )

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New() CLASS TClients

   local cDBF := cPath + "SCLIENTS.DBF"

   if !File( cDbf ); ::CreateDBF( cDbf ); endif
   ::Super:New( cDBF, "CLIENTID" ) // dbfName, KeyField

return Self

//----------------------------------------------------------------------------//

METHOD Browse() CLASS TClients

   local oSelf := Self
   local oDlg, oFont, oBrw, oRec

   DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
   DEFINE DIALOG oDlg SIZE 700,500 PIXEL TRUEPIXEL FONT oFont TITLE "Clients"

   @ 60,20 XBROWSE oBrw SIZE -20,-20 PIXEL OF oDlg DATASOURCE Self ;
      COLUMNS "ClientID", "First", "Last", "City" CELL LINES NOBORDER

   oBrw:CreateFromCode()

   @ 20, 20 BTNBMP PROMPT "New"    SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:EditSource( .T. )
   @ 20,140 BTNBMP PROMPT "Edit"   SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:EditSource()
   @ 20,260 BTNBMP PROMPT "Duplicate" SIZE 100,35 PIXEL OF oDlg FLAT ;
      ACTION ( oRec  := oSelf:Record( .t. ), ;
               oRec:Paste( oSelf:Record() ), ;
               oRec:oBrw := oBrw, ;
               oRec:Edit() )
   @ 20,380 BTNBMP PROMPT "Delete" SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:Delete()

   ACTIVATE DIALOG oDlg CENTERED
   RELEASE FONT oFont

return Self

//----------------------------------------------------------------------------//

METHOD EditDlg( oRec ) CLASS TClients

   local oSelf := Self
   local oDlg, oFont, oBmp, oBmp3, nID
   local lExit    := .f.

   oRec:bValid    := { |o| oSelf:ValidRec( o ) }

   DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
   DEFINE DIALOG oDlg SIZE 400,240 PIXEL TRUEPIXEL FONT oFont ;
      TITLE If( oRec:RecNo == 0, "NEW CLIENT", "EDIT CLIENT" )

   @  40, 40 SAY "ClientID :" GET oRec:ClientID SIZE 300,26 PIXEL OF oDlg UPDATE READONLY
   @  70, 40 SAY "First    :" GET oRec:First    SIZE 300,26 PIXEL OF oDlg UPDATE
   @ 100, 40 SAY "Last     :" GET oRec:Last     SIZE 300,26 PIXEL OF oDlg UPDATE
   @ 130, 40 SAY "City     :" GET oRec:City     SIZE 300,26 PIXEL OF oDlg UPDATE

if l3BtnStyle
   @ 180, 40 BTNBMP oBmp PROMPT "SAVE"  SIZE 090,30 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
      ACTION ( oRec:Save( .t. ), oDlg:Update() )

   @ 180,150 BTNBMP oBmp PROMPT "UNDO"  SIZE 090,30 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
      ACTION ( oRec:Undo(), oDlg:Update() )

   @ 180,260 BTNBMP oBmp3 PROMPT { || If( oRec:Modified, "CANCEL", "CLOSE" ) } ;
      SIZE 090,30 PIXEL OF oDlg FLAT UPDATE ;
      WHEN ( oBmp3:Refresh(), .t. ) ;
      ACTION ( If( oRec:RecNo == 0, oSelf:ResetID( Val( oRec:ClientID ) ), ), ;
               lExit := .t., oDlg:End() )
   oBmp:lCancel   := .t.
else
   @ 180, 40 BTNBMP oBmp PROMPT "SAVE"  SIZE 100,35 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
      ACTION If( oRec:Save( .t. ), ( lExit := .t., oDlg:End() ), nil )

   @ 180,260 BTNBMP oBmp PROMPT "CANCEL" SIZE 100,35 PIXEL OF oDlg FLAT ;
      ACTION ( If( oRec:RecNo == 0, oSelf:ResetID( Val( oRec:ClientID ) ), ), ;
               lExit := .t., oDlg:End() )
   oBmp:lCancel   := .t.
endif

   ACTIVATE DIALOG oDlg CENTERED VALID ( lExit )
   RELEASE FONT oFont

return nil

//----------------------------------------------------------------------------//

METHOD ValidRec( oRec ) CLASS TClients

   if Empty( oRec:First ) .or. Empty( oRec:Last ) .or. Empty( oRec:City )
      MsgAlert( "First, Last, City can not be empty", "INVALID RECORD" )
      return .f.
   endif

return ::UniqueValue( oRec:First -"|"- oRec:Last, "FIRSTLAST", oRec:RecNo, .t. )

//----------------------------------------------------------------------------//

METHOD CreateDBF( cName ) CLASS TClients

   field FIRST,LAST
   local aStruct  :=  { ;
      { "ROWID",     "+", 6, 0 }, ;
      { "CREATEDT",  "T", 8, 0 }, ;
      { "UPDATEDT",  "=", 8, 0 }, ;
      { "CLIENTID",  "C", 4, 0 }, ;
      { "FIRST",     "C",20, 0 }, ;
      { "LAST",      "C",20, 0 }, ;
      { "CITY",      "C",20, 0 }  }

   DBCREATE( cName, aStruct, "DBFCDX", .T., "SD" )
   FW_CdxCreate()
   INDEX ON UPPER( FIRST-"|"-LAST ) TAG FIRSTLAST
   CLOSE SD

return nil

//----------------------------------------------------------------------------//
// TITEMS CLASS DERIVED FROM TDATASEQ in TSEQ.PRG
//----------------------------------------------------------------------------//

CLASS TItems FROM TDataSEQ

   METHOD New() CONSTRUCTOR
   METHOD Browse()
   METHOD EditDlg( oRec )
   METHOD ValidRec( oRec )
   METHOD CreateDBF( cName )

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New() CLASS TItems

   local cDBF := cPath + "SITEMS.DBF"

   if !File( cDbf ); ::CreateDBF( cDbf ); endif

   ::Super:New( cDBF, "ITEMID" ) // DbfName, KeyField

return Self

//----------------------------------------------------------------------------//

METHOD Browse() CLASS TItems

   local oSelf := Self
   local oDlg, oFont, oBrw, oRec

   DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
   DEFINE DIALOG oDlg SIZE 700,500 PIXEL TRUEPIXEL FONT oFont ;
      TITLE "Items"

   @ 60,20 XBROWSE oBrw SIZE -20,-20 PIXEL OF oDlg ;
      DATASOURCE Self COLUMNS "ItemID", "ItemName", "Rate", "VAT" ;
      CELL LINES NOBORDER FASTEDIT

   oBrw:CreateFromCode()

   @ 20, 20 BTNBMP PROMPT "New"    SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:EditSource( .T. )
   @ 20,140 BTNBMP PROMPT "Edit"   SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:EditSource()
   @ 20,260 BTNBMP PROMPT "Duplicate" SIZE 100,35 PIXEL OF oDlg FLAT ;
      ACTION ( oRec  := oSelf:Record( .t. ), ;
               oRec:Paste( oSelf:Record() ), ;
               oRec:oBrw := oBrw, ;
               oRec:Edit() )
   @ 20,380 BTNBMP PROMPT "Delete" SIZE 100,35 PIXEL OF oDlg FLAT ACTION oBrw:Delete()

   ACTIVATE DIALOG oDlg CENTERED
   RELEASE FONT oFont

return Self

//----------------------------------------------------------------------------//

METHOD EditDlg( oRec ) CLASS TItems

   local oSelf := Self
   local oDlg, oFont, oBmp, oBmp3, nID
   local lExit    := .f.

   oRec:bValid    := { |o| oSelf:ValidRec( o ) }

   DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-14
   DEFINE DIALOG oDlg SIZE 400,240 PIXEL TRUEPIXEL FONT oFont ;
      TITLE If( oRec:RecNo == 0, "NEW CLIENT", "EDIT CLIENT" )

   @  40, 40 SAY "ItemID   :" GET oRec:ItemID   SIZE 300,26 PIXEL OF oDlg UPDATE READONLY

   @  70, 40 SAY "ItemName :" GET oRec:ItemName SIZE 300,26 PIXEL OF oDlg UPDATE ;
         VALID ::UniqueValue( oRec:ItemName, "ITEMNAME", oRec:RecNo, .t. )

   @ 100, 40 SAY "Rate     :" GET oRec:Rate     SIZE 300,26 PIXEL OF oDlg UPDATE ;
         PICTURE "@E 99,999.99" RIGHT VALID oRec:Rate > 0.0

   @ 130, 40 SAY "VAT %    :" GET oRec:Vat      SIZE 300,26 PIXEL OF oDlg UPDATE ;
         PICTURE "@E 99.99 %" RIGHT VALID oRec:Vat >= 0.0

if l3BtnStyle
   @ 180, 40 BTNBMP oBmp PROMPT "SAVE"  SIZE 090,30 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
      ACTION ( oRec:Save( .t. ), oDlg:Update() )

   @ 180,150 BTNBMP oBmp PROMPT "UNDO"  SIZE 090,30 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
      ACTION ( oRec:Undo(), oDlg:Update() )

   @ 180,260 BTNBMP oBmp3 PROMPT { || If( oRec:Modified, "CANCEL", "CLOSE" ) } ;
      SIZE 090,30 PIXEL OF oDlg FLAT UPDATE ;
      WHEN ( oBmp3:Refresh(), .t. ) ;
      ACTION ( If( oRec:RecNo == 0, oSelf:ResetID( Val( oRec:ItemID ) ), ), ;
               lExit := .t., oDlg:End() )
   oBmp:lCancel   := .t.
else
   @ 180, 40 BTNBMP oBmp PROMPT "SAVE"  SIZE 100,35 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
      ACTION If( oRec:Save( .t. ), ( lExit := .t., oDlg:End() ), nil )

   @ 180,260 BTNBMP oBmp PROMPT "CANCEL" SIZE 100,35 PIXEL OF oDlg FLAT ;
      ACTION ( If( oRec:RecNo == 0, oSelf:ResetID( Val( oRec:ItemID ) ), ), ;
               lExit := .t., oDlg:End() )
   oBmp:lCancel := .t.
endif

   ACTIVATE DIALOG oDlg CENTERED VALID ( lExit )
   RELEASE FONT oFont

return nil
//----------------------------------------------------------------------------//

METHOD ValidRec( oRec ) CLASS TItems

   if Empty( oRec:ItemName ) .or. Empty( oRec:Rate )
      MsgAlert( "ItemName, Rate can not be empty", "INVALID RECORD" )
      return .f.
   endif

return ::UniqueValue( oRec:ItemName, "ITEMNAME", oRec:RecNo, .t. )

//----------------------------------------------------------------------------//

METHOD CreateDBF( cName ) CLASS TItems

   field FIRST,LAST

   DBCREATE( cName, { ;
      { "ROWID",     "+", 6, 0 }, ;
      { "CREATEDT",  "T", 8, 0 }, ;
      { "UPDATEDT",  "=", 8, 0 }, ;
      { "ITEMID",    "C", 8, 0 }, ;
      { "ITEMNAME",  "C",20, 0 }, ;
      { "RATE",      "N", 8, 2 }, ;
      { "VAT",       "N", 5, 2 }  }, ;
      "DBFCDX", .T., "SD" )
   FW_CdxCreate()
   CLOSE SD

return nil

//----------------------------------------------------------------------------//

//----------------------------------------------------------------------------//
// TDATASEQ CLASS: Derive classes for tables from this class
//----------------------------------------------------------------------------//

CLASS TDataSEQ FROM TDatabase

   DATA oSequenza

   DATA cKeyFld, nKeyLen

   METHOD New( cDbf, cKeyFld ) CONSTRUCTOR
   METHOD Browse() INLINE XBrowse( Self )
   METHOD EditDlg( oRec )
   METHOD NextID() INLINE STRZERO( ::oSequenza:NextVal(), ::nKeyLen )
   METHOD ResetID( nID ) INLINE ::oSequenza:Reset( nID )
   METHOD Record()
   METHOD UniqueValue( uValue, cOrder, nRec, lMsg )

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( cDbf, cKeyFld ) CLASS TDataSEQ

   field CREATEDT, UPDATEDT

   ::Super:Open( , cDbf, "DBFCDX", .T. )
   ::cKeyFld      := cKeyFld
   ::nKeyLen      := ::FieldLen( ::FieldPos( ::cKeyFld ) )
   ::oSequenza    := TSequenze():New( ::cFile )
   ::bEdit        := { |oRec| ::EditDlg( oRec ) }

   if ::FieldPos( "CREATEDT" ) > 0 .and. ::FieldPos( "UPDATEDT" ) > 0
      ::bTrigger := { || If( Empty( CREATEDT ), CREATEDT := UPDATEDT, nil ) }
   endif


return Self

//----------------------------------------------------------------------------//

METHOD Record( cFieldList, lNew ) CLASS TDataSEQ

   local oRec, cID, n

   if HB_ISLOGICAL( cFieldList )
      lNew        := cFieldList
      cFieldList  := nil
   endif

   oRec  := TDataRow():New( Self, cFieldList, lNew )
   WITH OBJECT oRec
      :lNavigate     := .f.
      :bEdit         := ::bEdit
      if lNew == .t.
         cID      := ::NextID()
         :SetDefault( ::cKeyFld, cID, .f. )
         :aOrg[ :FieldPos( ::cKeyFld ), 2 ] := cID
      endif
      :FieldReadOnly( ::cKeyFld, .t. )
   END

return oRec

//----------------------------------------------------------------------------//

METHOD UniqueValue( uValue, cOrder, nRec, lMsg ) CLASS TDataSEQ

   local cSaveOrd := ::OrdSetFocus()
   local nSaveRec := ::RecNo()
   local cFoundID := ""
   local nFoundAt := 0
   local lUnique  := .f.
   local c

   DEFAULT nRec := nSaveRec, lMsg := .f.

   ::SetOrder( cOrder )
   if HB_ISCHAR( C := ::OrdKeyVal() )
      uValue   := PadR( cValToChar( uValue ), Len( c ) )
      if "UPPER" $ ::OrdKey()
         uValue   := Upper( uValue )
      endif
   endif
   if ::Seek( uValue )
      nFoundAt := ::RecNo()
      cFoundID := ::FieldGet( ::cKeyFld )
   endif
   ::OrdSetFocus( If( Empty( cSaveOrd ), 0, cSaveOrd ) )
   ::GoTo( nSaveRec )

   lUnique := ( nFoundAt == 0 .or. nFoundAt == nRec )

   if lMsg .and. !lUnique
      MsgAlert(  cFoundID + " has the same value" + CRLF + ;
                 cValToChar( uValue ) , "DUPLICATE" )
   endif

return lUnique

//----------------------------------------------------------------------------//

METHOD EditDlg( oRec ) CLASS TDataSEQ

   oRec:Edit()

return nil


//----------------------------------------------------------------------------//
// TSEQUENZE CLASS
//----------------------------------------------------------------------------//

CLASS TSequenze FROM TDatabase

   METHOD New( cDbf ) CONSTRUCTOR
   METHOD NextVal()
   METHOD Reset( nId )
   METHOD CreateSEQDBF( cPath )

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( cDbf ) CLASS TSequenze

   local cPath    := cFilePath( cDbf )
   local cName    := Upper( cFileNoExt( cDbf ) )
   local cSeqDbf  := cPath + "SEQUENZE.DBF"
   local cFilter  := 'TRIM( FIELD->DBF ) == "' + cName + '"'

   if !File( cSeqDbf )
      ::CreateSEQDBF( cSeqDbf )
   endif

   ::Super:Open( , cSeqDbf, "DBFCDX", .T. )
   ::SetFilter( cFilter )
   ::GoTop()
   if ::Eof()
//      ::Append( "DBF,COUNTER,UNUSED", { cName, 0, {} } )
      //
      ::Append( "DBF,COUNTER", { cName, 0 } )
      ::RecLock()
      ( ::cAlias )->UNUSED := {}
      ::Skip( 0 )
      ::RecUnlock()
      //
      ::GoTop()
   endif

return Self

//----------------------------------------------------------------------------//

METHOD NextVal() CLASS TSequenze

   field COUNTER, UNUSED
   local nID, bAction

   bAction  := <||
      local a := UNUSED
      local nRet
      if !Empty( a )
         nRet  := ATail( a )
         a     := ASize( a, Len( a ) - 1 )
         UNUSED := a
      else
         COUNTER    := COUNTER + 1
         nRet  := COUNTER
      endif
      DBCOMMIT()
      return nRet
      >

   do while .not. ::RecLock()
   enddo

   nID   := ::Exec( bAction )

   ::Unlock()
   ::Load()

return nID

//----------------------------------------------------------------------------//

METHOD Reset( nID ) CLASS TSequenze

   field COUNTER, UNUSED
   local bAction

   bAction := <||
      local a
      if nID == COUNTER
         COUNTER := COUNTER - 1
      elseif nID < COUNTER
         a  := UNUSED
         AAdd( a, nID )
         UNUSED   := a
      endif
      DBCOMMIT()
      return nil
   >

   do while .not. ::RecLock()
   enddo

   ::Exec( bAction )

   ::Unlock()
   ::Load()

return nil

//----------------------------------------------------------------------------//

METHOD CreateSEQDBF( cName ) CLASS TSequenze

   DBCREATE( cName, { ;
      { "DBF",     "C", 20, 0 }, ;
      { "COUNTER", "N", 10, 0 }, ;
      { "UNUSED",  "M", 10, 0 }  }, ;
      "DBFCDX" )

return nil

//----------------------------------------------------------------------------//
 

This approach has the same cons as discussed above, i.e., the IDs generated may not be ascending the chronological order and some IDs in the serial may be missing.

However, the fields RowID (autoincrement), CreateDt, UpdateDt, which are internal to the dbf and not displayed to the user, are in chronologically serial order and are evidence of the genuineness of data.

Please delete any tables like "sclients.*" created by the previous sample, before testing this program

Nages ,
can you explain me what are these types of data ?

{ "ROWID", "+", 6, 0 }, ;
{ "CREATEDT", "T", 8, 0 }, ;


I cannot open the dbf with EmagDbu
when I try with fwdbu I see the structure changed

= { { "ROWID", "+", 4, 0 },;
{ "CREATEDT", "@", 8, 0 },;
{ "UPDATEDT", "=", 8, 0 },;
{ "CLIENTID", "C", 4, 0 },;
{ "FIRST", "C", 20, 0 },;
{ "LAST", "C", 20, 0 },;
{ "CITY", "C", 20, 0 } }

@ instead of T

[nageswaragunupudi]

{ "ROWID", "+", 6, 0 }, ;
{ "CREATEDT", "T", 8, 0 }, ;
{ "UPDATEDT", "=", 8, 0 }, ;

Please keep the above three fields at the beginning of the structure of every table using the above system.

"ROWID" : Field Type "+"
Autoincrement numeric field. DBFCDX automatically increments the value in this field every time a new record is appended. Uniqueness and chronological continuity are assured even in multi-user environments. This field is read-only and we can not write this field or modify the values.

"UPDATEDT" : Field Type "="
This field contains datatime value accurate upto millisecond. DBFCDX automatically updates this field whenever any field in the record is modified, with the latest date and time of modification.

"CREATEDT" : Field Type "T"
'T' stands for DateTime type and stores date and time value upto millisecond. The program I provided to you writes the exact date and time when the record was first created. Later on, this value is not changed and you shoud also not change it.

When reading the DBSTRUCT(), Harbour displays this as "@" instead of 'T', but the functionality is the same. Nothing to worry about it.

[Silvio.Falconi]

>Please keep the above three fields at the beginning of the structure of every table using the above system.

But if I put them at the end of the structure, what does it imply?