Page 1 of 3

to Nages: test for tdatabase

Posted: Fri Apr 26, 2019 11:29 am
by Silvio.Falconi
I saw your test and run ok ( NextID)
it is used only for Sclienti.dbf
How i can to use the same system for other archives ?
Must I create a control.dbf for each dbf ?

Regards

Re: to Nages: test for tdatabase

Posted: Fri Apr 26, 2019 12:28 pm
by nageswaragunupudi
We can have one control file for many DBFs
I will post a sample to work with more DBFs
I will also change the name of the control file and some classes
You can then use that revised sample as a final template

Re: to Nages: test for tdatabase

Posted: Fri Apr 26, 2019 1:03 pm
by Silvio.Falconi
Do you remember my idea function?

I know it was very elementary written by a child but maybe it could work

besides the various archives I had also thought about the different lengths of the code
because each archive could have different dimensions

example

customers ---> 0001
Invoices -----> 0000000001

Re: to Nages: test for tdatabase

Posted: Fri Apr 26, 2019 2:21 pm
by Silvio.Falconi
Nages
on the test I add a new Method to duplicate a record ( seem run ok)

@ 20,360 BTNBMP PROMPT "Duplicate" SIZE 100,35 PIXEL OF oDlg FLAT ;
ACTION oClients:Duplicate(oClients)

Code: Select all

METHOD Duplicate(oClients) CLASS TClients
   Local oClienteTemp   := oClients:Record()
   Local oClienteNew

       oClienteTemp:Copy()
       oClienteNew   := oClients:Record( , .t. )
       oClienteNew:Paste() 
       oClienteNew:Edit()

   return nil
only not refresh the xbrowser ( id) when save or not) I thinked the index is on ID ....

Re: to Nages: test for tdatabase

Posted: Sat Apr 27, 2019 1:03 pm
by Otto
Hello Silvio,

I would suggest for better understanding this program insert following code.

@ 150, 40 BTNBMP PROMPT "SAVE" SIZE 100,35 PIXEL OF oDlg FLAT WHEN oRec:Modified() ;
ACTION ( oRec:City := dtos( date() ) + "/" + time() ,oRec:Save(), lExit := .t., oDlg:End() )

The customer numbers are one after the other but chronology is not guaranteed.

Best regards
Otto

Image

Re: to Nages: test for tdatabase

Posted: Sat Apr 27, 2019 1:33 pm
by nageswaragunupudi
Dear Friend Silvio

The inherent problem in this approach is that the IDs are not chronologically in ascending order and there can be gaps in the serial order.

In case of invoices, invoice numbers not being in serial order would be highly objectionable. Some programmer friends even felt that such database may be viewed with suspicion by tax authorities.

You were always insisting on displaying the next serial number in the append dialog. None of us can guess what exactly will be the next serial number in chronological order when the new record is saved in a multi-user environment. This can be known only when the new record is appended.

I remember very well that you refused all advices in this regard. Even at the risk of you blaming me also, I would reuest you once again re-consider your insistence to display the next serial in the append dialog even before saving it.

Re: to Nages: test for tdatabase

Posted: Sat Apr 27, 2019 5:30 pm
by TimStone
Mr. Rao,

I suppose ID’s are the same as account numbers. In many cases they are just a field for quick connection of data and I’m not sure why chronological order would be of any value. However, with invoices, you certainly want them in the exact order created.

I use a Counters.dbf that has one record and it contains the latest assigned number in fields for each ID assigned ( ie. Workorder/Invoice, customer number, accounting, etc ). Since I have classes for each process like work orders, my Add() method appends a record, fills the buffers with blanks, then goes to the counter dbf, increments the proper number, saves the value back to the record, and saves it to the appended record. The interaction with the counters file takes a fraction of a second and that is never an issue in multi-user environments.

It is important to not have gaps, especially in invoices. Customer data, parts and labor, and all other info is assigned after the record is created, so if one were started accidentally it could still be used for another job. The first part of the workorder process is to create an estimate. If the work is refused, I tell my clients to make a note on the invoice, have the customer sign it, then save the result. Thus, in an audit, there are never anyone holes.

I’ve done this for over 30 years in multi-user environments and never had a problem with assigning the IDs nor have any of my clients ever had problems with audits.

I think your points are very valid.

Re: to Nages: test for tdatabase

