DP Tool Club 24/CD_ASCQ_24_0995.iso/vrac/cols14.zip/COLSTATU.BAS

BASIC Source File | 1995-06-06 | 13KB | 420 lines

REM                 TEXT COLUMN INTERCHANGE PROGRAM
REM                          COLSTATU.BAS
REM                 COPYRIGHT (C) 1995 CHUCK BERNT
REM                       ALL RIGHTS RESERVED

DECLARE SUB TOTALCOL ()
DECLARE SUB DELIMITERLINEBREAK ()
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
CLS

PRINT
INPUT "FILENAME (DO NOT INCLUDE THE EXTENSION .TXT) ="; FILENAME$
PRINT "THE OUTPUT FILENAME WILL BE "; FILENAME$; ".LIS"
PRINT "TYPE CONTROL BREAK TO ABORT (THEN SELECT EXIT FROM THE FILE MENU)"
PRINT
IN$ = FILENAME$ + ".TXT"
OUT$ = FILENAME$ + ".LIS"

PRINT
PRINT "  PLEASE DESCRIBE HOW THE COLUMNS ARE SEPERATED (DELIMITED)"
PRINT "  BY ENTERING ONE OF THE FOLLOWING:"
PRINT
PRINT "  CARRIAGE RETURN - FOR ANY GROUP OF ADJACENT WHITE"
PRINT "                    SPACES (SPACES OR TABS)"
PRINT "                S - for any group of adjacent Spaces"
PRINT "                T - for only one Tab"
PRINT "                C - for only one Comma"
PRINT "                F - Fixed format"
PRINT "                O - for Other (more choices)"
PRINT
A:
INPUT LETTER$
CAPLETTER$ = UCASE$(LETTER$)
SELECT CASE CAPLETTER$
       CASE ""
       PRINT "ANY NUMBER OF WHITE SPACES WAS CHOSEN FOR THE DELIMITER"
       DELIMITER$ = " "
       DELIMITER2$ = CHR$(9)
       TRANSDETECT$ = "YES"

       CASE "C"
       PRINT "ONE COMMA WAS CHOSEN FOR THE DELIMITER"
       DELIMITER$ = ","

       CASE "S"
       PRINT "ANY NUMBER OF SPACES WAS CHOSEN FOR THE DELIMITER"
       DELIMITER$ = " "
       DELIMITER2$ = " "
       TRANSDETECT$ = "YES"
       SKIPDUMMY$ = "YES"

       CASE "T"
       PRINT "ONE TAB WAS CHOSEN FOR THE DELIMITER"
       DELIMITER$ = CHR$(9)

       CASE "O"
       PRINT "  THE DELIMITER CAN BE SPECIFIED IN ONE OF TWO WAYS."
       PRINT "  THE DELIMITER CAN BE EITHER TYPED DIRECTLY OR IT'S"
       PRINT "  ASCII CODE CAN BE SPECIFIED."
       GOTO C

       CASE "F"
       PRINT "FIXED FORMAT WAS CHOSEN"
       GOTO F

       CASE ELSE
       PRINT "OPS PLEASE TRY AGAIN"
       GOTO A
END SELECT
GOTO K

F:
PRINT
PRINT " INPUT FIELDS ARE SPECIFIED BY ENTERING THE STARTING POSITION"
PRINT " OF EACH FIELD ALONG WITH THE ENDING POSITION OF THE LAST FIELD."
PRINT " THE DOS EDITOR CAN BE USED TO FIND THESE POSITIONS."
PRINT
PRINT " THE PROGRAM WILL MOVE THE FIELD LENGTHS ALONG WITH THE FIELDS"
PRINT " AND ADD LENGTH AS REQUIRED BY NEW FIELDS."
PRINT
PRINT " PLEASE TYPE IN THE STARTING POSITION OF EACH FIELD."
PRINT " ENTER A BLANK LINE TO END."
FLDN = 1
PRINT
PRINT "STARTING POSITION OF FIELD NUMBER"; FLDN; "=";
INPUT FLDSTART(FLDN)
LASTFLDN = FLDN
FLDN = 2


