home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / dedit.zip / TOTAL.PRG < prev   
Text File  |  1980-01-01  |  8KB  |  354 lines
  1. *
  2. * PROGRAM: TTL ( WORK ARROUND FOR TOTAL COMMAND - FULL IMPLIMENTATION )
  3. *
  4. *  AUTHOR: KELLY MC TIERNAN
  5. *
  6. *    DATE: 09/06/85
  7. *
  8. *   NOTES: USAGE -
  9. *
  10. *          ERR = .F.
  11. *          USE FILE INDEX <KEYINDEX>
  12. *          DO TTL WITH "TO <TTLFILE> ON <KEY> [FIELDS <FIELD,FIELD..>] 
  13. *          [FOR / WHILE <CONDITION>]",ERR
  14. *
  15. *          ERR = .T. IF PARSING ERROR, OTHERWISE <TTLFILE> HAS TOTALS
  16. *          - SAME AS DBASE III TOTAL COMMAND.
  17. *       
  18. PROCEDURE TTL
  19. PARAM CMDSTR,ERR
  20. *
  21. PRIVATE FNAME,KEY,CONDITION,CNT,CTR,VARTMP,FLDTMP,FLDLST,C,FLDSTR,POS2
  22. PRIVATE WILEFLG,FORFLG
  23. *
  24. * INITIALIZATIONS
  25. *
  26. STORE "" TO FNAME,KEY,FLDLST,VARLST,CONDITION 
  27. POSIT = 0
  28. CMDSTR = UPPER(CMDSTR)
  29. CNT = 0
  30. *
  31. * GET TOTAL FILE NAME
  32. *
  33. IF AT("TO ",CMDSTR) = 0
  34.    ERR = .T.
  35.    RETURN
  36. ELSE
  37.    POSIT = AT("TO ",CMDSTR) + 3
  38.    DO NEXTWORD WITH CMDSTR,POSIT,FNAME
  39. ENDIF
  40. *
  41. * GET KEY FIELD NAME
  42. *
  43. IF AT(" ON ",CMDSTR) = 0
  44.    ERR = .T.
  45.    RETURN
  46. ELSE
  47.    POSIT = AT(" ON ",CMDSTR) + 4
  48.    DO NEXTWORD WITH CMDSTR,POSIT,KEY
  49. ENDIF
  50. *
  51. * GENERATE TOTAL FILE, USE FIELD LIST IF PRESENT
  52. * OTHERWISE GET ALL NUMERIC FIELD TYPES
  53. *
  54. VARTMP = ""
  55. FLDTMP = ""
  56. FLDLST = ""
  57. C = ""
  58. COPY STRUCTURE EXTENDED TO FLDS
  59. SELECT 2
  60. USE FLDS
  61. GO TOP
  62. IF AT(" FIELDS ",CMDSTR) = 0
  63.    DO WHILE .NOT. EOF()
  64.       DO CASE
  65.       *
  66.       * SAVE KEY FIELD IN STRUCTURE FILE
  67.       * 
  68.       CASE FIELD_NAME = "&KEY"
  69.         SKIP
  70.         LOOP
  71.       *
  72.       * GENERATE VARIABLE AND FIELD NAME'S FOR TOTAL PROCESS.
  73.       * COUNT NUMBER OF NUMERIC FIELDS.
  74.       * 
  75.       CASE FIELD_TYPE = "N"
  76.         CNT = CNT + 1
  77.         VARTMP = "VAR"
  78.         FLDTMP = "FLD"
  79.         DO CASE
  80.         CASE CNT > 99 .AND. CNT < 999
  81.             VARTMP = VARTMP + STR(CNT,3)
  82.             FLDTMP = FLDTMP + STR(CNT,3)
  83.             &VARTMP = 0
  84.             &FLDTMP = FIELD_NAME
  85.         CASE CNT > 9 .AND. CNT < 99
  86.             VARTMP = VARTMP + STR(CNT,2)
  87.             FLDTMP = FLDTMP + STR(CNT,2)
  88.             &VARTMP = 0
  89.             &FLDTMP = FIELD_NAME
  90.         CASE CNT < 10
  91.             VARTMP = VARTMP + STR(CNT,1)
  92.             FLDTMP = FLDTMP + STR(CNT,1)
  93.             &VARTMP = 0
  94.             &FLDTMP = FIELD_NAME
  95.         OTHERWISE
  96.             ERR = .T.
  97.             RETURN
  98.         ENDCASE
  99.       *
  100.       * IF NOT NUMERIC OR KEY FIELD, THEN DELETE FROM STRUCTURE FILE.
  101.       *
  102.       OTHERWISE
  103.         DELETE
  104.       ENDCASE
  105.       SKIP
  106.    ENDDO
  107. ELSE
  108.    FLDSTR = ""
  109.    *
  110.    * PARSE FOR FIELDS LIST.
  111.    *
  112.    POSIT = AT(" FIELDS ",CMDSTR) + 8
  113.    DO NEXTWORD WITH CMDSTR,POSIT,FLDLST
  114.    POS2 = 1
  115.    *
  116.    * PARSE INDIVIDUAL FIELD NAMES.
  117.    *
  118.    DO WHILE POS2 <= LEN(FLDLST)
  119.       C = SUBSTR(FLDLST,POS2,1)
  120.       IF C = ',' .OR. POS2 = LEN(FLDLST)
  121.         IF POS2 = LEN(FLDLST)
  122.             FLDSTR = FLDSTR + C
  123.         ENDIF
  124.         CNT = CNT + 1
  125.         VARTMP = "VAR"
  126.         FLDTMP = "FLD"
  127.         DO CASE
  128.         CASE CNT > 99 .AND. CNT < 999
  129.             VARTMP = VARTMP + STR(CNT,3)
  130.             FLDTMP = FLDTMP + STR(CNT,3)
  131.             &VARTMP = 0
  132.             &FLDTMP = FLDSTR
  133.         CASE CNT > 9 .AND. CNT < 99
  134.             VARTMP = VARTMP + STR(CNT,2)
  135.             FLDTMP = FLDTMP + STR(CNT,2)
  136.             &VARTMP = 0
  137.             &FLDTMP = FLDSTR
  138.         CASE CNT < 10
  139.             VARTMP = VARTMP + STR(CNT,1)
  140.             FLDTMP = FLDTMP + STR(CNT,1)
  141.             &VARTMP = 0
  142.             &FLDTMP = FLDSTR
  143.         OTHERWISE
  144.             ERR = .T.
  145.             RETURN
  146.         ENDCASE         
  147.         POS2 = POS2 + 1
  148.         FLDSTR = ""
  149.       ELSE
  150.         FLDSTR = FLDSTR + C
  151.         POS2 = POS2 + 1
  152.       ENDIF
  153.    ENDDO
  154.    GO TOP
  155.    *
  156.    * STRUCTURE FILE - USE FIELDS LIST HERE.
  157.    *
  158.    DO WHILE .NOT. EOF()
  159.       DO CASE
  160.       CASE FIELD_NAME = "&KEY"
  161.         SKIP
  162.         LOOP
  163.       CASE FIELD_TYPE <> "N"
  164.         DELETE
  165.         SKIP
  166.         LOOP
  167.       OTHERWISE
  168.         CTR = 1
  169.         FOUND = .F.
  170.         DO WHILE CTR <= CNT
  171.             FLDTMP = "FLD"
  172.             DO CASE
  173.             CASE CTR > 99 .AND. CTR < 999
  174.                 FLDTMP = FLDTMP + STR(CTR,3)
  175.             CASE CTR > 9 .AND. CTR < 99
  176.                 FLDTMP = FLDTMP + STR(CTR,2)
  177.             CASE CTR < 10
  178.                 FLDTMP = FLDTMP + STR(CTR,1)
  179.             OTHERWISE
  180.                 ERR = .T.
  181.                 RETURN
  182.             ENDCASE
  183.             IF FIELD_NAME = &FLDTMP
  184.                 FOUND = .T.
  185.                 EXIT
  186.             ELSE
  187.                 CTR = CTR + 1
  188.             ENDIF
  189.         ENDDO
  190.         IF .NOT. FOUND
  191.             DELETE
  192.         ENDIF
  193.         SKIP
  194.     ENDCASE
  195.   ENDDO
  196. ENDIF
  197. PACK
  198. USE
  199. *
  200. * CREATE TOTAL FILE FROM STRUCTURE FILE.
  201. *
  202. CREATE &FNAME FROM FLDS
  203. DELETE FILE FLDS.DBF
  204. USE
  205. USE &FNAME
  206. GO TOP
  207. SELECT 1
  208. GO TOP
  209. *
  210. * DO TOTAL WITH / WITHOUT CONDITION
  211. *
  212. WILEFLG = .F.
  213. FORFLG = .F.
  214. DO CASE
  215. CASE AT(" FOR ",CMDSTR) <> 0
  216.    POSIT = AT(" FOR ",CMDSTR) + 5
  217.    CONDITION = SUBSTR(CMDSTR,POSIT)
  218.    *
  219.    * SET UP CONDITION FLAGS - FOR
  220.    * 
  221.    FORFLG = .T.
  222. CASE AT(" WHILE ",CMDSTR) <> 0
  223.    POSIT = AT(" WHILE ",CMDSTR) + 7
  224.    CONDITION = SUBSTR(CMDSTR,POSIT)
  225.    *
  226.    * SET UP CONDITION FLAGS - WHILE
  227.    *
  228.    WILEFLG = .T.
  229. ENDCASE
  230. *
  231. * DO ACTUAL TOTALING PROCESS  
  232. *
  233. DO WHILE .NOT. EOF()
  234.     IF WILEFLG
  235.         IF .NOT. &CONDITION
  236.             EXIT
  237.         ENDIF
  238.     ENDIF
  239.     IF FORFLG
  240.         IF .NOT. &CONDITION
  241.             SKIP
  242.             LOOP
  243.         ENDIF
  244.     ENDIF
  245.     MKEY = &KEY
  246.     FKEY = &KEY
  247.     SELECT 2
  248.     APPEND BLANK
  249.     REPLACE &KEY WITH MKEY
  250.     SELECT 1
  251.     CTR = 1
  252.     * 
  253.     * INITIALIZE TOTAL ARRAY
  254.     *
  255.     DO WHILE CTR <= CNT
  256.         VARTMP = "VAR"
  257.         DO CASE
  258.         CASE CTR > 99 .AND. CTR < 999
  259.             VARTMP = VARTMP + STR(CTR,3)
  260.         CASE CTR > 9 .AND. CTR < 99
  261.             VARTMP = VARTMP + STR(CTR,2)
  262.         CASE CTR < 10
  263.             VARTMP = VARTMP + STR(CTR,1)
  264.         OTHERWISE
  265.             ERR = .T.
  266.             RETURN
  267.         ENDCASE
  268.         &VARTMP = 0
  269.         CTR = CTR + 1
  270.     ENDDO
  271.     DO WHILE FKEY = MKEY .AND. .NOT. EOF()
  272.         CTR = 1
  273.         DO WHILE CTR <= CNT
  274.             VARTMP = "VAR"
  275.             FLDTMP = "FLD"
  276.             DO CASE
  277.             CASE CTR > 99 .AND. CTR < 999
  278.                 VARTMP = VARTMP + STR(CTR,3)
  279.                 FLDTMP = FLDTMP + STR(CTR,3)
  280.             CASE CTR > 9 .AND. CTR < 99
  281.                 VARTMP = VARTMP + STR(CTR,2)
  282.                 FLDTMP = FLDTMP + STR(CTR,2)
  283.             CASE CTR < 10
  284.                 VARTMP = VARTMP + STR(CTR,1)
  285.                 FLDTMP = FLDTMP + STR(CTR,1)
  286.             OTHERWISE
  287.                 ERR = .T.
  288.                 RETURN
  289.             ENDCASE
  290.             FLDSTR = &FLDTMP
  291.             &VARTMP = &VARTMP + &FLDSTR
  292.             CTR = CTR + 1
  293.         ENDDO
  294.         * 
  295.         * DO ACTUAL REPLACEMENTS IN TOTAL FILE
  296.         *
  297.         CTR = 1
  298.         DO WHILE CTR <= CNT
  299.             VARTMP = "VAR"
  300.             FLDTMP = "FLD"
  301.             DO CASE
  302.             CASE CTR > 99 .AND. CTR < 999
  303.                 VARTMP = VARTMP + STR(CTR,3)
  304.                 FLDTMP = FLDTMP + STR(CTR,3)
  305.             CASE CTR > 9 .AND. CTR < 99
  306.                 VARTMP = VARTMP + STR(CTR,2)
  307.                 FLDTMP = FLDTMP + STR(CTR,2)
  308.             CASE CTR < 10
  309.                 VARTMP = VARTMP + STR(CTR,1)
  310.                 FLDTMP = FLDTMP + STR(CTR,1)
  311.             OTHERWISE
  312.                 ERR = .T.
  313.                 RETURN
  314.             ENDCASE
  315.             FLDSTR = &FLDTMP
  316.             SELECT 2
  317.             REPLACE &FLDSTR WITH &VARTMP
  318.             SELECT 1
  319.             CTR = CTR + 1
  320.         ENDDO
  321.         SKIP
  322.         FKEY = &KEY
  323.     ENDDO
  324. ENDDO
  325. SELECT 2
  326. USE
  327. SELECT 1
  328. RETURN
  329.  
  330. PROCEDURE NEXTWORD
  331. PARAM STRG,POS,DEST
  332. *
  333. * RETURN NEXT WORD FROM A STRING.
  334. *
  335. PRIVATE BEGN,L
  336. *
  337. BEGN = 0
  338. L = 0
  339. DO WHILE SUBSTR(STRG,POS,1) = " "
  340.    POS = POS + 1
  341. ENDDO
  342. BEGN = POS
  343. DO WHILE SUBSTR(STRG,POS,1) <> " " .AND. POS < LEN(STRG)
  344.    POS = POS + 1
  345. ENDDO
  346. IF POS = LEN(STRG)
  347.    L = POS - BEGN + 1
  348. ELSE
  349.    L = POS - BEGN
  350. ENDIF
  351. DEST = SUBSTR(STRG,BEGN,L)
  352. RETURN
  353.  
  354.