Posted: Sat Apr 27, 2019 6:13 pm
by nageswaragunupudi
I suppose ID’s are the same as account numbers. In many cases they are just a field for quick connection of data and I’m not sure why chronological order would be of any value.
Agree.
That is what the already posted Clients sample does.
However, with invoices, you certainly want them in the exact order created.
Yes.
I use a Counters.dbf that has one record and it contains the latest assigned number in fields for each ID assigned ( ie. Workorder/Invoice, customer number, accounting, etc ). Since I have classes for each process like work orders, my Add() method appends a record, fills the buffers with blanks, then goes to the counter dbf, increments the proper number, saves the value back to the record, and saves it to the appended record. The interaction with the counters file takes a fraction of a second and that is never an issue in multi-user environments.
Even the above Clients sample uses control.dbf same way you are using counters.dbf.
Oracle does not have autoincrement field type. It uses Sequences, which are virtual tables with the same logic as your counters.dbf.

Till DBFCDX introduced AutoIncrement field type, we all had to adopt some similar logic to generate sequence numbers. All this logic is no more required if we use AutoIncrement fields.

Here is the important difference:
You are fetching the incremented value at the time of appending the record.

Here we are required to fetch the incremented value in advance and display it in the Append Dialog without being sure whether the user will save or cancel the append and whether other users save their appends prior to or after this user's save. This results in numbers not being in chronological order.

Re: to Nages: test for tdatabase

Posted: Sat Apr 27, 2019 6:34 pm
by 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

For invoices, the invoice number must be associated with the invoice date
In Italy the art. 21 of Presidential Decree 633/1972 establishes the minimum elements that an invoice must contain, so that it can be considered validly issued. In the most serious cases the financial administration can also contest the false invoicing, with implications of a criminal nature (Article 2 and 3 of Legislative Decree 74/2000)

Minimum elements of an invoice:

issuing date;
progressive number that uniquely identifies it;
and other data customer,articles , total, vat

Re: to Nages: test for tdatabase

Posted: Sat Apr 27, 2019 8:04 pm
by Silvio.Falconi
nageswaragunupudi wrote:Dear Friend Silvio

The inherent problem in this approach is that the IDs are not chronologically in ascending order and there can be gaps in the serial order.

In case of invoices, invoice numbers not being in serial order would be highly objectionable. Some programmer friends even felt that such database may be viewed with suspicion by tax authorities.

You were always insisting on displaying the next serial number in the append dialog. None of us can guess what exactly will be the next serial number in chronological order when the new record is saved in a multi-user environment. This can be known only when the new record is appended.

I remember very well that you refused all advices in this regard. Even at the risk of you blaming me also, I would reuest you once again re-consider your insistence to display the next serial in the append dialog even before saving it.
I had only asked to have some compatibility with the old application.
the user at the time of edit saw in the dialog the user code as you did in the test

Image

Re: to Nages: test for tdatabase

Posted: Mon Apr 29, 2019 3:06 pm
by TimStone
The legal requirements would be met by data saved in the fields, ie. InvoiceNumber, InvoiceDate, InvoiceTime, Customer, Address, etc.

As for the control file, one field could be set for each category, and the size of the field denotes the number it could hold, ie. "invoice", N, 10; "customer", N, 6; "inventory", N, 8; etc.

Re: to Nages: test for tdatabase

Posted: Mon Apr 29, 2019 9:32 pm
by Silvio.Falconi
yes everything is fine but I do not prefer to talk to You mr Tm after the last messages we have had it seems to me that I have spoken clearly, You have a ideas, I have my own: I even had to suffer from your even of the offensive accusations now you have the courage to intrude and give advice: I have no words !!!

Re: to Nages: test for tdatabase

Posted: Tue Apr 30, 2019 12:57 am
by nageswaragunupudi
Silvio.Falconi wrote: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
Silvio.Falconi wrote: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

#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

Re: to Nages: test for tdatabase

Posted: Tue Apr 30, 2019 7:35 am
by Silvio.Falconi
Thank you Rao for the test
I tried with my tablet windows even if I am in hospital because I had an assault for a car park under my house: tachycardia and nasiotic state keep me here in the hospital under observation but I can use the tablet lenovo and I answer you that:

1) when I entered customers or items after pressing save the test does not return to xbrowse

2) this is the same even when I duplicate

3) not knowing the new commands "T" and "=" and "+" I would not have problems with these types of files but if you say that it is ok I trust you

4) in the delete function the record is deleted but in xbrowse a trace remains as you can see in this figure: I had deleted that record !!!

Image

obviously this is a test I know so something is not yet defined


This morning I feel better even though the doctors say I still have a bit of tachycardia

thank You
however, the function of undo is beautiful

Re: to Nages: test for tdatabase

Posted: Tue Apr 30, 2019 7:46 am
by nageswaragunupudi
Please take care of your health first.
We will discuss after your discharge. Please also do not work in the hospital.
Wish you get well very soon.