INPUTFLD:
PRINT "STARTING POSITION OF FIELD NUMBER"; FLDN; "=";
INPUT FLDSTART(FLDN)
IF FLDSTART(FLDN) = 0 THEN GOTO LASTFLD
FLDLENGTH(LASTFLDN) = FLDSTART(FLDN) - FLDSTART(LASTFLDN)
LASTFLDN = FLDN
FLDN = FLDN + 1
GOTO INPUTFLD

LASTFLD:
PRINT
PRINT "ENDING POSITION OF THE LAST FIELD =";
INPUT FLDSTART(FLDN)
FLDLENGTH(LASTFLDN) = FLDSTART(FLDN) - FLDSTART(LASTFLDN) + 1
GOTO K

C:
PRINT "  MOST COMMON CHARACTERS SUCH AS THE SPACE,"
PRINT "  SEMICOLON, COLON AND PERIOD CAN BE ENTERED"
PRINT "  DIRECTLY.  FOR THE QUOTATION MARK, LINEFEED"
PRINT "  AND ETC. YOU WILL NEED TO ENTER THE ASCII CODE."
PRINT "  THE DELIMITER CAN CONTAIN MORE THEN ONE CHARACTER"

PRINT
PRINT " IF YOU WANT TO SPECIFY THE ASCII CODE"
PRINT " TYPE Y OR YES OTHERWISE TYPE ENTER."
PRINT
INPUT "DO YOU WANT TO SPECIFY ASCII CODE ="; CODE$
CODE$ = UCASE$(CODE$)
IF CODE$ = "Y" THEN CODE$ = "CODE"
IF CODE$ = "YES" THEN CODE$ = "CODE"

IF CODE$ <> "CODE" THEN GOTO CHAR
PRINT " TYPE ONLY ONE ASCII CODE PER LINE AND ENTER A BLANK"
PRINT " LINE TO END.  SOME COMMON ASCII CODES ARE:"
PRINT
PRINT "COMMA=044 CR=013 LINEFEED=010 SPACE=032 TAB=009"
PRINT


I:
INPUT "CHARACTER'S ASCII CODE"; OLDCODE
IF OLDCODE = 0 THEN PRINT : GOTO K
DELIMITER$ = DELIMITER$ + CHR$(OLDCODE)
GOTO I


CHAR:
PRINT "USE DOUBLE QUOTATION MARKS WHEN USING COMMAS, SPACES & ETC."
PRINT "YOU DON'T NEED THE QUOTATION MARKS FOR THE . ; OR:"
PRINT
INPUT "ENTER THE DELIMITER'S CHARACTER(S) "; DELIMITER$

K:
IF LASTFLDN <> 0 THEN GOTO TOTAL
PRINT
PRINT " WOULD YOU LIKE THE PROGRAM TO CHECK EVERY INPUT LINE FOR AN"
PRINT " EXPECTED NUMBER OF COLUMNS AND LIST ALL EXCEPTIONS TO "
PRINT " "; FILENAME$; ".ERR ?  THESE LINES WILL STILL BE PROCESSED IN"
PRINT " ALL OTHER RESPECTS AS IF ERROR CHECKING HAD NOT BEEN CARRIED"
PRINT " OUT.  ENTER A BLANK LINE FOR NO INPUT ERROR CHECKING."
PRINT
INPUT "EXPECTED NUMBER OF INPUT COLUMNS = "; EXPECTNUMCOLS
IF EXPECTNUMCOLS <> 0 THEN
ERRORFILE$ = FILENAME$ + ".ERR"
OPEN ERRORFILE$ FOR OUTPUT AS #3
ELSE
END IF

TOTAL:
PRINT
PRINT "THE PROCESS TIME WILL INCREASE IF THE COLUMNS ARE TOTALED."
PRINT "TYPE Y OR YES TO TOTAL OUTPUT COLUMNS OTHERWISE TYPE ENTER."
PRINT
INPUT "DO YOU WANT TO TOTAL THE OUTPUT COLUMNS"; TOTALCOLS$
TOTALCOLS$ = UCASE$(TOTALCOLS$)
IF TOTALCOLS$ = "Y" THEN TOTALCOLS$ = "YES"

