home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l180 / 2.ddi / STRINGS.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-02-07  |  31.6 KB  |  881 lines
  1.   ' ************************************************
  2.   ' **  Name:          STRINGS                    **
  3.   ' **  Type:          Toolbox                    **
  4.   ' **  Module:        STRINGS.BAS                **
  5.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  6.   ' ************************************************
  7.   ' USAGE:           No command line parameters
  8.   ' .MAK FILE:       (none)
  9.   ' PARAMETERS:      (none)
  10.   ' VARIABLES:       a$       Working string for demonstrations
  11.   '                  b$       Working string for demonstrations
  12.   '                  c$       Working string for demonstrations
  13.   '                  x$       Working string for demonstrations
  14.   '                  y$       Working string for demonstrations
  15.   '                  set$     Set of characters that define word separations
  16.   
  17.     DECLARE FUNCTION Ascii2Ebcdic$ (a$)
  18.     DECLARE FUNCTION BestMatch$ (a$, x$, y$)
  19.     DECLARE FUNCTION Center$ (a$, n%)
  20.     DECLARE FUNCTION Detab$ (a$, tabs%)
  21.     DECLARE FUNCTION Ebcdic2Ascii$ (e$)
  22.     DECLARE FUNCTION Entab$ (a$, tabs%)
  23.     DECLARE FUNCTION FilterIn$ (a$, set$)
  24.     DECLARE FUNCTION FilterOut$ (a$, set$)
  25.     DECLARE FUNCTION Lpad$ (a$, n%)
  26.     DECLARE FUNCTION LtrimSet$ (a$, set$)
  27.     DECLARE FUNCTION Ord% (a$)
  28.     DECLARE FUNCTION Repeat$ (a$, n%)
  29.     DECLARE FUNCTION Replace$ (a$, find$, substitute$)
  30.     DECLARE FUNCTION Reverse$ (a$)
  31.     DECLARE FUNCTION ReverseCase$ (a$)
  32.     DECLARE FUNCTION Rpad$ (a$, n%)
  33.     DECLARE FUNCTION RtrimSet$ (a$, set$)
  34.     DECLARE FUNCTION Translate$ (a$, f$, t$)
  35.   
  36.   ' Subprograms
  37.     DECLARE SUB BuildAEStrings ()
  38.   
  39.   ' Quick demonstrations
  40.     CLS
  41.     a$ = "This is a test"
  42.     PRINT "a$", , a$
  43.     PRINT "ReverseCase$(a$)", ReverseCase$(a$)
  44.     PRINT "Reverse$(a$)", , Reverse$(a$)
  45.     PRINT "Repeat$(a$, 3)", Repeat$(a$, 3)
  46.     PRINT
  47.   
  48.     set$ = "T this"
  49.     PRINT "set$", , set$
  50.     PRINT "LtrimSet$(a$, set$)", LtrimSet$(a$, set$)
  51.     PRINT "RtrimSet$(a$, set$)", RtrimSet$(a$, set$)
  52.     PRINT "FilterOut$(a$, set$)", FilterOut$(a$, set$)
  53.     PRINT "FilterIn$(a$, set$)", FilterIn$(a$, set$)
  54.     PRINT
  55.   
  56.     a$ = "elephant"
  57.     x$ = "alpha"
  58.     y$ = "omega"
  59.     PRINT "a$", , a$
  60.     PRINT "x$", , x$
  61.     PRINT "y$", , y$
  62.     PRINT "BestMatch$(a$, x$, y$)", BestMatch$(a$, x$, y$)
  63.     PRINT
  64.   
  65.     PRINT "Press any key to continue"
  66.     DO
  67.     LOOP UNTIL INKEY$ <> ""
  68.   
  69.     CLS
  70.     a$ = "BEL"
  71.     PRINT "a$", , a$
  72.     PRINT "Ord%(a$)", , Ord%(a$)
  73.     PRINT
  74.   
  75.     a$ = "This is a test"
  76.     find$ = "s"
  77.     substitute$ = "<s>"
  78.     PRINT "a$", , , a$
  79.     PRINT "find$", , , find$
  80.     PRINT "substitute$", , , substitute$
  81.     PRINT "Replace$(a$, find$, substitute$)", Replace$(a$, find$, substitute$)
  82.     PRINT
  83.   
  84.     PRINT "a$", , a$
  85.     PRINT "Lpad$(a$, 40)", , ":"; Lpad$(a$, 40); ":"
  86.     PRINT "Rpad$(a$, 40)", , ":"; Rpad$(a$, 40); ":"
  87.     PRINT "Center$(a$, 40)", ":"; Center$(a$, 40); ":"
  88.     PRINT
  89.   
  90.     a$ = "a$ character" + STRING$(2, 9) + "count" + CHR$(9) + "is"
  91.     PRINT a$; LEN(a$)
  92.     PRINT "a$ = Detab$(a$, 8)"
  93.     a$ = Detab$(a$, 8)
  94.     PRINT a$; LEN(a$)
  95.     PRINT "a$ = Entab$(a$, 8)"
  96.     a$ = Entab$(a$, 8)
  97.     PRINT a$; LEN(a$)
  98.     PRINT
  99.   
  100.     PRINT "Press any key to continue"
  101.     DO
  102.     LOOP UNTIL INKEY$ <> ""
  103.   
  104.     CLS
  105.     a$ = "You know this test string has vowels."
  106.     x$ = "aeiou"
  107.     y$ = "eioua"
  108.     PRINT "a$", , a$
  109.     PRINT "x$", , x$
  110.     PRINT "y$", , y$
  111.     PRINT "Translate$(a$, x$, y$)", Translate$(a$, x$, y$)
  112.     PRINT
  113.   
  114.     a$ = "This is a test."
  115.     b$ = Ascii2Ebcdic$(a$)
  116.     c$ = Ebcdic2Ascii$(b$)
  117.     PRINT "a$", , a$
  118.     PRINT "b$ = Ascii2Ebcdic$(a$)", b$
  119.     PRINT "c$ = Ebcdic2Ascii$(b$)", c$
  120.     PRINT
  121.   
  122.     END
  123.  
  124.   ' ************************************************
  125.   ' **  Name:          Ascii2Ebcdic$              **
  126.   ' **  Type:          Function                   **
  127.   ' **  Module:        STRINGS.BAS                **
  128.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  129.   ' ************************************************
  130.   '
  131.   ' Returns a$ with each character translated from ASCII to EBCDIC.
  132.   '
  133.   ' EXAMPLE OF USE:  e$ = Ascii2Ebcdic$(a$)
  134.   ' PARAMETERS:      a$         String of ASCII characters to be
  135.   '                             converted
  136.   ' VARIABLES:       ebcdic$    Table of translation characters
  137.   '                  ascii$     Table of translation characters
  138.   ' MODULE LEVEL
  139.   '   DECLARATIONS:  DECLARE FUNCTION Ascii2Ebcdic$ (a$)
  140.   '
  141.     FUNCTION Ascii2Ebcdic$ (a$) STATIC
  142.         SHARED ebcdic$, ascii$
  143.         IF ebcdic$ = "" THEN
  144.             BuildAEStrings
  145.         END IF
  146.         Ascii2Ebcdic$ = Translate$(a$, ascii$, ebcdic$)
  147.     END FUNCTION
  148.  
  149.   ' ************************************************
  150.   ' **  Name:          BestMatch$                 **
  151.   ' **  Type:          Function                   **
  152.   ' **  Module:        STRINGS.BAS                **
  153.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  154.   ' ************************************************
  155.   '
  156.   ' Returns either x$ or y$, whichever is a best match to a$.
  157.   '
  158.   ' EXAMPLE OF USE:  b$ = BestMatch$(a$, x$, y$)
  159.   ' PARAMETERS:      a$          The string to be matched
  160.   '                  x$          The first string to compare with a$
  161.   '                  y$          The second string to compare with a$
  162.   ' VARIABLES:       ua$         Uppercase working copy of a$
  163.   '                  ux$         Uppercase working copy of x$
  164.   '                  uy$         Uppercase working copy of y$
  165.   '                  lena%       Length of a$
  166.   '                  i%          Length of substrings of ua$
  167.   '                  j%          Index into ua$
  168.   '                  t$          Substrings of ua$
  169.   '                  xscore%     Accumulated score for substring matches
  170.   '                              found in ux$
  171.   '                  yscore%     Accumulated score for substring matches
  172.   '                              found in uy$
  173.   ' MODULE LEVEL
  174.   '   DECLARATIONS:  DECLARE FUNCTION BestMatch$ (a$, x$, y$)
  175.   '
  176.     FUNCTION BestMatch$ (a$, x$, y$) STATIC
  177.         ua$ = UCASE$(a$)
  178.         ux$ = UCASE$(x$)
  179.         uy$ = UCASE$(y$)
  180.         lena% = LEN(ua$)
  181.         FOR i% = 1 TO lena%
  182.             FOR j% = 1 TO lena% - i% + 1
  183.                 t$ = MID$(ua$, j%, i%)
  184.                 IF INSTR(ux$, t$) THEN
  185.                     xscore% = xscore% + i% + i%
  186.                 END IF
  187.                 IF INSTR(uy$, t$) THEN
  188.                     yscore% = yscore% + i% + i%
  189.                 END IF
  190.             NEXT j%
  191.         NEXT i%
  192.         IF xscore% > yscore% THEN
  193.             BestMatch$ = x$
  194.         ELSE
  195.             BestMatch$ = y$
  196.         END IF
  197.     END FUNCTION
  198.  
  199.   ' ************************************************
  200.   ' **  Name:          BuildAEStrings             **
  201.   ' **  Type:          Subprogram                 **
  202.   ' **  Module:        STRINGS.BAS                **
  203.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  204.   ' ************************************************
  205.   '
  206.   ' Called by the Ascii2Ebcdic$ and Ebcdic2Ascii$
  207.   ' functions to build the translation strings.
  208.   ' This subprogram is called only once.
  209.   '
  210.   ' EXAMPLE OF USE:  Called automatically by either the Ascii2Ebcdic$ or
  211.   '                  Ebcdic2Ascii$ function
  212.   ' PARAMETERS:      ascii$     Shared by Ascii2Ebcdic$, Ebcdic2Ascii$, and
  213.   '                             BuildAEStrings
  214.   '                  ebcdic$    Shared by Ascii2Ebcdic$, Ebcdic2Ascii$, and
  215.   '                             BuildAEStrings
  216.   ' VARIABLES:       i%         Index into strings
  217.   '                  byte%      Binary value of character byte
  218.   ' MODULE LEVEL
  219.   '   DECLARATIONS:  DECLARE SUB BuildAEStrings ()
  220.   '
  221.     SUB BuildAEStrings STATIC
  222.         SHARED ebcdic$, ascii$
  223.         ascii$ = SPACE$(128)
  224.         ebcdic$ = ebcdic$ + "00010203372D2E2F1605250B0C0D0E0F"
  225.         ebcdic$ = ebcdic$ + "101112133C3D322618193F271C1D1E1F"
  226.         ebcdic$ = ebcdic$ + "404F7F7B5B6C507D4D5D5C4E6B604B61"
  227.         ebcdic$ = ebcdic$ + "F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F"
  228.         ebcdic$ = ebcdic$ + "7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6"
  229.         ebcdic$ = ebcdic$ + "D7D8D9E2E3E4E5E6E7E8E94AE05A5F6D"
  230.         ebcdic$ = ebcdic$ + "79818283848586878889919293949596"
  231.         ebcdic$ = ebcdic$ + "979899A2A3A4A5A6A7A8A9C06AD0A107"
  232.         FOR i% = 0 TO 127
  233.             MID$(ascii$, i% + 1, 1) = CHR$(i%)
  234.             byte% = VAL("&H" + MID$(ebcdic$, i% + i% + 1, 2))
  235.             MID$(ebcdic$, i% + 1, 1) = CHR$(byte%)
  236.         NEXT i%
  237.         ebcdic$ = LEFT$(ebcdic$, 128)
  238.     END SUB
  239.  
  240.   ' ************************************************
  241.   ' **  Name:          Center$                    **
  242.   ' **  Type:          Function                   **
  243.   ' **  Module:        STRINGS.BAS                **
  244.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  245.   ' ************************************************
  246.   '
  247.   ' Pads a$ with spaces on both ends until text is
  248.   ' centered and the string length is n%.
  249.   '
  250.   ' EXAMPLE OF USE:  b$ = Center$(a$, n%)
  251.   ' PARAMETERS:      a$         String of characters to be padded with spaces
  252.   '                  n%         Desired length of resulting string
  253.   ' VARIABLES:       pad%       Number of spaces to pad at ends of string
  254.   ' MODULE LEVEL
  255.   '   DECLARATIONS:  DECLARE FUNCTION Center$ (a$, n%)
  256.   '
  257.     FUNCTION Center$ (a$, n%) STATIC
  258.         a$ = LTRIM$(RTRIM$(a$))
  259.         pad% = n% - LEN(a$)
  260.         IF pad% > 0 THEN
  261.             Center$ = SPACE$(pad% \ 2) + a$ + SPACE$(pad% - pad% \ 2)
  262.         ELSE
  263.             Center$ = a$
  264.         END IF
  265.     END FUNCTION
  266.  
  267.   ' ************************************************
  268.   ' **  Name           Detab$                     **
  269.   ' **  Type:          Function                   **
  270.   ' **  Module:        STRINGS.BAS                **
  271.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  272.   ' ************************************************
  273.   '
  274.   ' Replaces all tab characters with spaces, using
  275.   ' tabs% to determine proper alignment.
  276.   '
  277.   ' EXAMPLE OF USE:  b$ = Detab$(a$, tabs%)
  278.   ' PARAMETERS:      a$           String with possible tab characters
  279.   '                  tabs%        Tab spacing
  280.   ' VARIABLES:       t$           Working copy of a$
  281.   '                  tb$          Tab character
  282.   '                  tp%          Pointer to position in t$ of a tab character
  283.   '                  sp$          Spaces to replace a given tab character
  284.   ' MODULE LEVEL
  285.   '   DECLARATIONS:  DECLARE FUNCTION Detab$ (a$, tabs%)
  286.   '
  287.     FUNCTION Detab$ (a$, tabs%) STATIC
  288.         t$ = a$
  289.         tb$ = CHR$(9)
  290.         DO
  291.             tp% = INSTR(t$, tb$)
  292.             IF tp% THEN
  293.                 Sp$ = SPACE$(tabs% - ((tp% - 1) MOD tabs%))
  294.                 t$ = LEFT$(t$, tp% - 1) + Sp$ + MID$(t$, tp% + 1)
  295.             END IF
  296.         LOOP UNTIL tp% = 0
  297.         Detab$ = t$
  298.         t$ = ""
  299.     END FUNCTION
  300.  
  301.   ' ************************************************
  302.   ' **  Name:          Ebcdic2Ascii$              **
  303.   ' **  Type:          Function                   **
  304.   ' **  Module:        STRINGS.BAS                **
  305.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  306.   ' ************************************************
  307.   '
  308.   ' Returns a$ with each character translated from
  309.   ' EBCDIC to ASCII.
  310.   '
  311.   ' EXAMPLE OF USE:  b$ = Ebcdic2Ascii$(a$)
  312.   ' PARAMETERS:      a$          String of EBCDIC characters to be converted
  313.   ' VARIABLES:       ebcdic$     Table of translation characters
  314.   '                  ascii$      Table of translation characters
  315.   ' MODULE LEVEL
  316.   '   DECLARATIONS:  DECLARE FUNCTION Ebcdic2Ascii$ (e$)
  317.   '
  318.     FUNCTION Ebcdic2Ascii$ (e$) STATIC
  319.         SHARED ebcdic$, ascii$
  320.         IF ebcdic$ = "" THEN
  321.             BuildAEStrings
  322.         END IF
  323.         Ebcdic2Ascii$ = Translate$(e$, ebcdic$, ascii$)
  324.     END FUNCTION
  325.  
  326.   ' ************************************************
  327.   ' **  Name:          Entab$                     **
  328.   ' **  Type:          Function                   **
  329.   ' **  Module:        STRINGS.BAS                **
  330.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  331.   ' ************************************************
  332.   '
  333.   ' Replaces groups of spaces, where possible, with
  334.   ' tab characters, keeping the alignment indicated
  335.   ' by the value of tabs%.
  336.   '
  337.   ' EXAMPLE OF USE:  b$ = Entab$(a$, tabs%)
  338.   ' PARAMETERS:      a$            String with possible tab characters
  339.   '                  tabs%         Tab spacing
  340.   ' VARIABLES:       t$            Working copy of a$
  341.   '                  tb$           Tab character
  342.   '                  i%            Index into t$
  343.   '                  k%            Count of spaces being replaced
  344.   '                  j%            Index into t$
  345.   ' MODULE LEVEL
  346.   '   DECLARATIONS:  DECLARE FUNCTION Entab$ (a$, tabs%)
  347.   '
  348.     FUNCTION Entab$ (a$, tabs%) STATIC
  349.         t$ = a$
  350.         tb$ = CHR$(9)
  351.         FOR i% = (LEN(t$) \ tabs%) * tabs% + 1 TO tabs% STEP -tabs%
  352.             IF MID$(t$, i% - 1, 1) = " " THEN
  353.                 k% = 0
  354.                 FOR j% = 1 TO tabs%
  355.                     IF MID$(t$, i% - j%, 1) <> " " THEN
  356.                         k% = i% - j%
  357.                         EXIT FOR
  358.                     END IF
  359.                 NEXT j%
  360.                 IF k% = 0 THEN
  361.                     k% = i% - tabs% - 1
  362.                 END IF
  363.                 t$ = LEFT$(t$, k%) + tb$ + MID$(t$, i%)
  364.             END IF
  365.         NEXT i%
  366.         Entab$ = t$
  367.         t$ = ""
  368.     END FUNCTION
  369.  
  370.   ' ************************************************
  371.   ' **  Name:          FilterIn$                  **
  372.   ' **  Type:          Function                   **
  373.   ' **  Module:        STRINGS.BAS                **
  374.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  375.   ' ************************************************
  376.   '
  377.   ' Returns a$ with all occurrences of any characters
  378.   ' that are not in set$ deleted.
  379.   '
  380.   ' EXAMPLE OF USE:  b$ = FilterIn$(a$, set$)
  381.   ' PARAMETERS:      a$          String to be processed
  382.   '                  set$        Set of characters to be retained
  383.   ' VARIABLES:       i%          Index into a$
  384.   '                  j%          Count of characters retained
  385.   '                  lena%       Length of a$
  386.   '                  t$          Working string space
  387.   '                  c$          Each character of a$
  388.   ' MODULE LEVEL
  389.   '   DECLARATIONS:  DECLARE FUNCTION FilterIn$ (a$, set$)
  390.   '
  391.     FUNCTION FilterIn$ (a$, set$) STATIC
  392.         i% = 1
  393.         j% = 0
  394.         lena% = LEN(a$)
  395.         t$ = a$
  396.         DO UNTIL i% > lena%
  397.             c$ = MID$(a$, i%, 1)
  398.             IF INSTR(set$, c$) THEN
  399.                 j% = j% + 1
  400.                 MID$(t$, j%, 1) = c$
  401.             END IF
  402.             i% = i% + 1
  403.         LOOP
  404.         FilterIn$ = LEFT$(t$, j%)
  405.         t$ = ""
  406.     END FUNCTION
  407.  
  408.   ' ************************************************
  409.   ' **  Name:          FilterOut$                 **
  410.   ' **  Type:          Function                   **
  411.   ' **  Module:        STRINGS.BAS                **
  412.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  413.   ' ************************************************
  414.   '
  415.   ' Returns a$ with all occurrences of any characters
  416.   ' from set$ deleted.
  417.   '
  418.   ' EXAMPLE OF USE:  b$ = FilterOut$(a$, set$)
  419.   ' PARAMETERS:      a$           String to be processed
  420.   '                  set$         Set of characters to be retained
  421.   ' VARIABLES:       i%           Index into a$
  422.   '                  j%           Count of characters retained
  423.   '                  lena%        Length of a$
  424.   '                  t$           Working string space
  425.   '                  c$           Each character of a$
  426.   ' MODULE LEVEL
  427.   '   DECLARATIONS:  DECLARE FUNCTION FilterOut$ (a$, set$)
  428.   '
  429.     FUNCTION FilterOut$ (a$, set$) STATIC
  430.         i% = 1
  431.         j% = 0
  432.         lena% = LEN(a$)
  433.         t$ = a$
  434.         DO UNTIL i% > lena%
  435.             c$ = MID$(a$, i%, 1)
  436.             IF INSTR(set$, c$) = 0 THEN
  437.                 j% = j% + 1
  438.                 MID$(t$, j%, 1) = c$
  439.             END IF
  440.             i% = i% + 1
  441.         LOOP
  442.         FilterOut$ = LEFT$(t$, j%)
  443.         t$ = ""
  444.     END FUNCTION
  445.  
  446.   ' ************************************************
  447.   ' **  Name:          Lpad$                      **
  448.   ' **  Type:          Function                   **
  449.   ' **  Module:        STRINGS.BAS                **
  450.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  451.   ' ************************************************
  452.   '
  453.   ' Returns a string of length n%, with a$ left justified
  454.   ' and padded on the right with spaces.
  455.   '
  456.   ' EXAMPLE OF USE:  b$ = Lpad$(a$, n%)
  457.   ' PARAMETERS:      a$          String to be left justified and padded
  458.   '                  n%          Length of string result
  459.   ' VARIABLES:       (none)
  460.   ' MODULE LEVEL
  461.   '   DECLARATIONS:  DECLARE FUNCTION Lpad$ (a$, n%)
  462.   '
  463.     FUNCTION Lpad$ (a$, n%) STATIC
  464.         Lpad$ = LEFT$(LTRIM$(a$) + SPACE$(n%), n%)
  465.     END FUNCTION
  466.  
  467.   ' ************************************************
  468.   ' **  Name:          LtrimSet$                  **
  469.   ' **  Type:          Function                   **
  470.   ' **  Module:        STRINGS.BAS                **
  471.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  472.   ' ************************************************
  473.   '
  474.   ' Trims occurrences of any characters in set$
  475.   ' from the left of a$.
  476.   '
  477.   ' EXAMPLE OF USE:  b$ = LtrimSet$(a$, set$)
  478.   ' PARAMETERS:      a$           String to be trimmed
  479.   '                  set$         Set of characters to be trimmed
  480.   ' VARIABLES:       i%           Index into a$
  481.   ' MODULE LEVEL
  482.   '   DECLARATIONS:  DECLARE FUNCTION LtrimSet$ (a$, set$)
  483.   '
  484.     FUNCTION LtrimSet$ (a$, set$) STATIC
  485.         IF a$ <> "" THEN
  486.             FOR i% = 1 TO LEN(a$)
  487.                 IF INSTR(set$, MID$(a$, i%, 1)) = 0 THEN
  488.                     LtrimSet$ = MID$(a$, i%)
  489.                     EXIT FUNCTION
  490.                 END IF
  491.             NEXT i%
  492.         END IF
  493.         LtrimSet$ = ""
  494.     END FUNCTION
  495.  
  496.   ' ************************************************
  497.   ' **  Name:          Ord%                       **
  498.   ' **  Type:          Function                   **
  499.   ' **  Module:        STRINGS.BAS                **
  500.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  501.   ' ************************************************
  502.   '
  503.   ' Similar to ASC() function; returns
  504.   ' numeric byte values for the ANSI standard
  505.   ' mnemonics for control characters.
  506.   '
  507.   ' EXAMPLE OF USE:  byte% = Ord%(a$)
  508.   ' PARAMETERS:      a$          ANSI standard character mnemonic string
  509.   ' VARIABLES:      (none)
  510.   ' MODULE LEVEL
  511.   '   DECLARATIONS:  DECLARE FUNCTION Ord% (a$)
  512.   '
  513.     FUNCTION Ord% (a$) STATIC
  514.         SELECT CASE UCASE$(a$)
  515.         CASE "NUL"              'Null
  516.             Ord% = 0
  517.         CASE "SOH"              'Start of heading
  518.             Ord% = 1
  519.         CASE "STX"              'Start of text
  520.             Ord% = 2
  521.         CASE "ETX"              'End of text
  522.             Ord% = 3
  523.         CASE "EOT"              'End of transmission
  524.             Ord% = 4
  525.         CASE "ENQ"              'Enquiry
  526.             Ord% = 5
  527.         CASE "ACK"              'Acknowledge
  528.             Ord% = 6
  529.         CASE "BEL"              'Bell
  530.             Ord% = 7
  531.         CASE "BS"               'Backspace
  532.             Ord% = 8
  533.         CASE "HT"               'Horizontal tab
  534.             Ord% = 9
  535.         CASE "LF"               'Line feed
  536.             Ord% = 10
  537.         CASE "VT"               'Vertical tab
  538.             Ord% = 11
  539.         CASE "FF"               'Form feed
  540.             Ord% = 12
  541.         CASE "CR"               'Carriage return
  542.             Ord% = 13
  543.         CASE "SO"               'Shift out
  544.             Ord% = 14
  545.         CASE "SI"               'Shift in
  546.             Ord% = 15
  547.         CASE "DLE"              'Data link escape
  548.             Ord% = 16
  549.         CASE "DC1"              'Device control 1
  550.             Ord% = 17
  551.         CASE "DC2"              'Device control 2
  552.             Ord% = 18
  553.         CASE "DC3"              'Device control 3
  554.             Ord% = 19
  555.         CASE "DC4"              'Device control 4
  556.             Ord% = 20
  557.         CASE "NAK"              'Negative acknowledge
  558.             Ord% = 21
  559.         CASE "SYN"              'Synchronous idle
  560.             Ord% = 22
  561.         CASE "ETB"              'End of transmission block
  562.             Ord% = 23
  563.         CASE "CAN"              'Cancel
  564.             Ord% = 24
  565.         CASE "EM"               'End of medium
  566.             Ord% = 25
  567.         CASE "SUB"              'Substitute
  568.             Ord% = 26
  569.         CASE "ESC"              'Escape
  570.             Ord% = 27
  571.         CASE "FS"               'File separator
  572.             Ord% = 28
  573.         CASE "GS"               'Group separator
  574.             Ord% = 29
  575.         CASE "RS"               'Record separator
  576.             Ord% = 30
  577.         CASE "US"               'Unit separator
  578.             Ord% = 31
  579.         CASE "SP"               'Space
  580.             Ord% = 32
  581.         CASE "UND"              'Underline
  582.             Ord% = 95
  583.         CASE "GRA"              'Grave accent
  584.             Ord% = 96
  585.         CASE "LCA"              'Lowercase a
  586.             Ord% = 97
  587.         CASE "LCB"              'Lowercase b
  588.             Ord% = 98
  589.         CASE "LCC"              'Lowercase c
  590.             Ord% = 99
  591.         CASE "LCD"              'Lowercase d
  592.             Ord% = 100
  593.         CASE "LCE"              'Lowercase e
  594.             Ord% = 101
  595.         CASE "LCF"              'Lowercase f
  596.             Ord% = 102
  597.         CASE "LCG"              'Lowercase g
  598.             Ord% = 103
  599.         CASE "LCH"              'Lowercase h
  600.             Ord% = 104
  601.         CASE "LCI"              'Lowercase i
  602.             Ord% = 105
  603.         CASE "LCJ"              'Lowercase j
  604.             Ord% = 106
  605.         CASE "LCK"              'Lowercase k
  606.             Ord% = 107
  607.         CASE "LCL"              'Lowercase l
  608.             Ord% = 108
  609.         CASE "LCM"              'Lowercase m
  610.             Ord% = 109
  611.         CASE "LCN"              'Lowercase n
  612.             Ord% = 110
  613.         CASE "LCO"              'Lowercase o
  614.             Ord% = 111
  615.         CASE "LCP"              'Lowercase p
  616.             Ord% = 112
  617.         CASE "LCQ"              'Lowercase q
  618.             Ord% = 113
  619.         CASE "LCR"              'Lowercase r
  620.             Ord% = 114
  621.         CASE "LCS"              'Lowercase s
  622.             Ord% = 115
  623.         CASE "LCT"              'Lowercase t
  624.             Ord% = 116
  625.         CASE "LCU"              'Lowercase u
  626.             Ord% = 117
  627.         CASE "LCV"              'Lowercase v
  628.             Ord% = 118
  629.         CASE "LCW"              'Lowercase w
  630.             Ord% = 119
  631.         CASE "LCX"              'Lowercase x
  632.             Ord% = 120
  633.         CASE "LCY"              'Lowercase y
  634.             Ord% = 121
  635.         CASE "LCZ"              'Lowercase z
  636.             Ord% = 122
  637.         CASE "LBR"              'Left brace
  638.             Ord% = 123
  639.         CASE "VLN"              'Vertical line
  640.             Ord% = 124
  641.         CASE "RBR"              'Right brace
  642.             Ord% = 125
  643.         CASE "TIL"              'Tilde
  644.             Ord% = 126
  645.         CASE "DEL"              'Delete
  646.             Ord% = 127
  647.         CASE ELSE               'Not ANSI Standard ORD mnemonic
  648.             Ord% = -1
  649.         END SELECT
  650.     END FUNCTION
  651.  
  652.   ' ************************************************
  653.   ' **  Name:          Repeat$                    **
  654.   ' **  Type:          Function                   **
  655.   ' **  Module:        STRINGS.BAS                **
  656.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  657.   ' ************************************************
  658.   '
  659.   ' Returns a string formed by concatenating n%
  660.   ' copies of a$ together.
  661.   '
  662.   ' EXAMPLE OF USE:  b$ = Repeat$(a$, n%)
  663.   ' PARAMETERS:      a$           String to be repeated
  664.   '                  n%           Number of copies of a$ to concatenate
  665.   ' VARIABLES:       lena%        Length of a$
  666.   '                  lent&        Length of result
  667.   '                  t$           Work space for building result
  668.   '                  ndx%         Index into t$
  669.   ' MODULE LEVEL
  670.   '   DECLARATIONS:  DECLARE FUNCTION Repeat$ (a$, n%)
  671.   '
  672.     FUNCTION Repeat$ (a$, n%) STATIC
  673.         lena% = LEN(a$)
  674.         lent& = n% * lena%
  675.         IF lent& < 0 OR lent& > 32767 THEN
  676.             PRINT "ERROR: Repeat$ - Negative repetition, or result too long"
  677.             SYSTEM
  678.         ELSEIF lent& = 0 THEN
  679.             Repeat$ = ""
  680.         ELSE
  681.             t$ = SPACE$(lent&)
  682.             ndx% = 1
  683.             DO
  684.                 MID$(t$, ndx%, lena%) = a$
  685.                 ndx% = ndx% + lena%
  686.             LOOP UNTIL ndx% > lent&
  687.             Repeat$ = t$
  688.             t$ = ""
  689.         END IF
  690.     END FUNCTION
  691.  
  692.   ' ************************************************
  693.   ' **  Name:          Replace$                   **
  694.   ' **  Type:          Function                   **
  695.   ' **  Module:        STRINGS.BAS                **
  696.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  697.   ' ************************************************
  698.   '
  699.   ' Replaces all occurrences of find$ in a$ with substitute$.
  700.   '
  701.   ' EXAMPLE OF USE:  b$ = Replace$(a$, find$, substitute$)
  702.   ' PARAMETERS:      a$            String to make substring replacements in
  703.   '                  find$         Substring to be searched for
  704.   '                  substitutes$  String for replacing the found
  705.   '                                substrings
  706.   ' VARIABLES:       t$            Working copy of a$
  707.   '                  lenf%         Length of find$
  708.   '                  lens%         Length of substitute$
  709.   '                  i%            Index into a$, pointing at substrings
  710.   ' MODULE LEVEL
  711.   '   DECLARATIONS:  DECLARE FUNCTION Replace$ (a$, find$, substitute$)
  712.   '
  713.     FUNCTION Replace$ (a$, find$, substitute$) STATIC
  714.         t$ = a$
  715.         lenf% = LEN(find$)
  716.         lens% = LEN(substitute$)
  717.         i% = 1
  718.         DO
  719.             i% = INSTR(i%, t$, find$)
  720.             IF i% = 0 THEN
  721.                 EXIT DO
  722.             END IF
  723.             t$ = LEFT$(t$, i% - 1) + substitute$ + MID$(t$, i% + lenf%)
  724.             i% = i% + lens%
  725.         LOOP
  726.         Replace$ = t$
  727.         t$ = ""
  728.     END FUNCTION
  729.  
  730.   ' ************************************************
  731.   ' **  Name:          Reverse$                   **
  732.   ' **  Type:          Function                   **
  733.   ' **  Module:        STRINGS.BAS                **
  734.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  735.   ' ************************************************
  736.   '
  737.   ' Reverses the order of all characters in a$.
  738.   '
  739.   ' EXAMPLE OF USE:  b$ = Reverse$(a$)
  740.   ' PARAMETERS:      a$         String to be processed
  741.   ' VARIABLES:       n%         Length of the string
  742.   '                  r$         Working string space
  743.   '                  i%         Index into the string
  744.   ' MODULE LEVEL
  745.   '   DECLARATIONS:  DECLARE FUNCTION Reverse$ (a$)
  746.   '
  747.     FUNCTION Reverse$ (a$) STATIC
  748.         n% = LEN(a$)
  749.         r$ = a$
  750.         FOR i% = 1 TO n%
  751.             MID$(r$, i%, 1) = MID$(a$, n% - i% + 1, 1)
  752.         NEXT i%
  753.         Reverse$ = r$
  754.         r$ = ""
  755.     END FUNCTION
  756.  
  757.   ' ************************************************
  758.   ' **  Name:          ReverseCase$               **
  759.   ' **  Type:          Function                   **
  760.   ' **  Module:        STRINGS.BAS                **
  761.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  762.   ' ************************************************
  763.   '
  764.   ' Changes all lowercase characters to uppercase
  765.   ' and all uppercase characters to lowercase.
  766.   '
  767.   ' EXAMPLE OF USE:  b$ = ReverseCase$(a$)
  768.   ' PARAMETERS:      a$         String to be processed
  769.   ' VARIABLES:       r$         Working copy of a$
  770.   '                  i%         Index into r$
  771.   '                  t$         Character from middle of a$
  772.   ' MODULE LEVEL
  773.   '   DECLARATIONS:  DECLARE FUNCTION ReverseCase$ (a$)
  774.   '
  775.     FUNCTION ReverseCase$ (a$) STATIC
  776.         r$ = a$
  777.         FOR i% = 1 TO LEN(a$)
  778.             t$ = MID$(a$, i%, 1)
  779.             IF LCASE$(t$) <> t$ THEN
  780.                 MID$(r$, i%, 1) = LCASE$(t$)
  781.             ELSE
  782.                 MID$(r$, i%, 1) = UCASE$(t$)
  783.             END IF
  784.         NEXT i%
  785.         ReverseCase$ = r$
  786.         r$ = ""
  787.     END FUNCTION
  788.  
  789.   ' ************************************************
  790.   ' **  Name:          Rpad$                      **
  791.   ' **  Type:          Function                   **
  792.   ' **  Module:        STRINGS.BAS                **
  793.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  794.   ' ************************************************
  795.   '
  796.   ' Returns string of length n%, with a$ right justified
  797.   ' and padded on the left with spaces.
  798.   '
  799.   ' EXAMPLE OF USE:  b$ = Rpad$(a$, n%)
  800.   ' PARAMETERS:      a$           String to be right justified and padded
  801.   '                  n%           Length of string result
  802.   ' VARIABLES:       (none)
  803.   ' MODULE LEVEL
  804.   '   DECLARATIONS:  DECLARE FUNCTION Rpad$ (a$, n%)
  805.   '
  806.     FUNCTION Rpad$ (a$, n%) STATIC
  807.         Rpad$ = RIGHT$(SPACE$(n%) + RTRIM$(a$), n%)
  808.     END FUNCTION
  809.  
  810.   ' ************************************************
  811.   ' **  Name:          RtrimSet$                  **
  812.   ' **  Type:          Function                   **
  813.   ' **  Module:        STRINGS.BAS                **
  814.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  815.   ' ************************************************
  816.   '
  817.   ' Trims occurrences of any characters in set$
  818.   ' from the right of a$.
  819.   '
  820.   ' EXAMPLE OF USE:  b$ = RtrimSet$(a$, set$)
  821.   ' PARAMETERS:      a$           String to be trimmed
  822.   '                  set$         Set of characters to be trimmed
  823.   ' VARIABLES:       i%           Index into a$
  824.   ' MODULE LEVEL
  825.   '   DECLARATIONS:  DECLARE FUNCTION RtrimSet$ (a$, set$)
  826.   '
  827.     FUNCTION RtrimSet$ (a$, set$) STATIC
  828.         IF a$ <> "" THEN
  829.             FOR i% = LEN(a$) TO 1 STEP -1
  830.                 IF INSTR(set$, MID$(a$, i%, 1)) = 0 THEN
  831.                     RtrimSet$ = LEFT$(a$, i%)
  832.                     EXIT FUNCTION
  833.                 END IF
  834.             NEXT i%
  835.         END IF
  836.         RtrimSet$ = ""
  837.     END FUNCTION
  838.  
  839.   ' ************************************************
  840.   ' **  Name:          Translate$                 **
  841.   ' **  Type:          Function                   **
  842.   ' **  Module:        STRINGS.BAS                **
  843.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  844.   ' ************************************************
  845.   '
  846.   ' Returns a$ with each character translated from
  847.   ' f$ to t$.  If a character from a$ is found in f$,
  848.   ' it is replaced with the character located
  849.   ' in the same position in t$.
  850.   '
  851.   ' EXAMPLE OF USE:  b$ = Translate$ (a$, f$, t$)
  852.   ' PARAMETERS:      a$         String to be translated
  853.   '                  f$         Table of lookup characters
  854.   '                  t$         Table of replacement characters
  855.   ' VARIABLES:       ta$        Working copy of a$
  856.   '                  lena%      Length of a$
  857.   '                  lenf%      Length of f$
  858.   '                  lent%      Length of t$
  859.   '                  i%         Index into ta$
  860.   '                  ptr%       Pointer into f$
  861.   ' MODULE LEVEL
  862.   '   DECLARATIONS:  DECLARE FUNCTION Translate$ (a$, f$, t$)
  863.   '
  864.     FUNCTION Translate$ (a$, f$, t$) STATIC
  865.         ta$ = a$
  866.         lena% = LEN(ta$)
  867.         lenf% = LEN(f$)
  868.         lent% = LEN(t$)
  869.         IF lena% > 0 AND lenf% > 0 AND lent% > 0 THEN
  870.             FOR i% = 1 TO lena%
  871.                 ptr% = INSTR(f$, MID$(ta$, i%, 1))
  872.                 IF ptr% THEN
  873.                     MID$(ta$, i%, 1) = MID$(t$, ptr%, 1)
  874.                 END IF
  875.             NEXT i%
  876.         END IF
  877.         Translate$ = ta$
  878.         ta$ = ""
  879.     END FUNCTION
  880.  
  881.