I have used this a lot in UNIVERSE:
* SYS.FIX.CTRL.CHARS
*
* ROBERT NORMAN AND ASSOCIATES
* 23441 Golden Springs Dr., #289, Diamond Bar, CA 91765
*
(951) 541-1668
*
I...@KEYWAY.NET
*
http://users.keyway.net/~ice/
* Affordable UNIVERSE programming services for PICK/BASIC, DATA/BASIC, UniVerse
* Basic, UniBasic, R/BASIC, jBC.
*
* Program to do the following:
* 1. Scan the target file for control characters (ASCII: 0-31, 127-250,
* and 255).
* 2. Convert them to uparrow format (^nnn) or delete them from the target
* record.
* 3. Update the target file with the target record, or route the record
* lines with the control characters (in uparrow format) to the screen
* or lineprinter.
*
* Notes:
* Characters 251-254 are not considered to be control characters here
* since they are processed by RETRIEVE as delimiters.
* Don't run this program against source code files, unless you are 100%
* sure that the program doesn't use delimiters like the tab character to
* separate the components of the programming statements. An example of
* this is the EDT program in the APP.PROGS file that comes with UNIVERSE.
* If you do, you might change things which look like 'EQU VAR TO 1' to
* 'EQUVARTO1'. Don't change the logic that specifies control characters
* as CHAR(94):'nnn' or this program might be detected as having a control
* character by the UPARROW.ITEM dictionary item.
*
* Modifications:
* Mod# Date Programmer Description of modification
* 03-29-11 Robert Norman Initial coding.
*
GOSUB 1000 ; * INITIALIZATION
GOSUB 2000 ; * MAIN ROUTINE
GOTO 10000 ; * EXIT ROUTINE
*
1000:* INITIALIZATION
*
!$OPTIONS PICK;* UNCOMMENT TO WORK WITH DELIMETER TYPES 6-8
$INCLUDE UNIVERSE.INCLUDE GETPU.H
*
EQU
PROGRAM.ID TO 'SYS.FIX.CTRL.CHARS'
EQU FM TO CHAR(254),VM TO CHAR(253),SVM TO CHAR(252),TM TO
CHAR(251),ERL TO @(-4)
EQU HILIGHT.ON TO @(-13),HILIGHT.OFF TO @(-14)
NULL.PLACEHOLDER=CHAR(35):CHAR(36):CHAR(37):'NULL':CHAR(37):CHAR(36):CHAR(35)
; * Spells out '#-$-%-NULL-%-$-#' without the dashes (don't
change this line or you could foul up this program if you run this
program on the source file that it is in!)
LEN.NULL.PLACEHOLDER=LEN(NULL.PLACEHOLDER)
PROMPT ''
DIM CHAR.STATS(256)
MAT CHAR.STATS=0
CRT.HIGH=@CRTHIGH
CRT.WIDE=@CRTWIDE
CTRL.CHARS=''
GETPU='!GETPU'
SETPU='!SETPU'
SKIP.UPDATE=0
LOOP
LOOP
CRT"Source file to check ('Q' to quit): ": ; INPUT
SOURCE.FILE.NAME
SOURCE.FILE.NAME=TRIM(
SOURCE.FILE.NAME)
IF
SOURCE.FILE.NAME='Q' THEN RETURN TO 10000 ; * EXIT ROUTINE
OK=1
OPEN
SOURCE.FILE.NAME TO SOURCE.FILE ELSE
CRT"'":
SOURCE.FILE.NAME:"' is not a file name" ; OK=0
END
UNTIL OK DO REPEAT
LOOP
CRT"Destination file to update (<ENTER> to skip update or
'Q' to quit): ": ; INPUT
DESTINATION.FILE.NAME
DESTINATION.FILE.NAME=TRIM(
DESTINATION.FILE.NAME)
IF
DESTINATION.FILE.NAME='Q' THEN RETURN TO 10000
; * EXIT ROUTINE
OK=1
OPEN
DESTINATION.FILE.NAME TO DESTINATION.FILE ELSE
IF
DESTINATION.FILE.NAME#'' THEN
CRT"'":
DESTINATION.FILE.NAME:"' is not a file name" ; OK=0
END
END
UNTIL OK DO REPEAT
UNTIL
SOURCE.FILE.NAME#DESTINATION.FILE.NAME DO
CRT'Files cannot be the same'
REPEAT
CRT"Record id (<ENTER> for all records, 'GET-LIST listname', or
'Q' to quit): ": ; INPUT
RECORD.ID
RECORD.ID=TRIM(
RECORD.ID)
IF
RECORD.ID='Q' THEN RETURN TO 10000 ; * EXIT ROUTINE
LOOP
CRT'<C>onvert (and display), <D>elete (no display) control
characters, or <Q>uit: ': ; INPUT ACTION
ACTION=TRIM(ACTION)
UNTIL ACTION='C' OR ACTION='D' OR ACTION='Q' DO REPEAT
IF ACTION='Q' THEN RETURN TO 10000 ; * EXIT ROUTINE
LOOP
CRT'Enter ASCII values of characters (0-31, 127, 129-250, or
255) to exclude'
CRT'from being identified as control characters, separated by commas'
CRT"(<ENTER> for none or 'Q' to quit)"
CRT': ': ; INPUT ASCII.SKIPS
ASCII.SKIPS=TRIM(ASCII.SKIPS)
IF ASCII.SKIPS='Q' THEN RETURN TO 10000 ; * EXIT ROUTINE
GOSUB 1100 ; * VALIDATE ASCII SKIPS
UNTIL OK DO
CRT'Invalid format'
REPEAT
LOOP
CRT'DETAIL SUPPRESS (Y/N/Q)? ': ; INPUT DET.SUP,1_
UNTIL DET.SUP='Y' OR DET.SUP='N' OR DET.SUP='Q' DO REPEAT
IF DET.SUP='Q' THEN RETURN TO 10000 ; * EXIT ROUTINE
LOOP
CRT'TO PRINTER (Y/N/Q)? ': ; INPUT PTR.OPT,1_
UNTIL PTR.OPT='Y' OR PTR.OPT='N' OR PTR.OPT='Q' DO REPEAT
IF PTR.OPT='Q' THEN RETURN TO 10000 ; * EXIT ROUTINE
CRT'Option Description'
CRT'------
---------------------------------------------------------------'
CRT'U Update destination file only with changed records.'
CRT"Options (U, <ENTER> for none, 'Q' to quit): ": ; INPUT OPTIONS
IF OPTIONS='Q' THEN RETURN TO 10000 ; * EXIT ROUTINE
UFLG=0
L=LEN(OPTIONS)
FOR I=1 TO L
CHR=OPTIONS[I,1]
BEGIN CASE
CASE CHR='U' ; UFLG=1
END CASE
NEXT I
WORD1=FIELD(
RECORD.ID,' ',1)
BEGIN CASE
CASE WORD1='GET-LIST' OR WORD1='GET.LIST'
LIST.NAME=
RECORD.ID[COL2()+1,32767]
CMD='GET-LIST ':
LIST.NAME
CRT CMD
EXECUTE CMD
ITEMS.SELECTED=@SYSTEM.RETURN.CODE
IF ITEMS.SELECTED<0 THEN RETURN TO 10000 ; * EXIT ROUTINE
CASE
RECORD.ID=''
CMD='SELECT ':
SOURCE.FILE.NAME
CRT CMD
EXECUTE CMD
ITEMS.SELECTED=@SYSTEM.RETURN.CODE
IF ITEMS.SELECTED<0 THEN RETURN TO 10000 ; * EXIT ROUTINE
CASE
RECORD.ID#''
SELECT
RECORD.ID
ITEMS.SELECTED=1
END CASE
DONE=0
CHANGED.CTR=0
NOT.FOUND.CTR=0
WRITTEN.CTR=0
BEGIN CASE
CASE PTR.OPT='N'
LINE.LENGTH=CRT.WIDE - 7
CASE PTR.OPT='Y'
PRINTER ON
LPTR.WIDTH=@LPTRWIDE
LINE.LENGTH=LPTR.WIDTH - 7
LPTR.MODE=0 ; CODE=0
CALL @GETPU(PU$MODE,0,LPTR.MODE,CODE) ; * READ INDIVIDUAL
PARAMETERS OF ANY LOGICAL PRINT CHANNEL
IF LPTR.MODE # 3 THEN
* save banner
LPTR.BANNER=SPACE(32)
CODE=0
CALL @GETPU(PU$BANNER,0,LPTR.BANNER,CODE) ; * READ
INDIVIDUAL PARAMETERS OF ANY LOGICAL PRINT CHANNEL
* set banner
RECORD.BANNER=FMT(
PROGRAM.ID, 'L#32')
CALL @SETPU(PU$BANNER,0,RECORD.BANNER,CODE) ; * SET
INDIVIDUAL PARAMETERS OF ANY LOGICAL PRINT CHANNEL
END
END CASE
SKIP.UPDATE=(
DESTINATION.FILE.NAME='')
IF SKIP.UPDATE THEN
LINE1="<":
PROGRAM.ID:"> File: ":
SOURCE.FILE.NAME:" 'T' PAGE 'S''L'"
LINE2=''
HEADING LINE1:LINE2
END ELSE
DUMMY=@(0) ; * DISABLE PAGINATION
END
FOR I=0 TO 31
LOCATE I IN ASCII.SKIPS<1> SETTING FORCE.TO.STANDARD ELSE
FORCE.TO.STANDARD=0
IF NOT(FORCE.TO.STANDARD) THEN
CTRL.CHARS:=CHAR(I)
END
NEXT I
FOR I=127 TO 255
LOCATE I IN ASCII.SKIPS<1> SETTING FORCE.TO.STANDARD ELSE
FORCE.TO.STANDARD=0
BEGIN CASE
CASE I=251 ; * TEXT MARK
CASE I=252 ; * SUBVALUE MARK
CASE I=253 ; * VALUE MARK
CASE I=254 ; * FIELD MARK
CASE 1
IF NOT(FORCE.TO.STANDARD) THEN
CTRL.CHARS:=CHAR(I)
END
END CASE
NEXT I
RETURN
*
1100:* VALIDATE ASCII SKIPS
*
OK=1
IF ASCII.SKIPS#'' THEN
CONVERT ',' TO FM IN ASCII.SKIPS
DC=DCOUNT(ASCII.SKIPS,FM)
FOR I=1 TO DC
ASC=ASCII.SKIPS<I>
IF NUM(ASC) THEN
IF NOT((ASC>=0 & ASC<=31) ! ASC=127 ! (ASC>=129 &
ASC<=250) ! ASC=255) THEN
OK=0
END
END ELSE
OK=0
END
NEXT I
END
RETURN
*
2000:* MAIN ROUTINE
*
LOOP
READNEXT ID ELSE DONE=1
UNTIL DONE DO
READ RECORD FROM SOURCE.FILE,ID THEN
RECORD.WITHOUT.CTRL.CHARS=CONVERT(CTRL.CHARS,'',RECORD)
RECORD.CHANGED=0
IF RECORD.WITHOUT.CTRL.CHARS#RECORD THEN ; * IF
there are control characters in record THEN
LINE.CTR=0
BEGIN CASE
CASE ACTION='C' ; * Convert control characters
DELIM.TYPE=''
NEW.RECORD=''
NEW.LINE=''
FIRST.TIME=1
RECORD=CHANGE(RECORD,CHAR(128),NULL.PLACEHOLDER)
; * Convert CHAR(128) to CHAR(128) placeholder or the logic below
won't work properly in some cases (like a CHAR(128):CHAR(253)
combination in a line)
LOOP
REMOVE ELEMENT FROM RECORD SETTING DELIM.TYPE
BEGIN CASE
CASE DELIM.TYPE=0 ; * End of string
NEW.LINE:=ELEMENT
STRING=NEW.LINE
GOSUB 2100 ; * CONVERT CONTROL
CHARACTERS TO UPARROW FORMAT
NEW.LINE=NEW.STRING
NEW.RECORD<-1>=NEW.LINE
LINE.CTR+=1
IF CHANGED AND DET.SUP='N' THEN
GOSUB 2200 ; * PRINT LINE
END
CASE DELIM.TYPE=1 ; * Item mark ASCII CHAR(255)
NEW.LINE:=ELEMENT:CHAR(255)
CASE DELIM.TYPE=2 ; * Field mark
ASCII CHAR(254)
NEW.LINE:=ELEMENT
STRING=NEW.LINE
GOSUB 2100 ; * CONVERT CONTROL
CHARACTERS TO UPARROW FORMAT
NEW.LINE=NEW.STRING
NEW.RECORD<-1>=NEW.LINE
LINE.CTR+=1
IF CHANGED AND DET.SUP='N' THEN
GOSUB 2200 ; * PRINT LINE
END
NEW.LINE=''
CASE DELIM.TYPE=3 ; * Value mark
ASCII CHAR(253)
NEW.LINE:=ELEMENT:VM
CASE DELIM.TYPE=4 ; * Subvalue mark
ASCII CHAR(252)
NEW.LINE:=ELEMENT:SVM
CASE DELIM.TYPE=5 ; * Text mark ASCII CHAR(251)
NEW.LINE:=ELEMENT:TM
CASE DELIM.TYPE=6 ; * ASCII CHAR(250)
- Not supported in the PIOPEN flavor
NEW.LINE:=ELEMENT:CHAR(250)
CASE DELIM.TYPE=7 ; * ASCII CHAR(249)
- Not supported in the PIOPEN flavor
NEW.LINE:=ELEMENT:CHAR(249)
CASE DELIM.TYPE=8 ; * ASCII CHAR(248)
- Not supported in the PIOPEN flavor
NEW.LINE:=ELEMENT:CHAR(248)
CASE 1 ; * Shouldn't happen (at
least as of ver 10.3.0)
DELIM.POS=GETREM(RECORD) ; * Get
position of delimiter from last REMOVE statement
DELIM=RECORD[DELIM.POS,1]
NEW.LINE:=ELEMENT:DELIM
END CASE
UNTIL DELIM.TYPE=0 DO REPEAT
NEW.RECORD=CHANGE(NEW.RECORD,NULL.PLACEHOLDER,CHAR(94):'128')
; * Convert CHAR(128) placeholder to CHAR(128) uparrow format
CASE ACTION='D' ; * Delete control characters
NEW.RECORD=RECORD.WITHOUT.CTRL.CHARS
END CASE
CHANGED.CTR+=1
IF NOT(SKIP.UPDATE) THEN
PRINT"'":ID:"' changed"
END
END ELSE
NEW.RECORD=RECORD
END
IF NOT(SKIP.UPDATE) THEN
IF UFLG AND NOT(RECORD.CHANGED) THEN
END ELSE
WRITE NEW.RECORD ON DESTINATION.FILE,ID
WRITTEN.CTR+=1
END
END
END ELSE
NOT.FOUND.CTR+=1
PRINT"'":ID:"' not on file"
END
REPEAT
PRINT
PRINT'Items selected : ':ITEMS.SELECTED
PRINT'Records changed : ':CHANGED.CTR
PRINT'Records not found: ':NOT.FOUND.CTR
PRINT'Records written : ':WRITTEN.CTR
PRINT'Character counts :'
CTR=0
FOR I=0 TO 31
STAT=CHAR.STATS(I+1)
IF STAT#0 THEN
PRINT'CHAR(':FMT(I,'R%3'):'):':
STAT=TRIM(FMT(STAT,'5T')) ; * WRAP LINES EVERY 5 CHARS
(SEPARATED BY TEXT MARK)
PRINT STR(' ',6-LEN(STAT)):STAT[1,6]: ; * This is one
more than what we are wrapping at to provide an overflow space
PRINT' ':
IF NOT(MOD(CTR+1,4)) THEN PRINT
CTR+=1
END
NEXT I
FOR I=127 TO 255
BEGIN CASE
CASE I=251 ; * TEXT MARK
CASE I=252 ; * SUBVALUE MARK
CASE I=253 ; * VALUE MARK
CASE I=254 ; * FIELD MARK
CASE 1
STAT=CHAR.STATS(I+1)
IF STAT#0 THEN
PRINT'CHAR(':FMT(I,'R%3'):'):':
STAT=TRIM(FMT(STAT,'5T')) ; * WRAP LINES
EVERY 5 CHARS (SEPARATED BY TEXT MARK)
PRINT STR(' ',6-LEN(STAT)):STAT[1,6]: ; * This
is one more than what we are wrapping at to provide an overflow space
PRINT' ':
IF NOT(MOD(CTR+1,4)) THEN PRINT
CTR+=1
END
END CASE
NEXT I
PRINT
IF PTR.OPT='Y' THEN
PRINTER CLOSE ; * Flush printer buffer
PRINTER OFF
PRINTER CLOSE
IF LPTR.MODE # 3 THEN
* reset banner
PRINTER ON
CALL @SETPU(PU$BANNER,0,LPTR.BANNER,CODE) ; * SET
INDIVIDUAL PARAMETERS OF ANY LOGICAL PRINT CHANNEL
PRINTER CLOSE ; * Flush printer buffer
PRINTER OFF
END
DUMMY=@(0) ; * TURN OFF CRT PAGING
END
RETURN
*
2100:* CONVERT CONTROL CHARACTERS TO UPARROW FORMAT
*
CHANGED=0
L=LEN(STRING)
NEW.STRING=''
HILIGHT.STRING=''
FOR I=1 TO L
CHR=STRING[I,1]
NULL.PLACEHOLDER.TEST=STRING[I,LEN.NULL.PLACEHOLDER]
ASC=SEQ(CHR)
LOCATE ASC IN ASCII.SKIPS<1> SETTING FORCE.TO.STANDARD ELSE
FORCE.TO.STANDARD=0
BEGIN CASE
CASE NULL.PLACEHOLDER.TEST=NULL.PLACEHOLDER ; * CHARACTER 128
IF PTR.OPT='Y' THEN
NEW.STRING:='^':FMT(ASC,'R%3')
END ELSE
HILIGHT.STRING:=HILIGHT.ON:CHAR(94):'128':HILIGHT.OFF
END
CHANGED=1
ASC=128
CHAR.STATS(ASC+1)+=1
I+=(LEN.NULL.PLACEHOLDER-1)
CASE (ASC>=32 & ASC<=126) ! (ASC=251 ! ASC=252 ! ASC=253 !
ASC=254) ! FORCE.TO.STANDARD ; * STANDARD CHARACTERS
NEW.STRING:=CHR
HILIGHT.STRING:=CHR
CASE 1 ; * CONTROL CHARACTERS
NEW.STRING:='^':FMT(ASC,'R%3')
HILIGHT.STRING:=HILIGHT.ON:'^':FMT(ASC,'R%3'):HILIGHT.OFF
CHANGED=1
CHAR.STATS(ASC+1)+=1
END CASE
NEXT I
IF CHANGED THEN RECORD.CHANGED=1
RETURN
*
2200:* PRINT LINE
*
IF FIRST.TIME THEN
FIRST.TIME=0
PRINT
END
IF PTR.OPT='Y' THEN
PRINT.LINE=ID:' @ ':'0000'[1,4-LEN(LINE.CTR)]:LINE.CTR:': ':NEW.LINE
END ELSE
PRINT.LINE=ID:' @ ':'0000'[1,4-LEN(LINE.CTR)]:LINE.CTR:':
':HILIGHT.STRING
END
L=LEN(PRINT.LINE)
FOR X=1 TO L STEP LINE.LENGTH
SEGMENT=PRINT.LINE[X,LINE.LENGTH]
PRINT SEGMENT
NEXT X
RETURN
*
10000:* EXIT ROUTINE
*
IF NOT(SKIP.UPDATE) THEN
CRT @(0,CRT.HIGH-1):ERL:@(0,CRT.HIGH-1):' Press <ENTER> to
continue...': ; INPUT KEY,1_
END
STOP
END
>
https://groups.google.com/d/msgid/mvdbms/SJ2PR11MB76480CDD4A4C2334D681F2B8FAA29%40SJ2PR11MB7648.namprd11.prod.outlook.com.
>