Sonderzeichen umsetzen in RPG/IV

[malzusrex]

Ich hatte dafür mal ein kleines Proggie gemacht.
Vielleicht hilft es Dir ja als Gedankenstütze.

 *                                                                                         
 * Programm dient zur Umwandlung von Texten                                                
 *                                                                                         
 * Übergabe Parameter                                                                      
 *                    text       255        den zu konvertierenten Text                    
 *                    art          2        Art der Umwandlung                             
 *                                          'KG' = klein --> GROß                          
 *                                          'GK' = GROß  --> Klein                         
 *                                          '1G' = erster Buchstabe GROß rest klein        
 *                                          '2G' = 1 Buchstabe aller Wörter groß rest klein
 *                                          'ÖO' = ö,Ö,ü,Ü,ä,Ä --> oe,OE,ue,UE,ae,AE       
 *                                          'OÖ' = oe,OE,ue,UE,ae,AE  -->  ö,Ö,ü,Ü,ä,Ä     
 *                                                                                         
 *                    ret_code     1        Fehlerzeiger  ist 'F' wenn art nicht gültig    
 *                                                                                         
 *                                                                                         
d                sds                                                                       
d  parmanz          *parms                                                                 
d  job                  244    253                                                         
d  user                 254    263                                                           
d                                                                                            
d                                                                                            
d art             s              2                                         Umwandluns-Kz     
d ret_code        s              1                                         Fehlerzeiger      
d text            s            255                                                           
d pos             s              3  0                                      Position im String
d Laenge          s              3  0                                      Länge des String  
d Buchstabe       s              1                                                           
d Such_was        s               n                                                          
d                                                                                            
d False           c                   *Off                                                   
d True            c                   *On                                                    
d                 ds                                                                         
d xtext                        255                                         Umsetzungstxt     
d erstes_zei                     1    overlay(xtext:1)                                       
d                                                                                            
d low             c                   const('abcdefghijklmnopqrstuvwxyz')                    
d upp             c                   const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')                    
d                                                                        
                                                                         
c                   Select                                               
c                   When      art = 'KG'                                 
c                   Exsr      klein_gross                                
c                   When      art = 'GK'                                 
c                   Exsr      gross_klein                                
c                   When      art = '1G'                                 
c                   Exsr      erster_gross                               
c                   When      art = '2G'                                 
c                   Exsr      erster_gross1                              
c                   When      art = 'ÖO'                                 
c                   Exsr      umlaut_1                                   
c                   When      art = 'OÖ'                                 
c                   Exsr      umlaut_2                                   
c                   Other                                                
c                   If        parmanz = 3                                
c                   Eval      ret_code = 'F'                             
c                   Endif                                                
c                   Endsl                                                  
c                                                                          
c                   Eval      text = xtext                                 
c                   Eval      *inlr = *on                                  
 *                                                                         
 *                                                                         
 ****************** klein_gross *******************************************
 *                                                                         
 *                                                                         
c     klein_gross   Begsr                                                  
c*                                                                         
c     low:upp       xlate     xtext         xtext                          
c*                                                                         
c                   Endsr                                                  
 *                                                                         
 *                                                                         
 ****************** gross_klein *******************************************
 *                                                                         
 *                                                                         
c     gross_klein   Begsr                                                  
c*                                                                         
c     upp:low       xlate     xtext         xtext                          
c*                                                                         
c                   Endsr                                                  
 *                                                                         
 *                                                                         
 ****************** erster_gross ******************************************
 *                                                                         
 *                                                                         
c     erster_gross  Begsr                                                  
c*                                                                         
c     upp:low       xlate     xtext         xtext                          
c     low:upp       xlate     erstes_zei    erstes_zei                     
c*                                                                         
c                   Endsr                                                  
 *                                                                         
 *                                                                         
 ****************** erster_gross1******************************************
 *    alle 1. Buchstaben pro Wort groß                                     
 *                                                                         
c     erster_gross1 Begsr                                                  
c*                                                                         
c     upp:low       xlate     xtext         xtext                          
c     low:upp       xlate     erstes_zei    erstes_zei                     
c                   Eval      Pos  = 1                                     
c                   Eval      Laenge = %Len( %Trim( xtext ) )              
c                   Eval      Such_Was = True                              
c                   Dow       Such_was                                     
c                                                                          
c                   Eval      Pos  = %Scan(' ' : xtext : pos)              
c                   If        Pos > *Zeros and Pos < Laenge                
c                   Eval      pos = pos +1                                 
c                   Eval      Buchstabe = %SubSt( xtext : pos : 1)         
c     low:upp       xlate     Buchstabe     Buchstabe                      
c                   Eval      xtext = %Replace( Buchstabe : xtext : pos :1)
c                   Else                                                   
c                   Eval      Such_Was = False                             
c                   EndIf                                                  
c                   EndDo                                                  
c*                                                                         
c                   Endsr                                                  
 *                                                                         
 *                                                                         
 ****************** umlaut_1 **********************************************
 *                                                                         
 *                                                                         
