home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 24 / CD_ASCQ_24_0995.iso / vrac / cols14.zip / COLLINE.BAS < prev    next >
BASIC Source File  |  1995-06-21  |  13KB  |  421 lines
  1.  
  2. REM                 TEXT COLUMN INTERCHANGE PROGRAM
  3. REM                          COLLINE.BAS
  4. REM                 COPYRIGHT (C) 1995 CHUCK BERNT
  5. REM                       ALL RIGHTS RESERVED
  6.  
  7. DECLARE SUB TOTALCOL ()
  8. DECLARE SUB DELIMITERLINEBREAK ()
  9. DIM SHARED C$(1 TO 200), OC$(1 TO 200), TOTAL(1 TO 200), FLDSTART(1 TO 200), FLDLENGTH(1 TO 200), COUNT(1 TO 200), LASTFLDN, NN, INLINE$, DELIMITER$, DELIMITERLEN, DELIMITER2$, TRANSDETECT$, LEAD$, SKIPDUMMY$, LASTCOL
  10. CLS
  11.  
  12. INPUT "FILENAME (DO NOT INCLUDE THE EXTENSION .TXT) ="; FILENAME$
  13. REM PRINT "THE OUTPUT FILENAME WILL BE "; FILENAME$; ".LIS"
  14. REM PRINT "TYPE CONTROL BREAK TO ABORT (THEN SELECT EXIT FROM THE FILE MENU)"
  15. REM PRINT
  16. IN$ = FILENAME$ + ".TXT"
  17. OUT$ = FILENAME$ + ".LIS"
  18.  
  19. REM PRINT
  20. REM PRINT "  PLEASE DESCRIBE HOW THE COLUMNS ARE SEPERATED (DELIMITED)"
  21. REM PRINT "  BY ENTERING ONE OF THE FOLLOWING:"
  22. REM PRINT
  23. REM PRINT "  CARRIAGE RETURN - FOR ANY GROUP OF ADJACENT WHITE"
  24. REM PRINT "                    SPACES (SPACES OR TABS)"
  25. REM PRINT "                S - for any group of adjacent Spaces"
  26. REM PRINT "                T - for only one Tab"
  27. REM PRINT "                C - for only one Comma"
  28. REM PRINT "                F - Fixed format"
  29. REM PRINT "                O - for Other (more choices)"
  30. REM PRINT
  31. A:
  32. INPUT LETTER$
  33. CAPLETTER$ = UCASE$(LETTER$)
  34. SELECT CASE CAPLETTER$
  35.        CASE ""
  36.        REM PRINT "ANY NUMBER OF WHITE SPACES WAS CHOSEN FOR THE DELIMITER"
  37.        DELIMITER$ = " "
  38.        DELIMITER2$ = CHR$(9)
  39.        TRANSDETECT$ = "YES"
  40.  
  41.        CASE "C"
  42.        REM PRINT "ONE COMMA WAS CHOSEN FOR THE DELIMITER"
  43.        DELIMITER$ = ","
  44.  
  45.        CASE "S"
  46.        REM PRINT "ANY NUMBER OF SPACES WAS CHOSEN FOR THE DELIMITER"
  47.        DELIMITER$ = " "
  48.        DELIMITER2$ = " "
  49.        TRANSDETECT$ = "YES"
  50.        SKIPDUMMY$ = "YES"
  51.  
  52.        CASE "T"
  53.        REM PRINT "ONE TAB WAS CHOSEN FOR THE DELIMITER"
  54.        DELIMITER$ = CHR$(9)
  55.  
  56.        CASE "O"
  57.        REM PRINT "  THE DELIMITER CAN BE SPECIFIED IN ONE OF TWO WAYS."
  58.        REM PRINT "  THE DELIMITER CAN BE EITHER TYPED DIRECTLY OR IT'S"
  59.        REM PRINT "  ASCII CODE CAN BE SPECIFIED."
  60.        GOTO C
  61.        
  62.        CASE "F"
  63.        REM PRINT "FIXED FORMAT WAS CHOSEN"
  64.        GOTO F
  65.        
  66.        CASE ELSE
  67.        REM PRINT "OPS PLEASE TRY AGAIN"
  68.        GOTO A
  69. END SELECT
  70. GOTO K
  71.  
  72. F:
  73. REM PRINT
  74. REM PRINT " INPUT FIELDS ARE SPECIFIED BY ENTERING THE STARTING POSITION"
  75. REM PRINT " OF EACH FIELD ALONG WITH THE ENDING POSITION OF THE LAST FIELD."
  76. REM PRINT " THE DOS EDITOR CAN BE USED TO FIND THESE POSITIONS."
  77. REM PRINT
  78. REM PRINT " THE PROGRAM WILL MOVE THE FIELD LENGTHS ALONG WITH THE FIELDS"
  79. REM PRINT " AND ADD LENGTH AS REQUIRED BY NEW FIELDS."
  80. REM PRINT
  81. REM PRINT " PLEASE TYPE IN THE STARTING POSITION OF EACH FIELD."
  82. REM PRINT " ENTER A BLANK LINE TO END."
  83. FLDN = 1
  84. REM PRINT
  85. REM PRINT "STARTING POSITION OF FIELD NUMBER"; FLDN; "=";
  86. INPUT FLDSTART(FLDN)
  87. LASTFLDN = FLDN
  88. FLDN = 2
  89.  
  90.  
  91. INPUTFLD:
  92. REM PRINT "STARTING POSITION OF FIELD NUMBER"; FLDN; "=";
  93. INPUT FLDSTART(FLDN)
  94. IF FLDSTART(FLDN) = 0 THEN GOTO LASTFLD
  95. FLDLENGTH(LASTFLDN) = FLDSTART(FLDN) - FLDSTART(LASTFLDN)
  96. LASTFLDN = FLDN
  97. FLDN = FLDN + 1
  98. GOTO INPUTFLD
  99.  
  100. LASTFLD:
  101. REM PRINT
  102. REM PRINT "ENDING POSITION OF THE LAST FIELD =";
  103. INPUT FLDSTART(FLDN)
  104. FLDLENGTH(LASTFLDN) = FLDSTART(FLDN) - FLDSTART(LASTFLDN) + 1
  105. GOTO K
  106.  
  107. C:
  108. REM PRINT "  MOST COMMON CHARACTERS SUCH AS THE SPACE,"
  109. REM PRINT "  SEMICOLON, COLON AND PERIOD CAN BE ENTERED"
  110. REM PRINT "  DIRECTLY.  FOR THE QUOTATION MARK, LINEFEED"
  111. REM PRINT "  AND ETC. YOU WILL NEED TO ENTER THE ASCII CODE."
  112. REM PRINT "  THE DELIMITER CAN CONTAIN MORE THEN ONE CHARACTER"
  113.  
  114. REM PRINT
  115. REM PRINT " IF YOU WANT TO SPECIFY THE ASCII CODE"
  116. REM PRINT " TYPE Y OR YES OTHERWISE TYPE ENTER."
  117. REM PRINT
  118. INPUT "DO YOU WANT TO SPECIFY ASCII CODE ="; CODE$
  119. CODE$ = UCASE$(CODE$)
  120. IF CODE$ = "Y" THEN CODE$ = "CODE"
  121. IF CODE$ = "YES" THEN CODE$ = "CODE"
  122.  
  123. IF CODE$ <> "CODE" THEN GOTO CHAR
  124. REM PRINT " TYPE ONLY ONE ASCII CODE PER LINE AND ENTER A BLANK"
  125. REM PRINT " LINE TO END.  SOME COMMON ASCII CODES ARE:"
  126. REM PRINT
  127. REM PRINT "COMMA=044 CR=013 LINEFEED=010 SPACE=032 TAB=009"
  128. REM PRINT
  129.  
  130.  
  131. I:
  132. INPUT "CHARACTER'S ASCII CODE"; OLDCODE
  133. IF OLDCODE = 0 THEN PRINT : GOTO K
  134. DELIMITER$ = DELIMITER$ + CHR$(OLDCODE)
  135. GOTO I
  136.  
  137.  
  138. CHAR:
  139. REM PRINT "USE DOUBLE QUOTATION MARKS WHEN USING COMMAS, SPACES & ETC."
  140. REM PRINT "YOU DON'T NEED THE QUOTATION MARKS FOR THE . ; OR:"
  141. REM PRINT
  142. INPUT "ENTER THE DELIMITER'S CHARACTER(S) "; DELIMITER$
  143.  
  144. K:
  145. IF LASTFLDN <> 0 THEN GOTO TOTAL
  146. REM PRINT
  147. REM PRINT " WOULD YOU LIKE THE PROGRAM TO CHECK EVERY INPUT LINE FOR AN"
  148. REM PRINT " EXPECTED NUMBER OF COLUMNS AND LIST ALL EXCEPTIONS TO "
  149. REM PRINT " "; FILENAME$; ".ERR ?  THESE LINES WILL STILL BE PROCESSED IN"
  150. REM PRINT " ALL OTHER RESPECTS AS IF ERROR CHECKING HAD NOT BEEN CARRIED"
  151. REM PRINT " OUT.  ENTER A BLANK LINE FOR NO INPUT ERROR CHECKING."
  152. REM PRINT
  153. EXPECTNUMCOLS = 0
  154. INPUT "EXPECTED NUMBER OF INPUT COLUMNS = "; EXPECTNUMCOLS
  155. IF EXPECTNUMCOLS <> 0 THEN
  156. ERRORFILE$ = FILENAME$ + ".ERR"
  157. OPEN ERRORFILE$ FOR OUTPUT AS #3
  158. ELSE
  159. END IF
  160.  
  161. TOTAL:
  162. REM PRINT
  163. REM PRINT "THE PROCESS TIME WILL INCREASE IF THE COLUMNS ARE TOTALED."
  164. REM PRINT "TYPE Y OR YES TO TOTAL OUTPUT COLUMNS OTHERWISE TYPE ENTER."
  165. REM PRINT
  166. INPUT "DO YOU WANT TO TOTAL THE OUTPUT COLUMNS"; TOTALCOLS$
  167. TOTALCOLS$ = UCASE$(TOTALCOLS$)
  168. IF TOTALCOLS$ = "Y" THEN TOTALCOLS$ = "YES"
  169.  
  170.  
  171. DELIMITERLEN = LEN(DELIMITER$)
  172. CHANGES = 0
  173. LINENUMBER = 0
  174. LINECHANGES = 0
  175. NUMBEROFERRORS = 0
  176. STARTTIME = TIMER
  177. OPEN IN$ FOR INPUT AS #1
  178. OPEN OUT$ FOR OUTPUT AS #2
  179.  
  180. REM PRINT
  181. REM PRINT "     TO SEE A STATUS REPORT JUST HIT THE SPACE BAR OR ANY KEY."
  182. PRINT
  183. PRINT
  184. PRINT "                       *****  TO ABORT  ******"
  185. PRINT
  186. PRINT " 1. TYPE CONTROL BREAK"
  187. PRINT "    (IF YOU HIT CONTROL BREAK BY MISTAKE AND YOU WOULD NOW LIKE"
  188. PRINT "     TO CONTINUE THE PROGRAM, JUST TYPE THE F5 FUNCTION KEY OR"
  189. PRINT "     SELECT CONTINUE FROM THE RUN MENU BEFORE STEP TWO BELOW)."
  190. PRINT
  191. PRINT " 2. THEN EXIT THE BASIC EDITOR TO CLOSE ALL OPEN FILES !!"
  192. PRINT
  193.  
  194. DO UNTIL (EOF(1))
  195.   LINE INPUT #1, INLINE$
  196.  
  197. REM  STATUSREQ$ = INKEY$
  198.      STATUSREQ$ = ""
  199.  
  200.   IF STATUSREQ$ <> "" THEN
  201.     ELAPSEDTIME = TIMER - STARTTIME
  202.     LINERATE = LINENUMBER * 60 / ELAPSEDTIME
  203.     PRINT
  204.     PRINT "CHANGING COLUMNS IN LINE # "; LINENUMBER; " OF FILE "; FILENAME$;
  205.     PRINT " "; TIME$
  206.     PRINT "ELAPSED TIME ="; ELAPSEDTIME; "SECS."
  207.     PRINT "LINE PROCESS RATE ="; LINERATE; "LINES/MINUTE"
  208. IF EXPECTNUMCOLS <> 0 THEN PRINT "THE NUMBER OF ERRORS FOUND SO FAR IS"; NUMBEROFERRORS
  209. IF TOTALCOLS$ <> "YES" GOTO SKIPSTATUSTOTAL
  210.     PRINT "THE CURRENT OUTPUT COLUMN RUNNING TOTALS AND AVERAGES"
  211.     PRINT "ARE AS FOLLOWS:"
  212.     PRINT "                      OUTPUT COLUMN RUNNING TOTALS"
  213.       FOR ITOTAL = 1 TO LASTCOL
  214.         IF COUNT(ITOTAL) <> 0 THEN PRINT "COLUMN #"; ITOTAL; " = "; TOTAL(ITOTAL),
  215.       NEXT ITOTAL
  216.       PRINT
  217.     PRINT "                      OUTPUT COLUMN RUNNING AVERAGES"
  218.     FOR ITOTAL = 1 TO LASTCOL
  219.       IF COUNT(ITOTAL) <> 0 THEN PRINT "COLUMN #"; ITOTAL; " = "; TOTAL(ITOTAL) / COUNT(ITOTAL),
  220.     NEXT ITOTAL
  221.     PRINT
  222.     PRINT "WARNING **** THE ABOVE VALUES ARE NOT FINAL ***** WARNING *****"
  223.     PRINT "***************************************************************"
  224. SKIPSTATUSTOTAL:
  225.   ELSE
  226.   END IF
  227. LINENUMBER = LINENUMBER + 1
  228.  
  229.   CALL DELIMITERLINEBREAK
  230.   IF EXPECTNUMCOLS = 0 THEN GOTO SKIPERROR
  231.   IF EXPECTNUMCOLS <> NN THEN
  232.     PRINT #3, INLINE$
  233.     NUMBEROFERRORS = NUMBEROFERRORS + 1
  234.   ELSE
  235.   END IF
  236. SKIPERROR:
  237.   GOSUB GENERATEOUTPUTCOLS
  238.  
  239.  IF TOTALCOLS$ <> "YES" GOTO B
  240.  CALL TOTALCOL
  241.  
  242. B:
  243. IF TRANSDETECT$ = "YES" THEN
  244. LASTDELCOL = LASTCOL - 1
  245. FOR ILDC = 1 TO LASTDELCOL
  246.     PRINT #2, OC$(ILDC); DELIMITER$;
  247.     NEXT ILDC
  248. OC$(LASTCOL) = RTRIM$(OC$(LASTCOL))
  249. PRINT #2, OC$(LASTCOL)
  250.  
  251. ELSE
  252. LASTDELCOL = LASTCOL - 1
  253. FOR ILDC = 1 TO LASTDELCOL
  254.     PRINT #2, OC$(ILDC); DELIMITER$;
  255.     NEXT ILDC
  256. PRINT #2, OC$(LASTCOL)
  257. END IF
  258.  
  259. LOOP
  260. CLOSE
  261. REM PRINT
  262. CLS
  263. PRINT
  264. PRINT "THE COLUMN CHANGE HAS COMPLETED NORMALLY & ALL FILES ARE CLOSED."
  265. PRINT
  266. PRINT "TOTAL NUMBER OF LINES = "; LINENUMBER
  267. IF EXPECTNUMCOLS <> 0 THEN PRINT "TOTAL NUMBER OF ERRORS FOUND = "; NUMBEROFERRORS
  268. ELAPSEDTIME = TIMER - STARTTIME
  269. LINERATE = LINENUMBER * 60 / ELAPSEDTIME
  270. PRINT "THE ELAPSED TIME ="; ELAPSEDTIME; " SECONDS."
  271. PRINT "THE LINE PROCESSING RATE ="; LINERATE; "LINES PER MINUTE."
  272. PRINT
  273.  
  274. IF TOTALCOLS$ <> "YES" GOTO SKIPTOTAL
  275. PRINT "   THE FOLLOWING ARE TOTALS AND AVERAGES OF NUMERIC OR"
  276. PRINT "   PARTIALLY NUMERIC OUTPUT COLUMNS.  ALL OUTPUT COLUMN"
  277. PRINT "   ENTRIES STARTING WITH A NUMBER ARE INCLUDED."
  278. PRINT
  279. PRINT "                         OUTPUT COLUMN TOTALS"
  280. PRINT
  281. FOR ITOTAL = 1 TO LASTCOL
  282. IF COUNT(ITOTAL) <> 0 THEN PRINT "COLUMN #"; ITOTAL; " = "; TOTAL(ITOTAL),
  283. NEXT ITOTAL
  284. PRINT
  285. PRINT
  286. PRINT "                         OUTPUT COLUMN AVERAGES"
  287. PRINT
  288. FOR ITOTAL = 1 TO LASTCOL
  289. IF COUNT(ITOTAL) <> 0 THEN PRINT "COLUMN #"; ITOTAL; " = "; TOTAL(ITOTAL) / COUNT(ITOTAL),
  290. NEXT ITOTAL
  291. PRINT
  292. PRINT
  293. SKIPTOTAL:
  294. SYSTEM
  295. END
  296.  
  297. SUB DELIMITERLINEBREAK
  298.  
  299. REM     THIS SUBROUTINE BREAKS UP THE INPUT LINE INTO FIELDS.
  300. REM     1. IN THE NORMAL MODE ONLY ONE DELIMITER IS USED AND THIS
  301. REM        DELIMITER IS NOT INCLUDED IN THE OUTPUT FIELDS.
  302. REM        THIS DELIMITER CAN BE ANY LENGTH GIVEN BY THE INPUT DELIMITERLEN.
  303. REM     2. IN THE TRANSITION DETECTION MODE TWO DELIMITERS ARE
  304. REM        USED AND THE DELIMITERS ARE INCLUDED IN THE OUTPUT.
  305. REM        THESE DELIMITERS MUST EACH BE ONLY ONE CHARACTER LONG.
  306. REM     3. IN THE FIXED FIELD MODE NO DELIMITER IS USED.
  307. REM
  308. REM     INPUTS TO THE SUBROUTINE:
  309. REM        INLINE$      - THE LINE TO BE DIVIDED INTO COLUMNS.
  310. REM        DELIMITER$   - THE DELIMITER THAT WILL DETERMINE COLUMN BREAKS.
  311. REM        DELIMITER2$  - "OR"ed WITH DELIMITER$ IN THE TRANSITION MODE.
  312. REM        DELIMITERLEN - THE LENGTH OF THE DELIMITER IN CHARACTERS.
  313. REM        TRANSDETECT$ - SPECIFIES THE MODE.
  314. REM        FLDSTART     - A VECTOR CONTAINING THE INPUT FIELD STARTING POSITIONS.
  315. REM        FLDLENGTH    - A VECTOR CONTAINING THE INPUT FIELD LENGTHS.
  316. REM        LASTFLDN     - THE LAST INPUT FIELD
  317. REM
  318. REM     OUTPUTS FROM THE SUBROUTINE:
  319. REM        C$(1 TO NN) - A VECTOR CONTAINING THE INLINE$'S COLUMNS
  320. REM        NN          - THE LAST COLUMN NUMBER
  321.  
  322.  
  323.   ERASE C$
  324.   NN = 1
  325.   START = 1
  326.   IF TRANSDETECT$ = "YES" THEN GOTO TRANS
  327.   IF LASTFLDN = 0 GOTO NOTRANS
  328.   FOR NN = 1 TO LASTFLDN
  329.       C$(NN) = MID$(INLINE$, FLDSTART(NN), FLDLENGTH(NN))
  330.   NEXT NN
  331.   EXIT SUB
  332.  
  333. NOTRANS:
  334.   DELPOS = INSTR(START, INLINE$, DELIMITER$)
  335.   IF DELPOS = 0 THEN DELPOS = 1000
  336.   LENGTH = DELPOS - START
  337.   C$(NN) = MID$(INLINE$, START, LENGTH)
  338.   IF DELPOS = 1000 THEN EXIT SUB
  339.   START = DELPOS + DELIMITERLEN
  340.   NN = NN + 1
  341.   GOTO NOTRANS
  342.  
  343. TRANS:
  344. STARTC = 1
  345. STARTD = 1
  346. INLINE$ = LTRIM$(INLINE$)
  347. DUMMY$ = INLINE$
  348. IF SKIPDUMMY$ = "YES" THEN GOTO ENDDUMMY
  349.  
  350. STARTDUMMY:
  351. DELPOS2 = INSTR(STARTD, DUMMY$, DELIMITER2$)
  352. IF DELPOS2 = 0 THEN GOTO ENDDUMMY
  353. MID$(DUMMY$, DELPOS2, 1) = DELIMITER$
  354. STARTD = DELPOS2 + 1
  355. GOTO STARTDUMMY
  356.  
  357. ENDDUMMY:
  358.  
  359. REM FIND FIRST FALL
  360. DELPOST = INSTR(1, DUMMY$, DELIMITER$)
  361. IF DELPOST = 0 THEN GOTO LASTCOL
  362. STARTC = DELPOST + 1
  363.  
  364. FINDNEXTCOL:
  365.  
  366. REM FIND NEXT TEXT
  367. DELPOS = INSTR(STARTC, DUMMY$, DELIMITER$)
  368. IF DELPOS = 0 THEN DELPOS = 1000
  369. INCREMENT = DELPOS - STARTC
  370. STARTC = STARTC + 1
  371. IF INCREMENT = 0 THEN GOTO FINDNEXTCOL
  372. RISE = STARTC - 1
  373. FALL = DELPOS
  374.  
  375. LENGTH = RISE - START
  376. C$(NN) = MID$(INLINE$, START, LENGTH)
  377. START = RISE
  378. NN = NN + 1
  379. IF DELPOS = 1000 THEN GOTO LASTCOL
  380. STARTC = FALL + 1
  381. GOTO FINDNEXTCOL
  382.  
  383. LASTCOL:
  384. LENGTH = 1000
  385. C$(NN) = MID$(INLINE$, START, LENGTH) + DELIMITER$
  386. EXIT SUB
  387.  
  388. END SUB
  389.  
  390. SUB TOTALCOL
  391. REM CALCULATE TOTALS
  392.   FOR ICOL = 1 TO LASTCOL
  393.    OCSTRING$ = OC$(ICOL)
  394.    OCSTRING$ = UCASE$(OCSTRING$)
  395.    ELOCATION = INSTR(1, OCSTRING$, "E")
  396.    IF ELOCATION <> 0 THEN MID$(OCSTRING$, ELOCATION, 1) = "X"
  397.    DLOCATION = INSTR(1, OCSTRING$, "D")
  398.    IF DLOCATION <> 0 THEN MID$(OCSTRING$, DLOCATION, 1) = "X"
  399.    INCRTOTAL = VAL(OCSTRING$)
  400.    TOTAL(ICOL) = TOTAL(ICOL) + INCRTOTAL
  401.    IF INCRTOTAL <> 0 THEN GOTO INCREMENTCOUNT
  402.    OCSTRING$ = LTRIM$(OCSTRING$)
  403.    ZERO = INSTR(1, OCSTRING$, "0")
  404.    IF ZERO = 0 OR ZERO > 3 THEN GOTO SKIPCOUNT
  405.    IF ZERO = 1 THEN GOTO INCREMENTCOUNT
  406.    C1$ = MID$(OCSTRING$, 1, 1)
  407.    IF C1$ <> "." AND C1$ <> "+" AND C1$ <> "-" THEN GOTO SKIPCOUNT
  408.    IF ZERO = 2 THEN GOTO INCREMENTCOUNT
  409.    C2$ = MID$(OCSTRING$, 2, 1)
  410.    IF C1$ <> "." AND C2$ = "." AND ZERO = 3 THEN GOTO INCREMENTCOUNT
  411.    GOTO SKIPCOUNT
  412. INCREMENTCOUNT:
  413. COUNT(ICOL) = COUNT(ICOL) + 1
  414. SKIPCOUNT:
  415.  
  416.   NEXT ICOL
  417.  
  418.  
  419. END SUB
  420.  
  421.