A toolbox of netfunctions and tDatabase-tests

[ukoenig]

Hello,

I'm working on a toolbox of netfunctions to control
any network-error.

You can open a DBF twice and test the different netfunctions.

Sample 1 : trying to ZAP a DBF
it will show your own defined error-messages.



Sample 2 : trying to RECALL a record that is in use
it will show your own defined error-messages.



I hope it will be usable.

// ---------- NET - FUNCTIONS ----------------------------
// --------------------------------------------------------------------

FUNCTION NET_USE ( cDBName, cAlias, nTrials, lNet )
FUNCTION NET_RLOCK( nTrials )
FUNCTION NET_ULOCK()
FUNCTION NET_FLOCK ( nTrials )
FUNCTION NET_WAIT ( nTrials )
FUNCTION SHOW_WAIT( nTrials, oMeter, oText1 )
FUNCTION NET_DELETE ( nTrials )
FUNCTION NET_RECALL ( nTrials )
FUNCTION NET_APPEND ( nTrials )
FUNCTION NET_PACK( cDBName, cAlias, nTrials )
FUNCTION NET_PACK1( cDBName, cAlias, nTrials )
FUNCTION PACK1()
FUNCTION NET_ZAP( cDBName, cAlias, nTrials )
FUNCTION ZAP1()
FUNCTION NET_CLOSE( nTrials )
FUNCTION NET_ORDER
FUNCTION NET_COPY ( cALIAS, nStart, nEnd, nTrials )

sample : open a DBF

Code: Select all  Expand view

// ---------- NET - FUNCTIONS ----------------------------
// --------------------------------------------------------------------

FUNCTION NET_USE ( cDBName, cAlias, nTrials, lNet )
LOCAL lReturn   := .T.
LOCAL lOpen     := .F.
LOCAL nTrcount  := nTrials
LOCAL YesNo := .F.

// SHARED    all Users
// EXCLUSIVE  1 User

IF !File( cDBName )
    nMsgBox ("File -> " + cDBName + " is missing !", "Attention !")
    SET RESOURCES to
    set _3DLOOK OFF
    FreeLibrary()
    CLOSE DATABASE
    QUIT
ENDIF

DO WHILE nTrcount <= nTrials
    IF !lNet
        USE &cDBName ALIAS &cAlias NEW VIA "DBFCDX" EXCLUSIVE
    ELSE
        USE &cDBName ALIAS &cAlias NEW VIA "DBFCDX" SHARED
    ENDIF
    IF !NETERR()
        lReturn   := .T.
    ELSE
        IF lNet = .T.
            Status := "SHARED"
        ELSE
            Status := "EXCLUSIVE"
        ENDIF
        IF nTrcount = nTrials
            xName := WNetGetUser()
            IF MsgYesNo( "Open " + Status + "  of " + upper(cDBName) + " not possible !" + ;
                                         " try again ?", "Network-error -> &xName !" )
                nTrials := nTrcount
                IF nTrials > 0  
                    NET_WAIT ( nTrcount, nTrials )
                ENDIF
            ELSE
                lReturn   := .F.
                EXIT
            ENDIF
        ENDIF
    ENDIF
    nTrials --
ENDDO

RETURN lReturn
 

regards
Uwe

[James Bott]

Uwe,

You should be using database objects. Some messaging is already built into TDatabase. If those don't meet your desires then you can subclass and write your own. This much easier than calling a bunch of functions each time you try to lock or save a record. You just do oCustomer:save() and it locks, saves, and unlocks with messaging and retrys if the lock fails. Simple, one line of code.

Users don't know or care how or where the data resides so I wouldn't be giving them types of messages you are. Give them something simple like "Update failed to complete, try again?" They don't care why or the path and name of the data file.

[ukoenig]

James,

I had a look at TDatabase.
That looks much better and I will rebuild my sample
switching from the old fashion way to TDatabase.
Is there somewhere a recommended sample about the usage ?
I found only little solution parts inside the forum.

regards
Uwe

[ukoenig]

I finished sample 1 and started with a second one using TDataBase()
testing the netfunctions.
It is the first time testing TDataBase() and i might be wrong
and I have to do some changes.

Maybe a language-support is possible like ?

METHOD Recall(cMsg1, cMsg2) CLASS TDataBase
MsgAlert( cMsg1, cMsg2 )
//MsgAlert( "DataBase in use", "Please try again" )

I noticed a problem with PACK and ZAP
( all other functions are working )

I tested to change from SHARED to EXCLUSIVE because of testing PACK and ZAP.
A errormessage is shown ( that is Ok ). But in case of a error it must stay SHARED !!!
But the status changes to EXCLUSIVE even with the errormessage and crashes on exit-button.
Opening as a single user it is Ok.