DELIMITERLEN = LEN(DELIMITER$)
CHANGES = 0
LINENUMBER = 0
LINECHANGES = 0
NUMBEROFERRORS = 0
STARTTIME = TIMER
OPEN IN$ FOR INPUT AS #1
OPEN OUT$ FOR OUTPUT AS #2

PRINT
PRINT "     TO SEE A STATUS REPORT JUST HIT THE SPACE BAR OR ANY KEY."
PRINT
PRINT
PRINT "                       *****  TO ABORT  ******"
PRINT
PRINT " 1. TYPE CONTROL BREAK"
PRINT "    (IF YOU HIT CONTROL BREAK BY MISTAKE AND YOU WOULD NOW LIKE"
PRINT "     TO CONTINUE THE PROGRAM, JUST TYPE THE F5 FUNCTION KEY OR"
PRINT "     SELECT CONTINUE FROM THE RUN MENU BEFORE STEP TWO BELOW)."
PRINT
PRINT " 2. THEN EXIT THE BASIC EDITOR TO CLOSE ALL OPEN FILES !!"
PRINT

DO UNTIL (EOF(1))
  LINE INPUT #1, INLINE$

  STATUSREQ$ = INKEY$
REM STATUSREQ$ = ""

  IF STATUSREQ$ <> "" THEN
    ELAPSEDTIME = TIMER - STARTTIME
    LINERATE = LINENUMBER * 60 / ELAPSEDTIME
    PRINT
    PRINT "CHANGING COLUMNS IN LINE # "; LINENUMBER; " OF FILE "; FILENAME$;
    PRINT " "; TIME$
    PRINT "ELAPSED TIME ="; ELAPSEDTIME; "SECS."
    PRINT "LINE PROCESS RATE ="; LINERATE; "LINES/MINUTE"
IF EXPECTNUMCOLS <> 0 THEN PRINT "THE NUMBER OF ERRORS FOUND SO FAR IS"; NUMBEROFERRORS
IF TOTALCOLS$ <> "YES" GOTO SKIPSTATUSTOTAL
    PRINT "THE CURRENT OUTPUT COLUMN RUNNING TOTALS AND AVERAGES"
    PRINT "ARE AS FOLLOWS:"
    PRINT "                      OUTPUT COLUMN RUNNING TOTALS"
      FOR ITOTAL = 1 TO LASTCOL
        IF COUNT(ITOTAL) <> 0 THEN PRINT "COLUMN #"; ITOTAL; " = "; TOTAL(ITOTAL),
      NEXT ITOTAL
      PRINT
    PRINT "                      OUTPUT COLUMN RUNNING AVERAGES"
    FOR ITOTAL = 1 TO LASTCOL
      IF COUNT(ITOTAL) <> 0 THEN PRINT "COLUMN #"; ITOTAL; " = "; TOTAL(ITOTAL) / COUNT(ITOTAL),
    NEXT ITOTAL
    PRINT
    PRINT "WARNING **** THE ABOVE VALUES ARE NOT FINAL ***** WARNING *****"
    PRINT "***************************************************************"
SKIPSTATUSTOTAL:
  ELSE
  END IF
LINENUMBER = LINENUMBER + 1

  CALL DELIMITERLINEBREAK
  IF EXPECTNUMCOLS = 0 THEN GOTO SKIPERROR
  IF EXPECTNUMCOLS <> NN THEN
    PRINT #3, INLINE$
    NUMBEROFERRORS = NUMBEROFERRORS + 1
  ELSE
  END IF
SKIPERROR:
  GOSUB GENERATEOUTPUTCOLS

 IF TOTALCOLS$ <> "YES" GOTO B
 CALL TOTALCOL

B:
IF TRANSDETECT$ = "YES" THEN
LASTDELCOL = LASTCOL - 1
FOR ILDC = 1 TO LASTDELCOL
    PRINT #2, OC$(ILDC); DELIMITER$;
    NEXT ILDC
OC$(LASTCOL) = RTRIM$(OC$(LASTCOL))
PRINT #2, OC$(LASTCOL)

