A toolbox of netfunctions and tDatabase-tests

A toolbox of netfunctions and tDatabase-tests

Postby ukoenig » Wed Jan 09, 2019 6:48 pm

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.

Image

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

Image

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  RUN

// ---------- 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 :?:
Last edited by ukoenig on Tue Feb 12, 2019 10:40 pm, edited 5 times in total.
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
User avatar
ukoenig
 
Posts: 4043
Joined: Wed Dec 19, 2007 6:40 pm
Location: Germany

Re: A toolbox of netfunctions

Postby James Bott » Thu Jan 17, 2019 10:31 pm

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.
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
User avatar
James Bott
 
Posts: 4840
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA

Re: A toolbox of netfunctions

Postby ukoenig » Fri Jan 18, 2019 3:05 pm

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 :?:
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
User avatar
ukoenig
 
Posts: 4043
Joined: Wed Dec 19, 2007 6:40 pm
Location: Germany

Re: A toolbox of netfunctions

Postby ukoenig » Thu Jan 24, 2019 11:43 am

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  RUN

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)
 


Image

Image

regards
Uwe :?:
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
User avatar
ukoenig
 
Posts: 4043
Joined: Wed Dec 19, 2007 6:40 pm
Location: Germany

Re: A toolbox of netfunctions

Postby James Bott » Thu Jan 24, 2019 4:27 pm

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  RUN
// 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
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
User avatar
James Bott
 
Posts: 4840
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA

Re: A toolbox of netfunctions

Postby James Bott » Thu Jan 24, 2019 4:50 pm

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  RUN
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
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
User avatar
James Bott
 
Posts: 4840
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA

Re: A toolbox of netfunctions

Postby James Bott » Thu Jan 24, 2019 5:38 pm

Uwe,

I forgot to ask, did you get the papers I sent you on object-oriented programming?
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
User avatar
James Bott
 
Posts: 4840
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA

Re: A toolbox of netfunctions

Postby ukoenig » Fri Jan 25, 2019 10:50 am

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  RUN

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

Image

regards
Uwe :?:
Last edited by ukoenig on Sat Jan 26, 2019 9:00 pm, edited 2 times in total.
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
User avatar
ukoenig
 
Posts: 4043
Joined: Wed Dec 19, 2007 6:40 pm
Location: Germany

Re: A toolbox of netfunctions and tDatabase-tests

Postby James Bott » Fri Jan 25, 2019 4:47 pm

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?
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
User avatar
James Bott
 
Posts: 4840
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA

Re: A toolbox of netfunctions and tDatabase-tests

Postby ukoenig » Fri Jan 25, 2019 4:54 pm

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 :D
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
User avatar
ukoenig
 
Posts: 4043
Joined: Wed Dec 19, 2007 6:40 pm
Location: Germany

Re: A toolbox of netfunctions and tDatabase-tests

Postby James Bott » Fri Jan 25, 2019 5:27 pm

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
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
User avatar
James Bott
 
Posts: 4840
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA

Re: A toolbox of netfunctions and tDatabase-tests

Postby ukoenig » Fri Jan 25, 2019 6:00 pm

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 :D
Last edited by ukoenig on Sat Jan 26, 2019 8:56 pm, edited 1 time in total.
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
User avatar
ukoenig
 
Posts: 4043
Joined: Wed Dec 19, 2007 6:40 pm
Location: Germany

Re: A toolbox of netfunctions and tDatabase-tests

Postby James Bott » Fri Jan 25, 2019 6:50 pm

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  RUN
#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
FWH 18.05/xHarbour 1.2.3/BCC7/Windows 10
User avatar
James Bott
 
Posts: 4840
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA

Re: A toolbox of netfunctions and tDatabase-tests

Postby Silvio.Falconi » Sat Jan 26, 2019 2:34 pm

with browse() you cannot show any record


See oCustomers ( tdatabase ) and oCustomer (TdataRow)

Code: Select all  Expand view  RUN
 
 #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
 
Since from 1991/1992 ( fw for clipper Rel. 14.4 - Momos)
I use : FiveWin for Harbour November 2023 - January 2024 - Harbour 3.2.0dev (harbour_bcc770_32_20240309) - Bcc7.70 - xMate ver. 1.15.3 - PellesC - mail: silvio[dot]falconi[at]gmail[dot]com
User avatar
Silvio.Falconi
 
Posts: 7070
Joined: Thu Oct 18, 2012 7:17 pm

Re: A toolbox of netfunctions and tDatabase-tests

Postby ukoenig » Sat Jan 26, 2019 5:19 pm

Silvio,

function Browse() is not compatible with tDatabase.

tested from inside the tool

Image

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

Image

regards
Uwe :D
Last edited by ukoenig on Sun Jan 27, 2019 2:26 pm, edited 4 times in total.
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
User avatar
ukoenig
 
Posts: 4043
Joined: Wed Dec 19, 2007 6:40 pm
Location: Germany

Next

Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 49 guests