PROCEDURE DBUPRO
* dbupro Unterprog Datenbanken lesen und Verarbeiten
set procedure to dbupro
parameters dat,ind,upfehl,schalt,upfunk
if vnetz = 'J'         && netz j,n
************************************************************************
if upfunk = 1          && 1 = use,2=Satzsperren,3=append
   if Schalt = 'E'        && E= exclusive  (z.B. bei reorg wenn upfunk=1)
      stor .T. to vara
   else
      stor .F. to vara
   endif
stor 0 to upfehl
stor '1' to schleife
do while schleife = '1'
   if net_use("&dat",vara,.5)
      if ind # space(8)
      set index to &ind
      endif
      stor '2' to schleife
   else
      clear
      text
      Die Datenbank wird zur Zeit von einem anderen Benutzer des Netzwerkes
      ge„ndert.
      Die Benutzung ist daher zur Zeit nicht m”glich.
      Geben Sie bitte eine 1 ein, wenn der Zugriff erneut versucht
      werden soll.
      endtext
      ? '   Datenbankname = ',dat
      SET CONS OFF
      WAIT to schleife
      SET CONS ON
      if schleife # '1'
         stor 1 to upfehl
         exit
      endif
**-->
      clear
      stor 0 to upfehl
   endif
enddo
endif
*********************************************************************
if upfunk = 2                && 2 = Satzsperren
stor 0 to upfehl
stor '1' to schleife
do while schleife = '1'
   if REC_LOCK(.5)
      stor 0 to upfehl
      stor '2' to schleife
   else
      clear
      text
      Der angeforderte Datensatz kann zur Zeit nicht ge„ndert werden, da
      ein anderer Benutzer diesen Satz angefordert hat.
      Die Žnderung ist daher zur Zeit nicht m”glich.
      Geben Sie bitte eine 1 ein, wenn der Zugriff erneut versucht
      werden soll.
      endtext
      ? '   Datensatz     = ',recno()
      SET CONS OFF
      WAIT to schleife
      SET CONS ON
      if schleife # '1'
         stor 1 to upfehl
         exit
      endif
*-->
      clear
      stor 0 to upfehl
   endif
enddo
endif
************************************************************************
if upfunk = 3            && 3 = einfgen
   stor 0 to upfehl
   stor '1' to schleife
   do while schleife = '1'
      if ADD_REC(.5)
         stor 0 to upfehl
         stor '2' to schleife
      else
         clear
         text
         Der angeforderte Datensatz kann zur Zeit nicht eingefgt werden, da
         ein anderer Benutzer S„tze gerade einfgt.
         Die Žnderung ist daher zur Zeit nicht m”glich.
         Geben Sie bitte eine 1 ein, wenn der Zugriff erneut versucht
         werden soll.
         endtext
         ? '   Datensatz     = ',recno()
         SET CONS OFF
         WAIT to schleife
         SET CONS ON
         if schleife # '1'
            stor 1 to upfehl
            exit
         endif
*-->
         clear
         stor 0 to upfehl
       endif
enddo
endif
else
stor 0 to upfehl
************************
if upfunk = 1
   use &dat
   if ind # space(8)
   set inde to &ind
endif
************************
endif
************************
if upfunk = 3
   appe blank
endif
************************
endif
retu
****---------------------------------
FUNCTION Net_use
PARAMETERS file, ex_use, wait
PRIVATE forever

forever = (wait = 0)
DO WHILE (forever .OR. wait > 0)

   IF ex_use                    && exclusive
      USE &file EXCLUSIVE
   ELSE
      USE &file                 && shared
   ENDIF

   IF .NOT. NETERR()           && USE succeeds
      RETURN (.T.)
   ENDIF

   INKEY(1)                     && wait 1 second
   wait = wait - 1
ENDDO
RETURN (.F.)                    && USE fails
*****------------------
FUNCTION REC_LOCK
PARAMETERS wait
PRIVATE forever

IF RLOCK()
   RETURN (.T.)         && locked
ENDIF

forever = (wait = 0)
DO WHILE (forever .OR. wait > 0)

   IF RLOCK()
      RETURN (.T.)              && locked
   ENDIF

   INKEY(.5)                    && wait 1/2 second
   wait = wait - .5

ENDDO
RETURN (.F.)                    && not locked
**---------------------------------
* End - REC_LOCK
****
*   ADD_REC function
*
*  Returns true if record appended.  The new record is current
*  and locked.
*  Pass the following parameter
*    1. Numeric - seconds to wait (0 = wait forever)
*

FUNCTION ADD_REC
PARAMETERS wait
PRIVATE forever

APPEND BLANK
IF .NOT. NETERR()
   RETURN (.T.)
ENDIF

forever = (wait = 0)
DO WHILE (forever .OR. wait > 0)

   APPEND BLANK
   IF .NOT. NETERR()
      RETURN .T.
   ENDIF

   INKEY(.5)                    && wait 1/2 second
   wait = wait - .5

ENDDO
RETURN (.F.)                    && not locked
RETURN