code

Name
Astradyne (UK) Ltd
Scriptlanguage
Plain Text
Tabwidth
4
Date
Thu, 08 Feb 2007 21:29:01 +0000
IP
192.168.0.34

Sub-procedure to retrieve the OS/400 version using the Retrieve Product Information (QSZRTVPR) system API.

  1.     D* Standard API Error Data Structure
  2.     D ApiError        DS                                     
  3.     D  ApiBytes                    10I 0 Inz(%Size(ApiError))
  4.     D  ApiBytesOut                10I 0                   
  5.     D  ApiErrID                    7A                     
  6.     D  ApiReserved                  1A                     
  7.     D  ApiErInDta                256A                     
  8.  
  9.     D* Prototypes
  10.     D RtvOS400Ver    pr            6a                   
  11.                                                            
  12.     D QszRtvPR        pr                  ExtPgm('QSZRTVPR')
  13.     D  verRcvVar                          Like(Prdr0100)   
  14.     D  verRcvLen                    10i 0 Const           
  15.     D  verFormat                    8a  Const           
  16.     D  verPrdInf                    27a  Const           
  17.     D  verError                          Like(ApiError)   
  18.  
  19.     D* Output format for API Call...                                         
  20.     D Prdr0100        ds               
  21.     D  PrdBytReturn                10i 0
  22.     D  PrdBytAvail                  10i 0
  23.     D  PrdReserve_1                10i 0
  24.     D  PrdID                        7a 
  25.     D  PrdVersion                    6a 
  26.     D  PrdOption                    4a 
  27.     D  PrdLoadID                    4a
  28.     D  PrdLoadType                  10a
  29.     D  PrdSymbState                10a
  30.     D  PrdLoadErr                  10a
  31.     D  PrdLoadState                  2a
  32.     D  PrdSupported                  1a
  33.     D  PrdRegType                    2a
  34.     D  PrdRegValue                  14a
  35.     D  PrdReserved_2                2a 
  36.     D  PrdOffAddInf                10i 0
  37.     D  PrdPrimLang                  4a 
  38.     D  PrdMinTgtRls                  6a 
  39.     D  PrdMinBaseVRM                6a 
  40.     D  PrdReqMet                    1a 
  41.     D  PrdLevel                      3a 
  42.                                          
  43.     D OS400Rls        c                  Const('*OPSYS *CUR  0000*CODE    ')
  44.  
  45.     D wVersion        s              6a                                     
  46.  
  47.     C                  Eval      wVersion = RtvOS400Ver()
  48.     C    wVersion      Dsply
  49.     C                  Eval      *InLr = *On
  50.  
  51.     P*  Retrieve OS/400 Version                                             
  52.     P RtvOS400Ver    b                  Export                           
  53.                                                                              
  54.     D* Procedure interface                                                 
  55.     D RtvOS400Ver    pi            6a                                     
  56.                                                                              
  57.     C* Procedure calculation specifications                                 
  58.                                                                              
  59.     C*  Call the API...                                                   
  60.     C                  Reset                  ApiError                   
  61.     C                  CallP    QszRtvPr(PrdR0100 : %len(PrdR0100) :     
  62.     C                                      'PRDR0100' : OS400Rls : ApiError)
  63.                                                                              
  64.     C                  If        ApiBytesOut <> 0                         
  65.     C                  Return    '*ERROR'                                 
  66.     C                  Else                                               
  67.     C                  Return    PrdVersion                               
  68.     C                  EndIf                                               
  69.                                                                              
  70.     P RtvOS400Ver    e
  71. </pre>
  72.