c     umlaut_1      Begsr                                                  
c*                                                                         
c                   Eval      pos = %scan('ö':xtext)                       
c                   Dow       pos > *zeros                                 
c                   Eval      xtext = %replace('oe':xtext:pos:1)           
c                   Eval      pos = %scan('ö':xtext)                       
c                   Enddo                                                  
c                   Eval      pos = %scan('Ö':xtext)                       
c                   Dow       pos > *zeros                                 
c                   Eval      xtext = %replace('OE':xtext:pos:1)           
c                   Eval      pos = %scan('Ö':xtext)            
c                   Enddo                                       
c                   Eval      pos = %scan('ü':xtext)            
c                   Dow       pos > *zeros                      
c                   Eval      xtext = %replace('ue':xtext:pos:1)
c                   Eval      pos = %scan('ü':xtext)            
c                   Enddo                                       
c                   Eval      pos = %scan('Ü':xtext)            
c                   Dow       pos > *zeros                      
c                   Eval      xtext = %replace('UE':xtext:pos:1)
c                   Eval      pos = %scan('Ü':xtext)            
c                   Enddo                                       
c                   Eval      pos = %scan('ä':xtext)            
c                   Dow       pos > *zeros                      
c                   Eval      xtext = %replace('ae':xtext:pos:1)
c                   Eval      pos = %scan('ä':xtext)            
c                   Enddo                                       
c                   Eval      pos = %scan('Ä':xtext)            
c                   Dow       pos > *zeros                      
c                   Eval      xtext = %replace('AE':xtext:pos:1)           
c                   Eval      pos = %scan('Ä':xtext)                       
c                   Enddo                                                  
c*                                                                         
c                   Endsr                                                  
 *                                                                         
 *                                                                         
 ****************** umlaut_2 **********************************************
 *                                                                         
 *                                                                         
c     umlaut_2      Begsr                                                  
c*                                                                         
c                   Eval      pos = %scan('oe':xtext)                      
c                   Dow       pos > *zeros                                 
c                   Eval      xtext = %replace('ö':xtext:pos:1)            
c                   Eval      pos = %scan('oe':xtext)                      
c                   Enddo                                                  
c                   Eval      pos = %scan('OE':xtext)                      
c                   Dow       pos > *zeros                                 
c                   Eval      xtext = %replace('Ö':xtext:pos:1)
c                   Eval      pos = %scan('OE':xtext)          
c                   Enddo                                      
c                   Eval      pos = %scan('ue':xtext)          
c                   Dow       pos > *zeros                     
c                   Eval      xtext = %replace('ü':xtext:pos:1)
c                   Eval      pos = %scan('ue':xtext)          
c                   Enddo                                      
c                   Eval      pos = %scan('UE':xtext)          
c                   Dow       pos > *zeros                     
c                   Eval      xtext = %replace('Ü':xtext:pos:1)
c                   Eval      pos = %scan('UE':xtext)          
c                   Enddo                                      
c                   Eval      pos = %scan('ae':xtext)          
c                   Dow       pos > *zeros                     
c                   Eval      xtext = %replace('ä':xtext:pos:1)
c                   Eval      pos = %scan('ae':xtext)          
c                   Enddo                                      
c                   Eval      pos = %scan('AE':xtext)          
c                   Dow       pos > *zeros                                 
c                   Eval      xtext = %replace('Ä':xtext:pos:1)            
c                   Eval      pos = %scan('AE':xtext)                      
c                   Enddo                                                  
c*                                                                         
c                   Endsr                                                  
 *                                                                         
 *                                                                         
 ****************** *inzsr ************************************************
 *                                                                         
 *                                                                         
c     *inzsr        Begsr                                                  
c*                                                                         
c     *entry        Plist                                                  
c                   Parm                    text                           
c                   Parm                    art                            
c                   Parm                    ret_code                       
c                                                                          
c                                                                          
c                   Eval      xtext = text      
c*                                              
c                   Endsr 

Gruß Ronald