home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1993 #2 / Image.iso / clipper / cl52bus.zip / DBUNET.PRG < prev    next >
Text File  |  1993-06-10  |  9KB  |  346 lines
  1. /***
  2. *
  3. *  Dbunet.prg
  4. *
  5. *  DBU Network Support Routines
  6. *
  7. *  Copyright (c) 1990-1993, Computer Associates International Inc.
  8. *  All rights reserved.
  9. *
  10. */
  11.  
  12. #include "common.ch"
  13. #define NET_WAIT  1
  14.  
  15.  
  16. /***
  17. *
  18. *  ErrMsg( <cMsg>, [<acChoices>] ) --> nChoice
  19. *
  20. *  Dialog box mechanism that displays cMsg and presents the choices
  21. *  acChoices to the user
  22. *
  23. *  Parameters:
  24. *     cMsg      - The message to display to the user; multiple line messages
  25. *                 can be used by delimiting them with a semicolon (;)
  26. *
  27. *     acChoices - Optional array of character strings that represent the
  28. *                 user's choices; if acChoices is not specified, the single
  29. *                 choice "Ok" is displayed
  30. *
  31. *  Returns:
  32. *     The element number of acChoices that the user selects
  33. *
  34. */
  35. FUNCTION ErrMsg( cMsg, acChoices )
  36.    RETURN ( ALERT( cMsg, acChoices ) )
  37.  
  38.  
  39.  
  40. /***
  41. *
  42. *  NetMode( [<lOpenMode>] ) --> lFilesOpenedShared
  43. *
  44. *  Determines the default file opening mode of DBU
  45. *
  46. *  Parameter:
  47. *     lOpenMode - If passed, determines new opening mode:
  48. *                 .T. - Open files shared (default)
  49. *                 .F. - Open files exclusive
  50. *
  51. *  Returns: The current default file opening mode of DBU
  52. *
  53. */
  54. FUNCTION NetMode( lNewMode )
  55.    
  56.    STATIC lOpenMode := .T.
  57.    RETURN ( IIF( lNewMode != NIL, lOpenMode := lNewMode, lOpenMode ))
  58.  
  59.  
  60.  
  61. /***
  62. *
  63. *  NetUse( <cDatabase>, [<lOpenMode>], [<nWaitSeconds>], 
  64. *          [<cAlias>], [<lNoAlert>] ) --> lSuccess
  65. *
  66. *  Attempt to USE a database file with optional retry
  67. *
  68. *  Parameters:
  69. *     cDatabase    - The name of the database to open
  70. *
  71. *     lOpenMode    - Mode to open file in: True opens file for exclusive
  72. *                    use, False opens file for shared use (Defaults to
  73. *                    shared if NetMode() is true, else exclusive)
  74. *
  75. *     nWaitSeconds - Number of seconds to retry a failed attempt (defaults
  76. *                    to NET_WAIT)
  77. *
  78. *     cAlias       - Optional alias to use for this database (defaults
  79. *                    to the filename)
  80. *
  81. *     lNoAlert     - If true, disables the notification of a failed attempt
  82. *                    to the user
  83. *
  84. *  Returns:
  85. *     True if the database was successfully opened, otherwise false
  86. *
  87. */
  88. FUNCTION NetUse( cDatabase, lOpenMode, nSeconds, cAlias, lNoAlert )
  89.    
  90.    LOCAL cErrMsg        // Error message to display
  91.    LOCAL lForever       // Variable to determine infinite retry
  92.    LOCAL lRet := .F.    // Return value, assume the worst
  93.  
  94.    DEFAULT lOpenMode TO !NetMode()  // Open in mode determined by NetMode()
  95.    DEFAULT nSeconds  TO NET_WAIT    // Retry for two seconds by default
  96.    DEFAULT cAlias    TO MakeAlias( cDatabase )  // Default alias to db name
  97.    DEFAULT lNoAlert  TO .F.         // Enable alert by default
  98.  
  99.    cErrMsg := "Unable to open file in;" + ;
  100.               IIF( lOpenMode, "exclusive", "shared" ) + " mode"
  101.  
  102.    lForever := ( nSeconds == 0 )    // Retry forever if nSeconds is zero
  103.  
  104.    WHILE ( lForever .OR. ( nSeconds > 0 ))
  105.       
  106.       IF lOpenMode
  107.           USE ( cDatabase ) ALIAS ( cAlias ) EXCLUSIVE
  108.       ELSE
  109.           USE ( cDatabase ) ALIAS ( cAlias ) SHARED
  110.       ENDIF
  111.  
  112.       IF !NETERR()                // If successful, let's get out of here
  113.          lRet := .T.
  114.          EXIT
  115.       ENDIF
  116.  
  117.       INKEY(1)                    // Wait 1 second
  118.       nSeconds--
  119.  
  120.       //
  121.       // Give user the choice to abort or retry if error alerting is
  122.       // enabled, we're not trying forever, and our wait period is up
  123.       //
  124.       IF ( !lNoAlert .AND. !lForever .AND. ( nSeconds <= 0 ))
  125.          IF ( ErrMsg( cErrMsg, { "Abort", "Retry" } ) == 2 )
  126.             nSeconds := NET_WAIT
  127.          ENDIF
  128.       ENDIF
  129.  
  130.    ENDDO
  131.  
  132.    RETURN ( lRet )
  133.  
  134.  
  135.  
  136. /***
  137. *
  138. *  NetPack() --> lSuccess
  139. *
  140. *  Networking routine for performing PACK with error handling
  141. *
  142. *  Returns true if the PACK was successful, otherwise false
  143. *
  144. */
  145. FUNCTION NetPack()
  146.    
  147.    LOCAL lRet := .F.    // Return value of NetPack()
  148.    
  149.    // If we have exclusive of the file already, we can just PACK here
  150.    IF !NetMode()
  151.       PACK
  152.       lRet := .T.
  153.    ELSE
  154.       
  155.       //
  156.       // We need to reopen exclusive, pack, then reopen shared since
  157.       // we're in network mode
  158.       //
  159.       IF !NetUse( cur_dbf, .T., NIL, NIL, .T. )
  160.          ErrMsg( "PACK failed;Unable to obtain exclusive use of file" )
  161.       ELSE
  162.          PACK
  163.          IF NetUse( cur_dbf, NIL, NIL, NIL, .T. )
  164.             lRet := .T.    // Operation was successful
  165.          ELSE
  166.             // This should never happen!
  167.             ErrMsg( "Unable to reopen file after PACK;The database is closed" )
  168.          ENDIF
  169.       ENDIF
  170.  
  171.    ENDIF
  172.  
  173.    RETURN ( lRet )
  174.  
  175.  
  176.  
  177. /***
  178. *
  179. *  NetZap() --> lSuccess
  180. *
  181. *  Networking routine for performing ZAP with error handling
  182. *
  183. *  Returns true if the ZAP was successful, otherwise false
  184. *
  185. */
  186. FUNCTION NetZap()
  187.    
  188.    LOCAL lRet := .F.    // Return value of NetZap()
  189.    
  190.    // If we have exclusive of the file already, we can just ZAP here
  191.    IF !NetMode()
  192.       ZAP
  193.       lRet := .T.
  194.    ELSE
  195.       
  196.       //
  197.       // We need to reopen exclusive, zap, then reopen shared since
  198.       // we're in network mode
  199.       //
  200.       IF !NetUse( cur_dbf, .T., NIL, NIL, .T. )
  201.          ErrMsg( "ZAP failed;Unable to obtain exclusive use of file" )
  202.       ELSE
  203.          ZAP
  204.          IF NetUse( cur_dbf, NIL, NIL, NIL, .T. )
  205.             lRet := .T.    // Operation was successful
  206.          ELSE
  207.             // This should never happen!
  208.             ErrMsg( "Unable to reopen file after ZAP;The database is closed" )
  209.          ENDIF
  210.       ENDIF
  211.  
  212.    ENDIF
  213.  
  214.    RETURN ( lRet )
  215.  
  216.  
  217.  
  218. /***
  219. *
  220. *  NetAppBlank( [<nWaitSeconds>] ) --> lSuccess
  221. *
  222. *  Networking routine for APPENDing a BLANK record with error handling
  223. *
  224. *  Parameter:
  225. *     nWaitSeconds - Optional number of seconds to retry a failed attempt
  226. *                    (defaults to NET_WAIT)
  227. *
  228. *  Returns:
  229. *     True if a record is successfully appended and locked, otherwise false
  230. *
  231. */
  232. FUNCTION NetAppBlank( nWaitSeconds )
  233.    
  234.    LOCAL lForever          // Variable to determine infinite retry
  235.    LOCAL lRet    := .F.    // Return value, .T. indicating successful
  236.    LOCAL cErrMsg := "Unable to append new record"  // Error message text
  237.  
  238.    DEFAULT nWaitSeconds TO NET_WAIT
  239.    lForever := ( nWaitSeconds == 0 )
  240.  
  241.    WHILE ( lForever .OR. ( nWaitSeconds > 0 ))
  242.       
  243.       APPEND BLANK
  244.       IF !NETERR()
  245.          lRet := .T.
  246.          EXIT
  247.       ENDIF
  248.  
  249.       INKEY(.5)         // Wait 1/2 second
  250.       nWaitSeconds -= .5
  251.  
  252.       // Give user the choice to abort or retry
  253.       IF ( !lRet .AND. !lForever .AND. ( nWaitSeconds <= 0 ))
  254.          IF ( ErrMsg( cErrMsg, { "Abort", "Retry" } ) == 2 )
  255.             nWaitSeconds := NET_WAIT
  256.          ENDIF
  257.       ENDIF
  258.  
  259.    ENDDO
  260.  
  261.    RETURN ( lRet )
  262.  
  263.  
  264.  
  265. /***
  266. *
  267. *  NetRLock( [<nWaitSeconds>] ) --> lSuccess
  268. *
  269. *  Networking function to obtain a record lock (includes error handler)
  270. *
  271. *  Parameters:
  272. *     nWaitSeconds - Optional number of seconds to attempt a record lock
  273. *                    (defaults to NET_WAIT)
  274. *
  275. *  Returns:
  276. *     True if a record was optained, otherwise false
  277. *
  278. */
  279. FUNCTION NetRLock( nWait )
  280.    
  281.    LOCAL lForever          // Variable to determine infinite retry
  282.    LOCAL lRet    := .T.    // Return value, .T. indicating successful
  283.    LOCAL cErrMsg := "Unable to obtain a record lock"  // Error message text
  284.  
  285.    DEFAULT nWait TO NET_WAIT
  286.    lForever := ( nWait == 0 )
  287.  
  288.    WHILE ( NetMode() .AND. ( lForever .OR. ( nWait > 0 )))
  289.       
  290.       IF RLOCK()
  291.          EXIT
  292.       ENDIF
  293.  
  294.       INKEY( .5 )          // Wait 1/2 second
  295.       nWait -= .5
  296.  
  297.       // Give user the choice to abort or retry
  298.       IF ( !lForever .AND. ( nWait <= 0 ))
  299.          IF ( ErrMsg( cErrMsg, { "Abort", "Retry" } ) == 2 )
  300.             nWait := NET_WAIT
  301.          ELSE
  302.             lRet := .F.
  303.          ENDIF
  304.       ENDIF
  305.  
  306.    ENDDO
  307.  
  308.    RETURN ( lRet )
  309.  
  310.  
  311.  
  312.  
  313. /***
  314. *        Service routines
  315. */
  316.  
  317.  
  318. /***
  319. *
  320. *  MakeAlias( cString ) --> cAliasName
  321. *
  322. *  Takes cString and parses it, removing drive, path, and extension
  323. *  information, returning only the filename
  324. *
  325. *  Parameters:
  326. *     cString - The string to parse
  327. *
  328. *  Returns: The filename contained in cString
  329. *
  330. */
  331. FUNCTION MakeAlias( cString )
  332.  
  333.    LOCAL nPos     // Used to locate position of search characters in string
  334.  
  335.    // Strip out the drive and path information, if any
  336.    IF (( nPos := MAX( MAX( 0, RAT( "\", cString )), RAT( ":", cString ))) != 0 )
  337.       cString := SUBSTR( cString, ++nPos )
  338.    ENDIF
  339.  
  340.    // Strip out the extension information, if any
  341.    IF (( nPos := RAT( ".", cString )) != 0 )
  342.       cString := SUBSTR( cString, 1, --nPos )
  343.    ENDIF
  344.  
  345.    RETURN ( cString )
  346.