home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / MARTIN.ZIP / UDF1.PRG < prev    next >
Encoding:
Text File  |  1990-06-02  |  6.1 KB  |  246 lines
  1. *****************************************************************
  2. * UDF1.PRG                                                      *
  3. * Written by Greg Martin                                        *
  4. * These functions may be freely used, but may not be published. *
  5. *****************************************************************
  6.  
  7.  
  8.  
  9. *********************
  10. * Opening Databases *
  11. *********************
  12.  
  13. FUNCTION G_Use
  14. PARAMETERS File, Indices, Alias, Try_Forever, Excl_Use
  15. * First, select an empty work area
  16. IF .not. Select_0()
  17.   RETURN(.f.)
  18. ENDIF
  19. * Make sure the database exists
  20. IF .not. FILE(File + ".DBF")
  21.   DECLARE LINE[4]
  22.   IF Excl_Use
  23.     Line[1] = "ERROR IN OPENING DATABASE FOR EXCLUSIVE USE !"
  24.   ELSE
  25.     Line[1] = "ERROR IN OPENING DATABASE FOR SHARED USE !"
  26.   ENDIF
  27.   Line[2] = "ERROR: DATABASE DOES NOT EXIST!"
  28.   Line[3] = "DATABASE: " + File
  29.   Line[4] = "PRESS ANY KEY TO ABORT OPERATION"
  30.   ErrorBox(Line)
  31.   RETURN(.f.)
  32. ENDIF
  33. * Attempt to open database until successful or aborted
  34. DO WHILE .t.
  35.   IF Excl_Use
  36.     USE &File ALIAS &Alias EXCLUSIVE
  37.   ELSE
  38.     USE &File ALIAS &Alias
  39.   ENDIF
  40.   IF .not. NETERR()
  41.     IF EMPTY(Indices)
  42.       RETURN(.t.)
  43.     ELSE
  44.       IF G_Index(Indices)
  45.         RETURN(.t.)
  46.       ELSE
  47.         USE
  48.         RETURN(.f.)
  49.       ENDIF
  50.     ENDIF
  51.   ENDIF
  52.   DECLARE LINE[4]
  53.   IF Excl_Use
  54.     Line[1] = "ERROR IN OPENING DATABASE FOR EXCLUSIVE USE !"
  55.     Line[2] = "ERROR: EXCLUSIVE USE OF DBF DENIED."
  56.   ELSE
  57.     Line[1] = "ERROR IN OPENING DATABASE FOR SHARED USE !"
  58.     Line[2] = "ERROR: SHARED USE OF DBF DENIED."
  59.   ENDIF
  60.   Line[3] = "DATABASE: " + File
  61.   IF .not. Try_Forever
  62.     Line[4] = "PRESS ANY KEY TO RETRY OR Esc TO ABORT OPERATION"
  63.   ELSE
  64.     Line[4] = "PRESS ANY KEY TO CONTINUE TRYING"
  65.   ENDIF
  66.   Key = ErrorBox(Line)
  67.   IF Key = Esc .and. .not. Try_Forever
  68.     RETURN(.f.)
  69.   ENDIF
  70. ENDDO
  71.  
  72.  
  73. FUNCTION Select_0
  74. * Select an empty work area.
  75. SELECT 0
  76. * Make sure an empty work area was found.
  77. IF .not. EMPTY(ALIAS())
  78.   DECLARE Line[2]
  79.   Line[1] = "ERROR: NO EMPTY WORK AREAS FOUND!"
  80.   Line[2] = "PRESS ANY KEY TO ABORT OPERATION."
  81.   ErrorBox(Line)
  82.   RETURN(.f.)
  83. ELSE
  84.   RETURN(.t.)
  85. ENDIF
  86.  
  87.  
  88. FUNCTION G_Index
  89. PARAMETER Indices
  90. PRIVATE RecNo, Num, Temp, Token
  91. PRIVATE Index_1, Index_2, Index_3, Index_4, Index_5, Index_6, Index_7, Index_8
  92. PRIVATE Index_9, Index_10, Index_11, Index_12, Index_13, Index_14, Index_15
  93. IF EMPTY(Indices)
  94.   * If no index specified then close any open indexes.
  95.   RecNo = RECNO()
  96.   SET INDEX TO
  97.   GO RecNo
  98.   RETURN(.t.)
  99. ELSE
  100.   * Open the specified indexes.
  101.   Indices = UPPER(Indices)
  102.   * Open up to 15 indexes by breaking down the listed indexes.
  103.   FOR Temp = 1 TO 15
  104.     Token = ""
  105.     FirstToken(@Indices, @Token)
  106.     Num = LTRIM(STR(Temp, 2, 0))
  107.     IF .not. EMPTY(Token)
  108.       Index_&Num = Token + ".NTX"
  109.       * Make sure index file exists.
  110.       IF .not. FILE(Index_&Num)
  111.         DECLARE LINE[4]
  112.         Line[1] = "ERROR IN OPENING INDEX FILE !"
  113.         Line[2] = "ERROR: INDEX FILE DOES NOT EXIST."
  114.         Line[3] = "INDEX: " + Index_&Num
  115.         Line[4] = "PRESS ANY KEY TO ABORT OPERATION"
  116.         ErrorBox(Line)
  117.         RETURN(.f.)
  118.       ENDIF
  119.     ELSE
  120.       Index_&Num = ""
  121.     ENDIF
  122.   NEXT Temp
  123.   * Save the record number.
  124.   RecNo = RECNO()
  125.   * Open all indexes.
  126.   * In this one case Clipper ignores empty string macros.
  127.   SET INDEX TO &Index_1, &Index_2, &Index_3, &Index_4, &Index_5, &Index_6, &Index_7, &Index_8, &Index_9, &Index_10, &Index_11, &Index_12, &Index_13, &Index_14, &Index_15
  128.   * Reset the record number.
  129.   GO RecNo
  130.   RETURN(.t.)
  131. ENDIF
  132. RETURN(.f.)
  133.  
  134.  
  135.  
  136. ***************************
  137. * Record and File Locking *
  138. ***************************
  139.  
  140. FUNCTION G_RLock
  141. PARAMETERS P1, P2
  142. PRIVATE Append, Try_Forever, PCount, Temp, No, Sec, PCount, Key
  143. Append = .f.
  144. Try_Forever = .f.
  145. PCount = PCOUNT()
  146. * Process any passed parameters
  147. FOR Temp = 1 TO PCount
  148.   No = STR(Temp, 1)
  149.   IF TYPE("m->P&No") == "L"
  150.     Append = P&No
  151.   ELSE
  152.     Try_Forever = (UPPER(P&No) == "FOREVER")
  153.   ENDIF
  154. NEXT Temp
  155. IF Append
  156.   * Append blank if specified.
  157.   RETURN(APPENDBLANK(Try_Forever))
  158. ENDIF
  159. DO WHILE .t.
  160.   Sec = SECONDS() + 5
  161.   * Try for 5 seconds.
  162.   DO WHILE SECONDS() < Sec
  163.     * Lock current record.
  164.     IF RLOCK()
  165.       RETURN(.t.)
  166.     ENDIF
  167.   ENDDO
  168.   * 5 second time limit reached.
  169.   DECLARE Line[4]
  170.   Line[1] = "ERROR WHILE ATTEMPTING TO LOCK A RECORD !"
  171.   Line[2] = "ERROR: UNABLE TO LOCK RECORD."
  172.   Line[3] = "DATABASE: " + ALIAS()
  173.   IF .not. Try_Forever
  174.     Line[4] = "PRESS ANY KEY TO RETRY OR Esc TO ABORT OPERATION"
  175.   ELSE
  176.     Line[4] = "PRESS ANY KEY TO CONTINUE TRYING"
  177.   ENDIF
  178.   Key = ErrorBox(Line)
  179.   IF Key = Esc .and. .not. Try_Forever
  180.     RETURN(.f.)
  181.   ENDIF
  182. ENDDO
  183.  
  184.  
  185. FUNCTION AppendBlank
  186. PARAMETER Try_Forever
  187. PRIVATE Sec, Key
  188. DO WHILE .t.
  189.   Sec = SECONDS() + 5
  190.   * Try for 5 seconds.
  191.   DO WHILE SECONDS() < Sec
  192.     APPEND BLANK
  193.     IF .not. NETERR()
  194.       RETURN(.t.)
  195.     ENDIF
  196.   ENDDO
  197.   * 5 second time limit reached.
  198.   DECLARE Line[4]
  199.   Line[1] = "ERROR WHILE ATTEMPTING TO APPEND A BLANK RECORD !"
  200.   Line[2] = "ERROR: UNABLE TO APPEND RECORD."
  201.   Line[3] = "DATABASE: " + ALIAS()
  202.   IF .not. Try_Forever
  203.     Line[4] = "PRESS ANY KEY TO RETRY OR Esc TO ABORT OPERATION"
  204.   ELSE
  205.     Line[4] = "PRESS ANY KEY TO CONTINUE TRYING"
  206.   ENDIF
  207.   Key = ErrorBox(Line)
  208.   IF Key = Esc .and. .not. Try_Forever
  209.     RETURN(.f.)
  210.   ENDIF
  211. ENDDO
  212. RETURN(.t.)
  213.  
  214.  
  215. FUNCTION G_FLock
  216. PARAMETERS P1
  217. PRIVATE Try_Forever, Sec, Key
  218. Try_Forever = .f.
  219. IF PCOUNT() > 0
  220.   Try_Forever = (UPPER(P1) = "FOREVER")
  221. ENDIF
  222. DO WHILE .t.
  223.   Sec = SECONDS() + 5
  224.   * Try for 5 seconds.
  225.   DO WHILE SECONDS() < Sec
  226.     IF FLOCK()
  227.       RETURN(.t.)
  228.     ENDIF
  229.   ENDDO
  230.   * 5 second time limit reached.
  231.   DECLARE LINE[4]
  232.   Line[1] = "ERROR WHILE ATTEMPTING TO LOCK A FILE !"
  233.   Line[2] = "ERROR: UNABLE TO LOCK FILE."
  234.   Line[3] = "DATABASE: " + ALIAS()
  235.   IF .not. Try_Forever
  236.     Line[4] = "PRESS ANY KEY TO RETRY OR Esc TO ABORT OPERATION"
  237.   ELSE
  238.     Line[4] = "PRESS ANY KEY TO CONTINUE TRYING"
  239.   ENDIF
  240.   Key = ErrorBox(Line)
  241.   IF Key = Esc .and. .not. Try_Forever
  242.     RETURN(.f.)
  243.   ENDIF
  244. ENDDO
  245.  
  246.