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