Le web de Dominique Guebey – IBM AS/400 iSeries

Page : http://www.dg77.net/tekno/as400/asrpgsql.htm


   D o m i n i q u e   G u e b e y    J u n g l e     IBM AS/400 iSeries

Ma petite fenêtre de sélection (SQL en RPG III)

Description

Le programme MAINT01R décrit par ailleurs permet de restreindre l’affichage en fonction d’un code. Ce petit module, appelé par la touche F4, permet de dresser à la volée la liste des codes qui figurent dans le fichier, et d’en choisir un. Les spécifications concernées dans MAINT01R figurent sur fond vert dans le membre source.

Le programme lance une requête SQL SELECT utilisant la clause GROUP BY pour obtenir une ligne par code existant.

Ce programme très simple utilise pour le défilement de la liste un sous-fichier en mode statique. Un exemple plus développé de sous-fichier dynamique se trouve dans la page « Sous-fichier dynamique en RPG III  »

Abstract
This lovely RPG 3 programm uses embedded SQL.

Format d’écran LIST00£

A noter :

     A                                      DSPSIZ(24 80 *DS3)                  
     A                                      PRINT                               
     A          R £1SFL                     SFL
     A            £1OPT          1A  B  3  2DSPATR(UL)                          
     A                                      VALUES('1' ' ')                     
     A            £1CODE         3A  O  3  4                                    
     A          R £1CTL                     SFLCTL(£1SFL)
     A                                      SFLSIZ(0099)                        
     A                                      SFLPAG(0010)                        
     A                                      WINDOW(3 18 13 20)                  
     A N44                                  ROLLUP(45)
     A  44                                  SFLEND    
     A                                      CA03(03 'Sortie')                   
     A                                      CA12(12 'Retour')                   
     A                                      OVERLAY                             
     A                                      WDWBORDER((*COLOR BLU) (*DSPATR RI)-
     A                                       (*CHAR '        '))                
     A N40                                  ERASE(£1SFL)                        
     A  40                                  SFLDSP                              
     A  41                                  SFLDSPCTL                           
     A  42                                  SFLCLR                              
     A            £1LIG          4S 0H      SFLRCDNBR                           
     A                                  1  1'1=Choix puis Entrée'               
     A                                      COLOR(BLU)                          
     A                                  2  1'F12=abandon        '               
     A                                      COLOR(BLU)                          
      * INDISPENSABLE !                 
      * Pour ne pas effacer ce qui est derriere la fenetre…                   
     A          R £BIDON
     A                                      ASSUME                              
     A                                  1  2' '                                 

SQL embarqué en RPG 3

Programme LIST00R. Noter comment le SQL est embarqué : on déclare un curseur (nommé SELCOD pour la circonstance) qu’on ouvre ensuite. Après quoi on lit la vue résultante enregistrement par enregistrement (cf le fetch contenu dans une boucle). Pour finir on ferme le curseur.

A noter encore :

      * Ce programme en RPG 3 contient du SQL :                 
      * le membre source doit être du type SQLRPG               
     FLIST00£ CF  E                    WORKSTN
     F                                        £1REC KSFILE £1SFL
      * Chargement initial              
     C                     EXSR CHGSFL  
      * - - - - - - - - - - - - - - - - - - - - - - - - - -     
     C                     DO   *HIVAL  
      * Ecran                           
     C                     WRITE£1CTL   
     C                     EXFMT£1CTL   
      * F12 = abandon                   
     C           *IN12     IFEQ '1'     
     C                     MOVE '2'       RET                   
     C                     LEAVE        
     C                     ENDIF        
      * Lecture du SFL, s'arrête sur le premier "1"             
     C                     Z-ADD0         WCPT    60            
     C           WCPT      DOWLT099
     C           £1REC     ANDGT0
     C                     ADD  1         WCPT                  
     C           WCPT      CHAIN£1SFL                99         
      * Fin : rien trouvé, réaffiche    
     C           *IN99     IFEQ '1'     
     C                     ITER         
     C                     LEAVE        
      * Sélection faite : sortie (de la lecture du SFL)         
     C           £1OPT     IFEQ '1'     
     C                     MOVE £1CODE    PCODE                 
     C                     LEAVE        
     C                     ENDIF        
     C                     ENDDO        
      *          …et sortie de l'affichage                    
     C           PCODE     IFNE *BLANK  
     C                     LEAVE        
     C                     ENDIF        
      *                                 
     C                     ENDDO        
      *                                 
     C******               MOVE '1'       *INLR
     C                     RETRN
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           CHGSFL    BEGSR        
     C                     Z-ADD0         £1REC   60
     C                     Z-ADD1         £1LIG     
      * Effacement préalable du SFL                 
     C                     MOVEA'001'     *IN,40    
     C                     WRITE£1CTL               
     C                     MOVEA'110'     *IN,40    
      * Chargement du SFL                                 
     C/EXEC SQL                         
     C+ DECLARE SELCOD CURSOR FOR
     C+ SELECT HTCODA FROM ARTICL GROUP BY HTCODA ORDER BY HTCODA               
     C/END-EXEC                         
      *                                 
     C/EXEC SQL                         
     C+ OPEN SELCOD
     C/END-EXEC                         
      * Boucle :                        
     C           SQLCOD    DOWEQ0       
     C           £1REC     ANDLT99
     C/EXEC SQL                         
     C+ FETCH SELCOD INTO :£1CODE
     C/END-EXEC                         
     C           SQLCOD    IFEQ 0       
     C                     ADD  1         £1REC
     C                     WRITE£1SFL   
     C           £1REC     IFEQ 99             
     C                     MOVE '1'       *IN44
     C                     ENDIF               
     C                     ELSE                
     C                     MOVE '1'       *IN44
     C                     ENDIF               
     C                     ENDDO        
      *
     C           £1REC     IFNE 0              
     C                     MOVE '1'       *IN40
     C                     ELSE                
     C                     MOVE '0'       *IN40
     C                     ENDIF               
      * Ferme le curseur                
     C/EXEC SQL                         
     C+ CLOSE SELCOD
     C/END-EXEC                         
      *                                 
     C                     ENDSR        
      * - - - - - - - - - - - - - - - - - - - - - - - - - -                     
     C           *INZSR    BEGSR        
     C           *ENTRY    PLIST        
     C                     PARM           PCODE   3                             
     C                     PARM           RET     1
      *                                 
     C                     MOVE *BLANK    PCODE                                 
     C                     ENDSR