I think the problem belongs to :

METHOD Open( cAlias, cFile, cDriver, lShared, lReadOnly, cPassword ) CLASS TDataBase

::Use()

METHOD Use() CLASS TDataBase
...
...
if ::td_ExecLoop( { || dbUseArea( .t., ::cDriver, ::cFile, ::cAlias, ::lShared, ::lReadOnly ) }, ;
"Unable to open " + ::cFile + ". Retry?" )
::SetArea( Select() )
SELECT 0
else
::nArea := 0
::cAlias := ""

return .f.
endif
...
...
return ::Used()

Code: Select all  Expand view

FUNCTION NET_PACKZAP(nStyle)

MsgAlert( oCust:lShared() ) // .T. SHARED ok
oCust:Close()
oCust:= TDataBase():Open( ,"CUSTOMER.dbf", "DBFCDX", .F. ) // try open EXCLUSIVE
// Errormessage but oCust:lShared() shows .F. ( exclusive )
MsgAlert( oCust:lShared() ) // shows .F. !!! and crashes

IF oCust:lShared() = .F.
    IF nStyle = 1
        oCust:Pack()
    ELSE
        oCust:Zap()
    ENDIF
ELSE
    MsgAlert( "Not possible to open EXCLUSIVE" )
ENDIF

// back opening SHARED
oCust:Close()
oCust:= TDataBase():Open( "CUST", "CUSTOMER", "DBFCDX", .T. )  

RETURN( NIL)
 

regards
Uwe

[James Bott]

Uwe,

The code below packs the file just fine.

Your error message indicates that the file was not open. Did you have it open elsewhere in your program? You can't have it open in a browse and then open it again in exclusive use.

James

Code: Select all  Expand view

// Test TDatabase:pack()

#include "fivewin.ch"

Function Main()

    use customer
    copy to temp
    use temp
    delete all
    close
   
    oCustomers:= TDatabase():New(,"temp",,.f.)
    oCustomers:use()
   
    msgInfo( oCustomers:used(),"oCustomers:used()")  // Returns .T.
   
    if oCustomers:used()
       msgInfo( oCustomers:lShared, "oCustomers:lShared")  // Returns .F.
       oCustomers:pack()
    endif
    msgInfo("Done packing.")

Return nil

[James Bott]

Uwe,

Also you must have oCust declared as a static because you didn't pass it. I don't recommend using statics.

And I don't recommend calling functions to manipulate the database. If you want to modify the database's behavior then create a subclass and override a method (like Zap()).

Code: Select all  Expand view

Class MyDatabase from TDatabase
   Method Zap()
Endclass

Method Zap() Class MyDatabase
    Local lSuccess:=.F.
    if ! :lShared
       ::super:zap()
       lSuccess := .T.
    else
       msgInfo("File busy now. Cannot zap().", "Information")
    endif
Return lSuccess

[James Bott]

Uwe,

I forgot to ask, did you get the papers I sent you on object-oriented programming?

[ukoenig]

James,

Thank You very much. I received Your Emails.

Next I tested Your PACK-sample.
Packing works, but I need something more :
after PACK I have to close EXCLUSIVE and switch back to SHARED to refresh xBrowse.
Adding these two missing steps I noticed a problem.

Application
===========
Error description: Error BASE/1002 Alias does not exist: CUST

Stack Calls
===========
Called from: .\TDATAB.PRG => (b)DATABASE( 135 )
Called from: .\source\classes\XBROWSE.PRG => TXBROWSE:CHANGE( 1786 )

From inside the created netfunction-section ( part 1 ) it works.
the needed steps :

USE
USE "Customer" ALIAS "Cust" NEW VIA "DBFCDX" EXCLUSIVE
PACK
USE
USE "Customer" ALIAS "Cust" NEW VIA "DBFCDX" SHARED

Code: Select all  Expand view

FUNCTION NET_PACK( cDBName, cAlias, nTrials )
LOCAL  lReturn := .F., nReturn := 0
LOCAL nTrcount := nTrials

IF MsgYesNo( "Pack File : " + upper(cDBName) , "DBF Pack !" )
    act_ord := NET_ORDER()
    SET FILTER TO
    SET INDEX TO
    DO WHILE nTrCount <= nTrials .and. nTrcount > 0
        IF NET_CLOSE( nTrials ) = .F.
            nReturn = 2
            EXIT
        ELSE
            // .T. = SHARED    all Users
            // .F. = EXCLUSIVE  1 User
            IF NET_USE ( cDBName, cAlias, nTrials, .F. )            // EXCLUSIVE
                MsgRun( "Pack File :  " + upper(cDBName),  "Please wait.......",;
                { || PACK1() } )
                IF NET_CLOSE( nTrcount ) = .T.
                    IF NET_USE ( cDBName, cAlias, nTrials, .T. )    // SHARED
                        nReturn = 1
                        EXIT
                    ENDIF
                ENDIF
            ENDIF
            nTrcount --
            IF nTrcount <= nTrials
                NET_USE ( cDBName, cAlias, nTrials, .T. )       // SHARED
                nReturn = 2
                EXIT
            ENDIF
        ENDIF

        nTrcount --

    ENDDO