ELSE
LASTDELCOL = LASTCOL - 1
FOR ILDC = 1 TO LASTDELCOL
    PRINT #2, OC$(ILDC); DELIMITER$;
    NEXT ILDC
PRINT #2, OC$(LASTCOL)
END IF

LOOP
CLOSE
PRINT
CLS
PRINT
PRINT "THE COLUMN CHANGE HAS COMPLETED NORMALLY & ALL FILES ARE CLOSED."
PRINT
PRINT "TOTAL NUMBER OF LINES = "; LINENUMBER
IF EXPECTNUMCOLS <> 0 THEN PRINT "TOTAL NUMBER OF ERRORS FOUND = "; NUMBEROFERRORS
ELAPSEDTIME = TIMER - STARTTIME
LINERATE = LINENUMBER * 60 / ELAPSEDTIME
PRINT "THE ELAPSED TIME ="; ELAPSEDTIME; " SECONDS."
PRINT "THE LINE PROCESSING RATE ="; LINERATE; "LINES PER MINUTE."
PRINT

IF TOTALCOLS$ <> "YES" GOTO SKIPTOTAL
PRINT "   THE FOLLOWING ARE TOTALS AND AVERAGES OF NUMERIC OR"
PRINT "   PARTIALLY NUMERIC OUTPUT COLUMNS.  ALL OUTPUT COLUMN"
PRINT "   ENTRIES STARTING WITH A NUMBER ARE INCLUDED."
PRINT
PRINT "                         OUTPUT COLUMN TOTALS"
PRINT
FOR ITOTAL = 1 TO LASTCOL
IF COUNT(ITOTAL) <> 0 THEN PRINT "COLUMN #"; ITOTAL; " = "; TOTAL(ITOTAL),
NEXT ITOTAL
PRINT
PRINT
PRINT "                         OUTPUT COLUMN AVERAGES"
PRINT
FOR ITOTAL = 1 TO LASTCOL
IF COUNT(ITOTAL) <> 0 THEN PRINT "COLUMN #"; ITOTAL; " = "; TOTAL(ITOTAL) / COUNT(ITOTAL),
NEXT ITOTAL
PRINT
PRINT
SKIPTOTAL:
SYSTEM
END

SUB DELIMITERLINEBREAK

REM     THIS SUBROUTINE BREAKS UP THE INPUT LINE INTO FIELDS.
REM     1. IN THE NORMAL MODE ONLY ONE DELIMITER IS USED AND THIS
REM        DELIMITER IS NOT INCLUDED IN THE OUTPUT FIELDS.
REM        THIS DELIMITER CAN BE ANY LENGTH GIVEN BY THE INPUT DELIMITERLEN.
REM     2. IN THE TRANSITION DETECTION MODE TWO DELIMITERS ARE
REM        USED AND THE DELIMITERS ARE INCLUDED IN THE OUTPUT.
REM        THESE DELIMITERS MUST EACH BE ONLY ONE CHARACTER LONG.
REM     3. IN THE FIXED FIELD MODE NO DELIMITER IS USED.
REM
REM     INPUTS TO THE SUBROUTINE:
REM        INLINE$      - THE LINE TO BE DIVIDED INTO COLUMNS.
REM        DELIMITER$   - THE DELIMITER THAT WILL DETERMINE COLUMN BREAKS.
REM        DELIMITER2$  - "OR"ed WITH DELIMITER$ IN THE TRANSITION MODE.
REM        DELIMITERLEN - THE LENGTH OF THE DELIMITER IN CHARACTERS.
REM        TRANSDETECT$ - SPECIFIES THE MODE.
REM        FLDSTART     - A VECTOR CONTAINING THE INPUT FIELD STARTING POSITIONS.
REM        FLDLENGTH    - A VECTOR CONTAINING THE INPUT FIELD LENGTHS.
REM        LASTFLDN     - THE LAST INPUT FIELD
REM
REM     OUTPUTS FROM THE SUBROUTINE:
REM        C$(1 TO NN) - A VECTOR CONTAINING THE INLINE$'S COLUMNS
REM        NN          - THE LAST COLUMN NUMBER


  ERASE C$
  NN = 1
  START = 1
  IF TRANSDETECT$ = "YES" THEN GOTO TRANS
  IF LASTFLDN = 0 GOTO NOTRANS
  FOR NN = 1 TO LASTFLDN
      C$(NN) = MID$(INLINE$, FLDSTART(NN), FLDLENGTH(NN))
  NEXT NN
  EXIT SUB

