[NEWSboard IBMi Forum]
  1. #1
    Registriert seit
    Sep 2013
    Beiträge
    21

    Liste der IFS-Freigaben via RPG

    Hallo zusammen

    Ich möchte in einem RPG Programm, nachdem der User einen IFS (Export) Pfad eingegeben hat, sicherstellen können, dass dieser Pfad über eine aktive Verzeichnisfreigabe verfügt, damit die exportierte Datei auch wirklich via PC abgeholt werden kann. In ein Verzeichnis zu exportieren das keine Freigabe hat macht für diesen Job keinen Sinn.

    Ich weiss, dass die Freigaben unter /QIBM/UserData/OS400/Netserver/QAZLSSHR einzusehen sind. Leider ist diese Datei nicht einfach so lesbar. Ein API dazu habe ich nicht gefunden.

    Kennt da jemand eine Möglichkeit?

    Für Eure Vorschläge danke ich im voraus.

  2. #2
    Registriert seit
    May 2002
    Beiträge
    1.121
    Da gibt es ein API dafür
    PHP-Code:
          *************************************************************************                    
          *
    Programm erstellen mit:                                                                    
          *        
    CRTRPGMOD MODULE(mylib/DSPshareSRCFILE(mylib/QRPGLESRC)                       
          *        
    CRTPGM PGM(mylib/dspshareBNDSRVPGM(mylib/#USRSPAPI)                           
          
    *ˆ************************************************************************                    
         
    flist198   o    f  198        printer                                                          
                                                                                                        
         D UserOK          S              1A                                                            
         D UserSpace       S             20A   INZ
    ('FREIGABEN QTEMP     ')                              
         
    D UsrSpcExtA      S             10A   INZ('PROD')                                              
         
    D UsrSpcText      S             50A   INZ('Freigaben IFS    ')                                 
         
    D LstFormat       S              8A   INZ('ZLSL0100')                                          
         
    D InfoQ           s             15A   Inz('*ALL')                                              
         
    D I_O_Err         s               *                                                            
                                                                                                        
         
    D NbrEntries      s             10U 0                                                          
         D Count           s             10U 0                                                          
         D                                                                                              
         D Path            s             50                                                             
         D Zugriff         s             10                                                             
         D AnzMaxU         s             10                                                             
         D AnzCurU         s             10                                                             
         D MaxUsrN         s              6s 0                                                          
         D CurUsrN         s              6s 0                                                          
                                                                                                        
         D FreiG           ds                                                                           
         D  Length                 1      4b 0                                                          
         D  Name                   5     16                                                             
         D  DevType               17     20b 0                                                          
         D  Permiss               21     24b 0                                                          
         D  MaxUsr                25     28b 0                                                          
         D  CurUsr                29     32b 0                                                          
         D  SplFType              33     36b 0                                                          
         d  OfsOfPathNam          37     40b 0                                                          
         d  LenOfPathNam          41     44b 0                                                          
         d  QuaOutQ               45     64                                                             
         d  PrtDrvTyp             65    114                                                             
         d  Text                 115    164                                                             
         d  PathName             165   1188                                                             
                                                                                                        
         d                                                                                              
                                                                                                        
          
    Prototype Lists                                                                             
         D
    /COPY mylib/QRPGLESRC,FUSPCP                                                              
                                                                                                        
         c                   
    Eval      UserOK   =   CrtUsrSpc(UserSpace       :                         
         
    c                                                    UsrSpcExtA      :                         
         
    c                                                    UsrSpcText      )                         
         
    c                                                                                              
         c                   Call      
    'QZLSLSTI'                                                       
         
    c                   Parm                    UserSpace                                          
         c                   Parm                    LstFormat                                          
         c                   Parm                    InfoQ                                              
         c                   Parm                    I_O_Err                                            
         c                                                                                              
         c                   Except    Kopf                                                             
         c                                                                                              
         c                   
    Eval      NbrEntries GetNumEnt(UserSpace)                                
         
    c                                                                                              
         c                   
    For       Count  =  1 to NbrEntries                                        
         c                   
    Eval      FreiG  =  GetSpcEnt(UserSpace Count)                           
         
    c                   ExSr      Ausgabe                                                          
         c                   
    EndFor                                                                     
         
    c                                                                                              
         c                   
    Eval      UserOK   =   DltUsrSpc(UserSpace)                                
         
    c                                                                                              
         c                   
    Eval      *InLr    =   *On                                                 
                                                                                                        
         c     Ausgabe       BegSr                                                                      
         c
    *                                                                                             
         
    c                   Eval      Path = %SubSt(PathName:1:LenOfPathNam)                           
         
    c                   Select                                                                     
         c                   When      Permiss  
    1                                                     
         c                   
    Eval      Zugriff  'Read Only'                                           
         
    c                   When      Permiss  2                                                     
         c                   
    Eval      Zugriff  'Read Write'                                          
         
    c                   EndSl                                                                      
         C                   Z
    -Add     MaxUsr        MaxUsrN                                            
         c                   
    If        MaxUsrN  = -1                                                    
         c                   
    Eval      AnzMaxU  '*NoMax'                                              
         
    c                   Else                                                                       
         
    c                   Eval      AnzMaxU  = %TrimL(%EditC(MaxUsrN:'Z'))                           
         
    c                   EndIf                                                                      
         
    C                   Z-Add     CurUsr        CurUsrN                                            
         c                   
    Eval      AnzCurU  = %TrimL(%EditC(CurUsrN:'Z'))                           
         
    c                                                                                              
         c                   Except    Zeile                                                            
         c
    *                                                                                             
         
    c                   EndSr                                                                      
                                                                                                        
         olist198   e            Kopf           2 01                                                    
         o                                              
    'Folgende Ordner sind im IF'                    
         
    o                                              'S freigegeben'                                 
         
    o          e            Kopf           2                                                       
         o                                            4 
    'Name'                                          
         
    o                                           17 'Pfad'                                          
         
    o                                           71 'Zugriff'                                       
         
    o                                         +  'Maximale Anzahl User'                          
         
    o                                         +  'Aktuelle User'                                 
         
    o                                         +  'Beschreibung'                                  
         
    o          e            Zeile          1                                                       
         o                       Name                                                                   
         o                       Path              
    +  1                                                 
         o                       Zugriff           
    +  1                                                 
         o                       AnzMaxU           
    +  4                                                 
         o                       AnzCurU           
    14                                                 
         o                       Text              
    +  
    PHP-Code:
          *ˆ************************************************************************                    
          
    *Service PGM erstellen mit:                                                               
          *        
    CRTRPGMOD MODULE(mylib/#USRSPAPI) SRCFILE(mylib/QRPGLESRC)                   
          
    *        CRTSRVPGM SRVPGM(mylib/#USRSPAPI) EXPORT(*ALL)                                   
          
    *************************************************************************                    
          *                                                                                             
          **************************************************************************                    
          *                                                                                             
          *     
    Program NameFunctUsp                                                                  
          
    *    Program TitleUser Space Function Procedures                                            
          
    *           Author:                                                                           
          *      
    Origin Date:  1/23/1998                                                                
          
    *        Revisions:                                                                           
          *                                                                                             
          **************************************************************************                    
         
    H NOMAIN                                                                                       
                                                                                                        
          
    Prototype Lists                                                                             
         D
    /COPY mylib/QRPGLESRC,FUSPCp                                                              
                                                                                                        
          
    Generic Error Structure                                                                     
         D
    /COPY mylib/QRPGLESRC,QUSEC                                                               
          
    User Space Generic Structure                                                                
         D
    /COPY mylib/QRPGLESRC,QUSGEN                                                              
                                                                                                        
                                                                                                        
         D DS_Error        DS                                                                           
         D Bytpv                   1      4b 0 inz
    (100)                                                 
         
    D Bytav                   5      8b 0 inz(0)                                                   
         
    D MSgid                   9     15                                                             
         D Resvd                  16     16                                                             
         D Exdta                  17    256                                                             
         D Exdta52                17     67                                                             
                                                                                                        
          
    **************************************************************************                    
          *                                                                                             
          *  
    Procedure Name:  CrtUsrSpc                                                                 
          
    *                                                                                             
          **************************************************************************                    
         
    P CrtUsrSpc       B                   EXPORT                                                   
         D CrtUsrSpc       PI             1A                                                            
         D  UsrSpcName                   20A   VALUE                                                    
         D  UsrSpcExtA                   10A   VALUE                                                    
         D  UsrSpcText                   50A   VALUE                                                    
                                                                                                        
                                                                                                        
          
    Local Variables                                                                             
                                                                                                        
          
    User Space API Fields                                                                       
         D SpaceName       S             20A                                                            
         D SpaceSize       S              9B 0 INZ
    (8388608)                                             
         
    D SpaceInit       S              1A   INZ(x'00')                                               
         
    D SpaceExtA       S             10A                                                            
         D SpaceAut        S             10A   INZ
    ('*ALL')                                              
         
    D SpaceText       S             50A                                                            
         D SpaceRepl       S             10A   INZ
    ('*YES')                                              
         
    D SpaceDom        S             10A   INZ('*USER')                                             
                                                                                                        
          *   
    Set error code structure to use basic feedback                                            
         C
    *****              EVAL      QUSBPRV 16                                                     
                                                                                                        
          
    Set up imported variables                                                                   
         C                   
    EVAL      SpaceName UsrSpcName                                           
         C                   
    EVAL      SpaceExtA UsrSpcExtA                                           
         C                   
    EVAL      SpaceText UsrSpcText                                           
                                                                                                        
         C                   CALL      
    'QUSCRTUS'                                                       
         
    C                   PARM                    SpaceName                                          
         C                   PARM                    SpaceExtA                                          
         C                   PARM                    SpaceSize                                          
         C                   PARM                    SpaceInit                                          
         C                   PARM                    SpaceAut                                           
         C                   PARM                    SpaceText                                          
         C                   PARM                    SpaceRepl                                          
         C                   PARM                    DS_Error                                           
         C                   PARM                    SpaceDom                                           
                                                                                                        
         C                   SELECT                                                                     
         C                   WHEN      Bytav 
    0                                                        
         C                   
    RETURN    'Y'                                                              
         
    C                   WHEN      Bytav <> 0                                                       
         C     Bytav         DSPLY     
    'OS400'                                                          
         
    C     MSgid         DSPLY     'OS400'                                                          
         
    C     Exdta52       DSPLY     'OS400'                                                          
         
    C                   RETURN    'N'                                                              
         
    C                   ENDSL                                                                      
                                                                                                        
         P CrtUsrSpc       E                                                                            
                                                                                                        
          
    **************************************************************************                    
          *                                                                                             
          *  
    Procedure Name:  GetUsrSpcP                                                                
          
    *                                                                                             
          **************************************************************************                    
         
    P GetUsrSpcP      B                   EXPORT                                                   
         D GetUsrSpcP      PI              
    *                                                            
         
    D  UsrSpcName                   20A   VALUE                                                    
                                                                                                        
         D SpaceName       S             20A                                                            
         D SpacePoint      S               
    *                                                            
                                                                                                        
          *   
    Set error code structure to use basic feedback                                            
         C                   
    EVAL      QUSBPRV 16                                                     
                                                                                                        
          
    Set up imported variables                                                                   
         C                   
    EVAL      SpaceName UsrSpcName                                           
                                                                                                        
          
    Get the pointer for the user space                                                          
         C                   CALL      
    'QUSPTRUS'                                                       
         
    C                   PARM                    SpaceName                                          
         C                   PARM                    SpacePoint                                         
         C                   PARM                    QUSEC                                              
                                                                                                        
         C                   
    RETURN                  SpacePoint                                         
                                                                                                        
         P GetUsrSpcP      E                                                                            
                                                                                                        
          
    **************************************************************************                    
          *                                                                                             
          *  
    Procedure Name:  GetNumEnt                                                                 
          
    *                                                                                             
          **************************************************************************                    
         
    P GetNumEnt       B                   EXPORT                                                   
         D GetNumEnt       PI             9B 0                                                          
         D  UsrSpcName                   20A   VALUE                                                    
                                                                                                        
          
    Local Variables                                                                             
         D UsrSpcPntr      S               
    *                                                            
         
    D BigField        S          32767A   BASED(UsrSpcPntr)                                        
                                                                                                        
          * 
    Get the pointer for the user space                                                          
         C                   
    EVAL      UsrSpcPntr GetUsrSpcP(UsrSpcName)                              
                                                                                                        
          * 
    Move the based on pointer to                                                                
         C                   MOVEL     BigField      QUSH0100                                           
                                                                                                        
          
    * Return number of list entries                                                               
         C                   
    RETURN    QUSNBRLE                                                         
                                                                                                        
         P GetNumEnt       E                                                                            
                                                                                                        
          
    **************************************************************************                    
          *                                                                                             
          *  
    Procedure Name:  GetSpcEnt                                                                 
          
    *                                                                                             
          **************************************************************************                    
         
    P GetSpcEnt       B                   EXPORT                                                   
         D GetSpcEnt       PI         32767A                                                            
         D  UsrSpcName                   20A   VALUE                                                    
         D  EntNumber                     9B 0 VALUE                                                    
                                                                                                        
          
    Local Variables                                                                             
         D UsrSpcPntr      S               
    *                                                            
         
    D ListPointr      S               *                                                            
         
    D BigField        S          32767A   BASED(ListPointr)                                        
         
    D BigFldOut       S          32767A                                                            
                                                                                                        
          
    Get the pointer for the user space                                                          
         C                   
    EVAL      UsrSpcPntr GetUsrSpcP(UsrSpcName)                              
                                                                                                        
          * 
    Move the based on pointer to get header information                                         
         C                   
    EVAL      ListPointr UsrSpcPntr                                          
         C                   MOVEL     BigField      QUSH0100                                           
                                                                                                        
          
    Check to see if  entry requested is <= user space number entries                            
          
    *   If not, return a blank field                                                              
         C                   
    IF        EntNumber QUSNBRLE                                             
         C                   
    EVAL      BigFldOut = *BLANKS                                              
         C                   
    RETURN    BigFldOut                                                        
         C                   
    ENDIF                                                                      
                                                                                                        
          * Return 
    specific list entry                                                                  
         C                   
    EVAL      EntNumber EntNumber 1                                        
         C                   
    EVAL      ListPointr ListPointr QUSOLD +                               
         
    C                                        (QUSSEE EntNumber)                                  
         
    C                   EVAL      BigFldOut = %SUBST(BigField:1:QUSSEE)                            
                                                                                                        
         
    C                   RETURN    BigFldOut                                                        
                                                                                                        
         P GetSpcEnt       E                                                                            
          
    **************************************************************************                    
          *                                                                                             
          *  
    Procedure Name:  DltUsrSpc                                                                 
          
    *                                                                                             
          **************************************************************************                    
         
    P DltUsrSpc       B                   EXPORT                                                   
         D DltUsrSpc       PI             1A                                                            
         D  UsrSpcName                   20A   VALUE                                                    
                                                                                                        
                                                                                                        
          
    Local Variables                                                                             
                                                                                                        
          
    User Space API Fields                                                                       
         D SpaceName       S             20A                                                            
                                                                                                        
          
    *   Set error code structure to use basic feedback                                            
         C                   
    EVAL      QUSBPRV 16                                                     
                                                                                                        
          
    Set up imported variables                                                                   
         C                   
    EVAL      SpaceName UsrSpcName                                           
                                                                                                        
         C                   CALL      
    'QUSDLTUS'                                                       
         
    C                   PARM                    SpaceName                                          
         C                   PARM                    QUSEC                                              
                                                                                                        
         C                   SELECT                                                                     
         C                   WHEN      QUSBAVL 
    0                                                      
         C                   
    RETURN    'Y'                                                              
         
    C                   WHEN      QUSBAVL <> 0                                                     
         C                   
    RETURN    'N'                                                              
         
    C                   ENDSL                                                                      
                                                                                                        
         P DltUsrSpc       E 

    Sicher gibt es jetzt auch schon was mit SQL dafür..

    Gruß
    Ronald

  3. #3
    Registriert seit
    Sep 2013
    Beiträge
    21
    Vielen herzlichen Dank für die prompte Antwort und für das API. Werde mal versuchen das sinnvoll zu implementieren.

    Eine Abfrage mit SQL? Da wäre ich ebenfalls sehr interessiert!

  4. #4
    Registriert seit
    May 2002
    Beiträge
    1.121
    Vor ein "paar" Tagen hatten wir das schon mal..
    http://www.newsolutions.de/forum-sys...light=QZLSLSTI

  5. #5
    Registriert seit
    Feb 2001
    Beiträge
    20.207
    Dienstleistungen? Die gibt es hier: http://www.fuerchau.de
    Das Excel-AddIn: https://www.ftsolutions.de/index.php/downloads
    BI? Da war doch noch was: http://www.ftsolutions.de

  6. #6
    Registriert seit
    Sep 2013
    Beiträge
    21
    In der Liste der Services ist nichts passendes drin. Bin zwar noch auf V7R2, finde aber in der Gesamtübersicht der Services von V7R4 auch nichts was mich anspringt, obwohl es sogar eine extra-Rubrik IFS hat...

    Vielen Dank für Eure Tipps.

  7. #7
    Registriert seit
    Feb 2001
    Beiträge
    20.207
    Es hindert dich ja keiner, mit obigen API's und Birgittas Hinweisen zu "TableFunction" eine eigene SQL-Funktion zu stricken:

    select * from table ( mytableshares() )
    Dienstleistungen? Die gibt es hier: http://www.fuerchau.de
    Das Excel-AddIn: https://www.ftsolutions.de/index.php/downloads
    BI? Da war doch noch was: http://www.ftsolutions.de

Similar Threads

  1. Antworten: 3
    Letzter Beitrag: 22-05-17, 17:21
  2. QNTC-Zugriff auf Freigaben
    By Chris.jan in forum IBM i Hauptforum
    Antworten: 3
    Letzter Beitrag: 01-07-14, 11:04
  3. IFS Freigaben berechtigen
    By cs400_de in forum NEWSboard SAP
    Antworten: 12
    Letzter Beitrag: 18-04-07, 10:08
  4. Liste von Berechtigungen
    By Marlin in forum NEWSboard Windows
    Antworten: 0
    Letzter Beitrag: 04-03-03, 08:34
  5. BIBL.-Liste im WAS 3.5 definieren
    By sufukli in forum IBM i Hauptforum
    Antworten: 4
    Letzter Beitrag: 07-06-02, 13:07

Tags for this Thread

Berechtigungen

  • Neue Themen erstellen: Nein
  • Themen beantworten: Nein
  • You may not post attachments
  • You may not edit your posts
  •