ENDIF

IF nReturn = 1
    MsgWait( "File : " + cDBName + "  packed !", "Attention !", 1 )
    lReturn := .T.
ENDIF
IF nReturn = 2
    MsgAlert( "ERROR pack File : " + cDBName, "Attention !", 1 )
ENDIF

RETURN (lReturn)
 

Now it is possible to switch between the different tests



regards
Uwe

[James Bott]

Uwe,

Next I tested Your PACK-sample.
Packing works, but I need something more :
after PACK I have to close EXCLUSIVE and switch back to SHARED to refresh xBrowse.
Adding these two missing steps I noticed a problem.

Error description: Error BASE/1002 Alias does not exist: CUST

Well I can't help much without seeing your code.

From the error message I assume you are using the alias "CUST." Database objects generate their own alias so you can't specify a different one. Well, actually you can but you shouldn't. Unique aliases are automatically generated each time a database object is opened--and you can open multiple copies of a database object (even in the same function).

Did you use the code I posted for your test?

[ukoenig]

James,

Yes I tested Your sample.

I will post the complete tool with a download-link.
With that it will be possible to have something useful to work on.

regards
Uwe

[James Bott]

Uwe,

I just noticed that the error occurred in xBrowse. I suspect you specified "CUST" was the alias. You need to do this to specify that the browse is using a database object:

oBrw:SetoDBF( oDatabase ) // where oDatabase is whatever name you have used for the database object

oBrw gets the alias from there.

James

[ukoenig]

James,

here is the downloadlink
still some improvements must be done
but the basics are working.

DOWNLOAD

http://www.pflegeplus.com/DOWNLOADS/Network.zop

regards
Uwe

[James Bott]

Uwe wrote:
cAlias := cGetNewAlias( "CUST" )
USE CUSTOMER NEW ALIAS (cAlias) SHARED VIA "DBFCDX"
oCust := TDataBase():New( Select( cAlias ) )

The above should be this simple:

oCustomers:= TCustomers():New()

You need to create a class for each file and the class name should be plural (Customers for tables)
Later you will want to create record classes and they should be singular (Customer)

Forget aliases--you will rarely, if ever, need to use them again.

Code: Select all  Expand view

#include "fivewin.ch"

Function Main()
   local oCustomers
   
   oCustomers:= TCustomers():New()  // simple, one line. File is open in shared mode.
                                    // Indexes are open, in rimary key index order, at top of file
                                    // One line!
   // Display first 3 customer names
   for i = 1 to 3
      msgInfo( oCustomers:Name, "Customer Name")
      oCustomers:skip()
   next
   
   browse()
   
Return nil

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

Class TCustomers from TDatabase
   Method New()
Endclass

Method New(lShared) Class TCustomers
   Default lShared := .T.
   ::super():New(,"customer",,lShared)
   if ::use()
      ::setOrder(1)
      ::gotop()
   endif
Return self

[Silvio.Falconi]

with browse() you cannot show any record


See oCustomers ( tdatabase ) and oCustomer (TdataRow)

Code: Select all  Expand view

 
 #include "fivewin.ch"

    Function Main()
       local oCustomers

       oCustomers:= TCustomers():New()  // simple, one line. File is open in shared mode.
                                        // Indexes are open, in primary key index order, at top of file
                                        // One line!

         xbrowser oCustomers TITLE "Customer"


       // Display first 3 customer names  with TdataRow

       ocustomer:=TCustomer():New(oCustomers)  //TdataRow

        for i = 1 to 3
           msgInfo( ocustomer:first, "Customer Name")
        *   oCustomer:skip()
       next


    Return nil

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

    Class TCustomers from TDatabase
       Method New()
    Endclass

    Method New(lShared) Class TCustomers
       Default lShared := .T.
       ::super():New(,"customer",,lShared)
       if ::use()
          ::setOrder(1)
          ::gotop()
       endif
       Return self
  //---------------------------------------------------------------------------//
      CLASS TCustomer From  TDataRow
          Method New()
       ENDCLASS

      Method New(oTable )
         ::super:New( oTable )
     Return self
 

[ukoenig]

Silvio,

function Browse() is not compatible with tDatabase.

tested from inside the tool



also You can use from folder < samples > xbradded.prg
next select tDatabase and You can browse the file customer.



regards
Uwe