home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / gt_use.prg < prev    next >
Text File  |  1993-10-14  |  3KB  |  151 lines
  1. /*
  2.     File......: GT_Use.prg
  3.     Author....: Martin Bryant
  4.     BBS.......: The Dark Knight Returns
  5.     Net/Node..: 050/069
  6.     User Name.: Martin Bryant
  7.     Date......: 10/02/93
  8.     Revision..: 1.0
  9.  
  10.     This is an original work by Martin Bryant and is placed
  11.     in the public domain.
  12.  
  13.     Modification history:
  14.     ---------------------
  15.  
  16.     Rev 1.0 10/02/93
  17.     PD Revision.
  18. */
  19.  
  20. /*  $DOC$
  21.  *  $FUNCNAME$
  22.  *      GT_USE()
  23.  *  $CATEGORY$
  24.  *      General
  25.  *  $ONELINER$
  26.  *      Use a DBF file shared or exclusive.
  27.  *  $SYNTAX$
  28.  *      GT_Use(<cFile>,[<lExclusive>],[<cAlias>]) -> cAlias
  29.  *  $ARGUMENTS$
  30.  *      <cFile> is the name of the file to open.
  31.  *
  32.  *      <lExclusive> use file shared or exclusive.
  33.  *
  34.  *      <cAlias> is the alias to use if successful.
  35.  *  $RETURNS$
  36.  *      cAlias
  37.  *  $DESCRIPTION$
  38.  *      Use a DBF file shared or exclusive.
  39.  *  $EXAMPLES$
  40.  *      // Open a DBF file exclusively
  41.  *      IF EMPTY(GT_Use('INVS0293',.T.,'INVOICES'))
  42.  *          ? 'Error'
  43.  *      ENDIF
  44.  *  $SEEALSO$
  45.  *
  46.  *  $INCLUDE$
  47.  *
  48.  *  $END$
  49.  */
  50.  
  51. #include "GT_LIB.ch"
  52.  
  53. #define HEIGHT  06
  54. #define WIDTH   16
  55.  
  56. FUNCTION GT_Use(cFile,lExclusive,cAlias)
  57.  
  58. LOCAL cScreen := ''
  59. LOCAL lMessage := .F.
  60. LOCAL lSuccess := .F.
  61. LOCAL nBottom := INT((MAXROW() + HEIGHT)/2)
  62. LOCAL nKey := 0
  63. LOCAL nLeft := INT((MAXCOL() - WIDTH)/2)
  64. LOCAL nPause := 0.5
  65. LOCAL nRight := nLeft - WIDTH
  66. LOCAL nSeconds := 120
  67. LOCAL nTop := nBottom - HEIGHT
  68.  
  69. Default cFile to ''
  70. Default lExclusive to .F.
  71. Default cAlias to cFile
  72.  
  73. //  Trim dots
  74. nKey := AT('.',cAlias) - 1
  75. IF nKey > 0
  76.     cAlias := SUBSTR(cAlias,1,nKey)
  77. ENDIF
  78.  
  79. //  Trim '\'
  80. nKey := RAT('\',cAlias) + 1
  81. IF nKey > 1
  82.     cAlias := SUBSTR(cAlias,nKey)
  83. ENDIF
  84.  
  85. //  Trim ':'
  86. nKey := RAT(':',cAlias) + 1
  87. IF nKey > 1
  88.     cAlias := SUBSTR(cAlias,nKey)
  89. ENDIF
  90.  
  91. cAlias := UPPER(cAlias)
  92.  
  93. BEGIN SEQUENCE
  94.  
  95.     // Attempt the USE
  96.     SELECT((cAlias)->(SELECT()))
  97.     USE // Nothing
  98.  
  99.     DO WHILE nSeconds > 0 .AND. (.NOT. lSuccess) .AND. ;
  100.         (nKey != K_ESC)
  101.  
  102.         // Attempt use
  103.         IF lExclusive
  104.             USE (cFile) EXCLUSIVE ALIAS (cAlias)
  105.         ELSE
  106.             USE (cFile) SHARED ALIAS (cAlias)
  107.         ENDIF
  108.         lSuccess := (ALIAS() == cAlias)
  109.  
  110.         IF .NOT. lSuccess
  111.  
  112.             // Message ?
  113.             IF .NOT. lMessage
  114.  
  115.                 // Save
  116.                 cScreen := SAVESCREEN(nTop,nLeft,nBottom,nRight)
  117.  
  118.                 // Display
  119.                 GT_Window(nTop,nLeft,nBottom,nRight,BOX_SS, ;
  120.                     NIL,'Opening ....',.T.)
  121.  
  122.                 // Position for message
  123.                 @ nTop+02, nLeft+02 SAY 'Timeout:'
  124.                 @ nTop+04, nLeft+02 SAY PADC('Esc∙Exit',WIDTH-03)
  125.  
  126.                 lMessage := .T.
  127.  
  128.             ENDIF
  129.  
  130.             @ nTop+02, nLeft+09 SAY PADR(INT(nSeconds),3)
  131.  
  132.             // Wait
  133.             nKey := INKEY(nPause)
  134.             nSeconds -= nPause
  135.  
  136.         ENDIF
  137.  
  138.     ENDDO
  139.  
  140. ENDSEQUENCE
  141.  
  142. IF lMessage
  143.     RESTSCREEN(nTop,nLeft,nBottom,nRight,cScreen)
  144. ENDIF
  145.  
  146. /*
  147.     End of GT_Use()
  148. */
  149. RETURN(IF(lSuccess,UPPER(ALIAS()),'')) // 
  150.  
  151.