midrange.com code scratchpad
Name:
Strings_SP
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
02/08/2012 08:26:31 pm
IP:
Logged
Description:
service program for string manipulation.
Code:
  1.      H Option( *NoDebugIO : *SrcStmt ) NoMain
  2.       // PgmInfo( *PCML : *Module ) NoMain
  3.  
  4.       // Program:  STRINGS_SP    Author:  Tommy Holden
  5.       // Date:  04-05-2011
  6.       //
  7.       // Purpose:  Service Program For String/Character Manipulation Functions
  8.  
  9.       // _____________________________________________________________________
  10.       // Procedure - CENTER_DATA() - Exported
  11.       //  Parameters:
  12.       //  String: Character Max Size 65535
  13.       //  Return String Length:  Integer Const
  14.       // _____________________________________________________________________
  15.       // Procedure - MIX_CASE() - Not Exported
  16.       //  Parameters:
  17.       //   String: Character Max Size 65535
  18.       //   String Length:  Integer Const
  19.       // _____________________________________________________________________
  20.       // Procedure - CONVERT_CASE() - Exported
  21.       //  Parameters:
  22.       //   String: Character Max Size 65535
  23.       //   String Length:  Integer Const
  24.       //   Operation: Constant 'UPPER','LOWER','MIXED'
  25.       // _____________________________________________________________________
  26.       // Procedure - STRIP_SPECIAL_CHARS() - Exported
  27.       //  Parameters:
  28.       //   String: Character Max Size 65535
  29.       //   String Length:  Integer Const
  30.  
  31.       // Copy In Prototypes
  32.       /Copy QCopySrc,Strings_Pr
  33.  
  34.       // Prototypes For Non-Exported Procedures
  35.      d Mix_Case        pr
  36.      d  String                    65535a   Options( *VarSize )
  37.      d  String_Length                10i 0 Const
  38.  
  39.       // Exported Procedures
  40.  
  41.      p Center_Data     b                   Export
  42.      d Center_Data     pi
  43.      d  String                    65535a   Options( *VarSize )
  44.      d  String_Length                10i 0 Const
  45.  
  46.      d Work_Data       s          65535a
  47.      d Start_Position  s             10i 0
  48.      d Data_Length     s             10i 0
  49.      d Divisor         s              5i 0
  50.  
  51.       /free
  52.           If String <> ' ';
  53.             Divisor = String_Length / 2;
  54.             Data_Length = %Len( %Trim( %Subst( String : 1 : String_Length ) ) );
  55.             If Data_Length = String_Length;
  56.               Return;
  57.             EndIf;
  58.  
  59.             Start_Position = Divisor - ( Data_Length / 2 );
  60.  
  61.             Work_Data = %Subst( String : 1 : String_Length );
  62.             %Subst( String : 1 : String_Length ) = ' ';
  63.             If ( Start_Position + Data_Length ) <= String_Length ;
  64.               %Subst( String : Start_Position : Data_Length )
  65.                   = %Trim( Work_Data );
  66.             Else;
  67.               %Subst( String : 1 : String_Length ) = %Trim( Work_Data );
  68.             EndIf;
  69.  
  70.           EndIf;
  71.  
  72.           Return;
  73.  
  74.       /end-free
  75.      pCenter_Data      e
  76.  
  77.      pConvert_Case     b                   Export
  78.      dConvert_Case     pi
  79.      d  String                    65535a   Options( *VarSize )
  80.      d  String_Length                10i 0 Const
  81.      d  Operation                     5a   Const
  82.  
  83.       // Local Variables & Constants
  84.      d Lower_Case      c                   Const('abcdefghijklmnopqrstuvwxyz')
  85.      d Upper_Case      c                   Const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
  86.  
  87.       /free
  88.  
  89.           Select;
  90.  
  91.             When Operation = Upper;
  92.               %Subst( String : 1 : String_Length ) =
  93.                 %XLate( Lower_Case : Upper_Case
  94.                    : %Subst( String : 1 : String_Length ) );
  95.  
  96.             When Operation = Lower;
  97.               %Subst( String : 1 : String_Length ) =
  98.                 %XLate( Upper_Case : Lower_Case
  99.                    : %Subst( String : 1 : String_Length ) );
  100.  
  101.             When Operation = Mixed;
  102.               Mix_Case( String : String_Length );
  103.  
  104.           EndSl;
  105.  
  106.           Return;
  107.       /end-free
  108.      pConvert_Case     e
  109.  
  110.      pMix_Case         b
  111.      dMix_Case         pi
  112.      d  String                    65535a   Options( *VarSize )
  113.      d  String_Length                10i 0 Const
  114.  
  115.       // Local Variables & Constants
  116.      d Work_String     s          65535a
  117.      d i               s             10i 0
  118.      d Converted       s               n
  119.      d Position        s             10i 0
  120.      d Lower_Case      c                   Const('abcdefghijklmnopqrstuvwxyz')
  121.      d Upper_Case      c                   Const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
  122.      d Apostrophe      c                   Const('''')
  123.  
  124.       /free
  125.  
  126.           Work_String = %Subst( String : 1 : String_Length );
  127.  
  128.           Work_String = %XLate( Upper_Case : Lower_Case
  129.              : Work_String );
  130.  
  131.           For i = 1 To String_Length;
  132.  
  133.             If %Subst( Work_String : i : 1 ) = ' ';
  134.               Converted = *Off;
  135.             Else;
  136.  
  137.               If Not Converted;
  138.                 %Subst( Work_String : i : 1 ) =
  139.                    %XLate( Lower_Case : Upper_Case
  140.                      : %Subst( Work_String : i : 1 ) );
  141.                 Converted = *On;
  142.               EndIf;
  143.  
  144.               If Converted
  145.                 And %Subst( Work_String : i : 1 ) = Apostrophe;
  146.                   Converted = *Off;
  147.               EndIf;
  148.  
  149.             EndIf;
  150.  
  151.           EndFor;
  152.  
  153.           %Subst( String : 1 : String_Length )
  154.             = %Subst( Work_String : 1 : String_Length );
  155.  
  156.           Return;
  157.  
  158.       /end-free
  159.      pMix_Case         e
  160.  
  161.      pStrip_Special_Chars...
  162.      p                 b                   Export
  163.      dStrip_Special_Chars...
  164.      d                 pi
  165.      d  String                    65535a   Options( *VarSize )
  166.      d  Length                       10i 0 Const
  167.      d  Keep_Blanks_In...
  168.      d                                 n   Const Options( *NoPass )
  169.  
  170.       // Local Variables & Constants
  171.      d Work_String     s          65535a
  172.      d i               s             10i 0
  173.      d x               s             10i 0
  174.      d SP_DS           ds                  Qualified
  175.      d Special_Chars                 30a
  176.      d Chars                          1a   Dim( 30 ) Overlay( Special_Chars )
  177.      d Keep_Blanks     s               n
  178.  
  179.       /free
  180.  
  181.            If %Parms >= %ParmNum( Keep_Blanks_In );
  182.              Keep_Blanks = Keep_Blanks_In;
  183.            Else;
  184.              Keep_Blanks = *On;
  185.            EndIf;
  186.  
  187.            SP_DS.Special_Chars = '`~!@#$%^&*()_-+=''";,.<>/?\|]{}';
  188.  
  189.            Work_String = %Subst( String : 1 : Length );
  190.            %subst(work_string:65535:1) ='x';
  191.            For i = 1 To Length;
  192.  
  193.              For x = 1 To %Elem( SP_DS.Chars );
  194.  
  195.                If ( %Scan( SP_DS.Chars( x ) : %Subst( Work_String : i : 1 ) )
  196.                  = 0 );
  197.                    Iter;
  198.                EndIf;
  199.  
  200.                If Keep_Blanks;
  201.  
  202.                  %Subst( Work_String : i : 1 ) =
  203.                    %XLate( SP_DS.Chars( x ) : ' '
  204.                       : %Subst( Work_String : i : 1 ) );
  205.                  Leave;
  206.  
  207.                Else;
  208.  
  209.                  %Subst( Work_String : i ) =
  210.                    %Subst( Work_String : i + 1 );
  211.                  i -= 1;
  212.  
  213.                  Leave;
  214.  
  215.                EndIf;
  216.  
  217.              EndFor;
  218.  
  219.            EndFor;
  220.  
  221.            %Subst( String : 1 : Length ) = %Subst( Work_String : 1 : Length );
  222.  
  223.            Return;
  224.  
  225.       /end-free
  226.      pStrip_Special_Chars...
  227.      p                 e
  228.  
  229.      pMixed_Case       b                   Export
  230.      dMixed_Case       pi         32000a   Varying
  231.      d String                     32000a   Varying
  232.  
  233.      d Work_String     s          65535a
  234.      d Length          s             10i 0
  235.       /free
  236.  
  237.          Work_String = String;
  238.  
  239.          Mix_Case( Work_String
  240.                  : %Len( String ) );
  241.  
  242.          String = %Trim( Work_String );
  243.  
  244.          Return String;
  245.  
  246.       /end-free
  247.      pMixed_Case       e
  248.  
  249.      pStrip_Special    b                   Export
  250.      dStrip_Special    pi         32000a   Varying
  251.      d String                     32000a   Varying
  252.  
  253.      d Work_String     s          65535a
  254.      d Length          s             10i 0
  255.       /free
  256.  
  257.          Work_String = String;
  258.  
  259.          Strip_Special_Chars( Work_String
  260.                             : %Len( String )
  261.                             : *On );
  262.  
  263.          String = %Trim( Work_String );
  264.  
  265.          Return String;
  266.  
  267.       /end-free
  268.      pStrip_Special    e
  269.  
  270.  
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css