NOTRANS:
  DELPOS = INSTR(START, INLINE$, DELIMITER$)
  IF DELPOS = 0 THEN DELPOS = 1000
  LENGTH = DELPOS - START
  C$(NN) = MID$(INLINE$, START, LENGTH)
  IF DELPOS = 1000 THEN EXIT SUB
  START = DELPOS + DELIMITERLEN
  NN = NN + 1
  GOTO NOTRANS

TRANS:
STARTC = 1
STARTD = 1
INLINE$ = LTRIM$(INLINE$)
DUMMY$ = INLINE$
IF SKIPDUMMY$ = "YES" THEN GOTO ENDDUMMY

STARTDUMMY:
DELPOS2 = INSTR(STARTD, DUMMY$, DELIMITER2$)
IF DELPOS2 = 0 THEN GOTO ENDDUMMY
MID$(DUMMY$, DELPOS2, 1) = DELIMITER$
STARTD = DELPOS2 + 1
GOTO STARTDUMMY

ENDDUMMY:

REM FIND FIRST FALL
DELPOST = INSTR(1, DUMMY$, DELIMITER$)
IF DELPOST = 0 THEN GOTO LASTCOL
STARTC = DELPOST + 1

FINDNEXTCOL:

REM FIND NEXT TEXT
DELPOS = INSTR(STARTC, DUMMY$, DELIMITER$)
IF DELPOS = 0 THEN DELPOS = 1000
INCREMENT = DELPOS - STARTC
STARTC = STARTC + 1
IF INCREMENT = 0 THEN GOTO FINDNEXTCOL
RISE = STARTC - 1
FALL = DELPOS

LENGTH = RISE - START
C$(NN) = MID$(INLINE$, START, LENGTH)
START = RISE
NN = NN + 1
IF DELPOS = 1000 THEN GOTO LASTCOL
STARTC = FALL + 1
GOTO FINDNEXTCOL

LASTCOL:
LENGTH = 1000
C$(NN) = MID$(INLINE$, START, LENGTH) + DELIMITER$
EXIT SUB

END SUB

SUB TOTALCOL
REM CALCULATE TOTALS
  FOR ICOL = 1 TO LASTCOL
   OCSTRING$ = OC$(ICOL)
   OCSTRING$ = UCASE$(OCSTRING$)
   ELOCATION = INSTR(1, OCSTRING$, "E")
   IF ELOCATION <> 0 THEN MID$(OCSTRING$, ELOCATION, 1) = "X"
   DLOCATION = INSTR(1, OCSTRING$, "D")
   IF DLOCATION <> 0 THEN MID$(OCSTRING$, DLOCATION, 1) = "X"
   INCRTOTAL = VAL(OCSTRING$)
   TOTAL(ICOL) = TOTAL(ICOL) + INCRTOTAL
   IF INCRTOTAL <> 0 THEN GOTO INCREMENTCOUNT
   OCSTRING$ = LTRIM$(OCSTRING$)
   ZERO = INSTR(1, OCSTRING$, "0")
   IF ZERO = 0 OR ZERO > 3 THEN GOTO SKIPCOUNT
   IF ZERO = 1 THEN GOTO INCREMENTCOUNT
   C1$ = MID$(OCSTRING$, 1, 1)
   IF C1$ <> "." AND C1$ <> "+" AND C1$ <> "-" THEN GOTO SKIPCOUNT
   IF ZERO = 2 THEN GOTO INCREMENTCOUNT
   C2$ = MID$(OCSTRING$, 2, 1)
   IF C1$ <> "." AND C2$ = "." AND ZERO = 3 THEN GOTO INCREMENTCOUNT
   GOTO SKIPCOUNT
INCREMENTCOUNT:
COUNT(ICOL) = COUNT(ICOL) + 1
SKIPCOUNT:

  NEXT ICOL


END SUB