[NEWSboard IBMi Forum]
  1. #1
    Registriert seit
    Jan 2007
    Beiträge
    904

    IFS Share Name ermitteln

    Hallo,

    Kennt jemand eine Methode um den Share Namen eines IFS Ordners zu ermitteln - am liebsten mit RPG.

    Danke für den Input.
    kf

  2. #2
    Registriert seit
    May 2002
    Beiträge
    1.121
    Schaue mal bei den NetServer-APIs.

    http://www-01.ibm.com/support/knowle...de.htm?lang=en

    Gruß
    Ronald

    Habe da noch eine alte Quelle gefunden

    PHP-Code:
    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    
                                          
     
    Prototype Lists                                                     
    D
    /COPY malz/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:
     /IF NOT DEFINED(FUSPCP)                                                   
     **************************************************************************
     *                                                                         
     *     
    Program NameFunctUSPcp                                            
     
    *    Program TitleCopy Member for User Space Prototypes                 
     
    *      Origin Date10/30/97                                              
     
    *           Author:                                                       
     *        
    Revisions:                                                       
     *                                                                         
     **************************************************************************
                                                                               
     * 
    Prototype for CrtUsrSpc procedure  (Create User Space)                  
    D CrtUsrSpc       PR             1A                                        
    D  UsrSpcName                   20A   VALUE                                
    D  UsrSpcExtA                   10A   VALUE                                
    D  UsrSpcText                   50A   VALUE                                
                                                                               
     
    Prototype for GetUsrSpcP procedure (Get User Space Pointer)             
    D GetUsrSpcP      PR              *                                        
    D  UsrSpcName                   20A   VALUE                                   
                                                                                  
     
    Prototype for GetNumEnt procedure (Get Number of Entries in the User Space)
    D GetNumEnt       PR             9B 0                                         
    D  UsrSpcName                   20A   VALUE                                   
                                                                                  
     
    Prototype for GetSpcEnt procedure (Get Specific Entry in the User Space)   
    D GetSpcEnt       PR         32767A                                           
    D  UsrSpcName                   20A   VALUE                                   
    D  EntNumber                     9B 0 VALUE                                   
                                                                                  
     
    Prototype for DltUsrSpc procedure  (Delete User Space)                     
    D DltUsrSpc       PR             1A                                           
    D  UsrSpcName                   20A   VALUE                                   
                                                                                  
                                                                                  
     
    /DEFINE FUSPCP                                                               
     
    /ENDIF 
    und hier kannst du noch die Quelle für die User-Space-API sehen
    http://newsolutions.de/forum-systemi...plf-in-outfile
    Last edited by malzusrex; 15-08-14 at 08:52. Grund: Verweis auf Userspace Module eingefügt

  3. #3
    Registriert seit
    Jan 2007
    Beiträge
    904
    Besten Dank Ronald,

    nur dieses API treibt mich zum Wahnsinn. Angelehnt an dein Beispiel hab ich das implementiert. Mein Problem nun ist, dass der Aufruf des API's mir genau eine Bibliothek zurück gibt, der Rest ist Schrott.

    Nun das Kuriose:
    Rufe ich den QUSCRTUS und den QZLSLSTI manuell oder im CL aus der Befehlszeile auf, erhalte ich alle meine Shares. Erfolgt jedoch der Aufruf aus dem RPG (API Direktaufruf oder via CL, egal) bekomme ich wiederum nur den einen Share. Siehe untenstehendes CL...

    PGMPARM(&USRSPACE)
    DCLVAR(&USRSPACE)TYPE(*CHAR)LEN(20)
    /* Create User Space */
    CALLPGM(QUSCRTUS)PARM('@USRSPACE QTEMP ' PF 2048 X'00'*ALL'API output space')
    /* CALL QZLSLSTI API - Option ZLSL0100 */
    CALLPGM(QZLSLSTI)PARM('@USRSPACE QTEMP ' ZLSL0100 *ALL X'00000000')
    ENDPGM
    kf

  4. #4
    Registriert seit
    May 2002
    Beiträge
    1.121
    Hmm,
    das Programm ist bei mir noch genau so im Einsatz.

    Gruß
    Ronald

  5. #5
    Registriert seit
    Feb 2001
    Beiträge
    20.207
    Der Unterschied liegt in den Aufrufarten:

    Bei RPG/LE musst du Variablen und/oder Prototypen für die Aufrufparameter definieren, dann gibt's kein Problem mit dem Aufruf

    Bei CLP kannst du beim CALL auch Konstanten verwenden, da es aber keinen Prototyp gibt, werden die Parameter mit Sicherheit falsch an die API's übergeben (2048 z.B. als DEC(15, 5) und nicht als BIN(4)). Ggf. führt dies zu CPF-Fehlern oder eben zu Schrott.
    Also definiere im CLP genau die Variablen für die API's, ins besonders wenn BIN(4) gefordert ist.
    Oder verwende gleich obige RPG-Quelle, dann gibt's das Problem gar nicht.
    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
    Jan 2007
    Beiträge
    904
    Hallo Baldur,

    Würd ich ja gerne. Wie du siehst sind im CLP alle Parameter als Konstanten für für den Call definiert, sprich es wird kein Parameter übergeben. Trotzdem - egal wie ich das mache - sei es als Prototyp oder gewöhnlicher "C"-Call, ich erhalte verschiedene Resultate wenn ich das CLP aus dem RPGLE oder aus der Befehlszeile aufrufe. Ich forsche weiter - aber nicht mehr lange.
    OS: (V7R1)
    kf

  7. #7
    Registriert seit
    Feb 2001
    Beiträge
    20.207
    Nochmal!
    Ändere dein CLP, in dem du alle Parameter laut API-Beschreibung als Variablen übergibst.
    Du kannst die Variablen ja in der DCL-Anweisung auch initialisieren.

    Da die API's bestimmte Parameter erwarten, greifen sie ggf. auf Speicherstellen zu, die eben unterschiedlich initialisiert sind je nach dem ob du dein CLP aus der Kommandozeile oder aus RPG aufrufst.
    Bei Konstanten im CL-CALL hast du eben keine Garantie, dass diese korrekt sind!
    - Zahlen immer als 15p 5
    - Zeichen in der angegebenen Länge, mindestens jedoch 32
    Erwartet das API also 50 Zeichen musst du auch 50 Zeichen übergeben!
    Wird BIN(4) erwartet, so musst du eben eine BIN(4)-Variable definieren (vor V6 als CHAR mit %BIN-Init, ab V6 als *INT 4).

    Solange du also die API's nicht korrekt aufrufst kannst du auch keine korrekten Ergebnisse erwarten.
    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

  8. #8
    Registriert seit
    Jan 2007
    Beiträge
    904
    Was so ein falsch gesetzter Pointer alles bewirken kann...

    Nun, es funktioniert - herzlichen Dank an Ronald und Baldur.

    Für diejenigen die eine "all in one" Lösung für das QZLSLSTI API brauchen, habe ich dieses in Free RPG angefügt. Input = Pfad, Rückgabe = Share Name.

    PHP-Code:
            ctl-opt DftActGrp(*noOption(*NoDebugIO : *NoExpDDS : *SrcStmt);
     
          
    // Retrieve NetServer share informations
          // API: QZLSLSTI - ZLSL0100
          // ------------------------------------------------------------------------
     
              
    dcl-pi *n;
                
    inPath          char(50options(*varsize) const;
                
    outShare        char(12);
              
    end-pi;
     
          
    // PROTOTYPES
          // ------------------------------------------------------------------------
     
          // Prototype for CrtUsrSpc procedure  (Create User Space)
           
    dcl-pr CrtUsrSpc extpgm('QUSCRTUS');
             *
    n                 like(SpaceName) const;                      // Name
             
    *n                 like(SpaceExtA) const;                      // Attribute
             
    *n                 like(SpaceSize) const;                      // Initial size
             
    *n                 like(SpaceInit) const;                      // Initial value
             
    *n                 like(SpaceAut)  const;                      // Authority
             
    *n                 like(SpaceText) const;                      // Text
             
    *n                 like(SpaceRepl) const options(*nopass);     // Replace existing
             
    *n                 like(DS_Error)  options(*nopass);           // Error feedback
             
    *n                 like(SpaceDom)  options(*nopass);           // Error feedback
           
    end-pr;
     
          
    // Prototype for GetUsrSpcP procedure (Get User Space Pointer)
           
    dcl-pr GetUsrSpc extpgm('QUSPTRUS');
             *
    n                 char(20) const;
             *
    n                 pointer ;
             *
    n                 like(QUSEC)options(*nopass);
           
    end-pr;
     
          
    // Prototype for GetUsrSpcP procedure (Get User Space Pointer)
           
    dcl-pr GetUsrSpcP pointer;
             *
    n                 char(20) const;
           
    end-pr;
     
          
    // Prototype for GetNumEnt procedure (Get Number of Entries in the User Space)
           
    dcl-pr GetNumEnt bindec(9);
             *
    n         char(20) const;
           
    end-pr;
     
          
    // Prototype for GetSpcEnt procedure (Get Specific Entry in the User Space)
           
    dcl-pr GetSpcEnt char(32767);
             *
    n         char(20) const;
             *
    n         bindec(9value;
           
    end-pr;
     
          
    // Prototype for DltUsrSpc procedure  (Delete User Space)
           
    dcl-pr DltUsrSpc extpgm('QUSDLTUS');
             *
    n         char(20) const;
             *
    n         char(32767options(*varsize);                      // Error feedback
           
    end-pr;
     
          
    // Prototype API QZLSLSTI
           
    dcl-pr QZLSLSTI extpgm ;
             *
    n         like(SpaceName) const;
             *
    n         like(LstFormat) const;
             *
    n         like(InfoQ) const;
             *
    n         like(I_O_Err) const;
           
    end-pr ;
     
          
    // Prototype for StringConvert procedure  (Convert String upper/lower)
           
    dcl-pr StringConvert varchar(65535);
             *
    n         varchar(65535) const;
             *
    n         bindec(9value;                                    // Modus 0=up/1=low
           
    end-pr;
     
          
    // DECLARATIONS
          // ------------------------------------------------------------------------
           
    /copy qsysinc/qrpglesrc,qusec
           
    /copy qsysinc/qrpglesrc,qusgen
     
           dcl
    -s Error          char(32767);                                // Error feedback
           
    dcl-s NbrEntries     int(10);
           
    dcl-s Count          int(10);
           
    dcl-s iPath          varchar(65535);
           
    dcl-s uPath          varchar(65535);
           
    dcl-s Pos            int(5);
     
          
    // API User-Space Fields
           
    dcl-s SpaceName      char(20)   inz('@USRSPACE QTEMP     ');     // User Space
           
    dcl-s SpaceExtA      char(10)   inz('SHARE');                    // User Space Prod
           
    dcl-s SpaceSize      bindec(9)  inz(2048);                       // Initial Value
           
    dcl-s SpaceInit      char(1)    inz(x'00');                      // Space Init
           
    dcl-s SpaceAut       char(10)   inz('*ALL');                     // API Format
           
    dcl-s SpaceText      char(50)   inz('Check Shares IFS');         // User Space IFS
           
    dcl-s SpaceRepl      char(10)   inz('*YES');                     // Replace Space
           
    dcl-s SpaceDom       char(10)   inz('*USER');                    // Domain
     
          // API ZLSLSTI Fields
           
    dcl-s LstFormat      char(8)    inz('ZLSL0100');                 // API Format
           
    dcl-s InfoQ          char(15)   inz('*ALL');                     // API Format
           
    dcl-s I_O_Err        pointer;
     
          
    // API ErrorStructure
           
    dcl-ds DS_Error;
              
    Bytpv             bindec(4)  Pos(1)  inz(100);
              
    Bytav             bindec(4)  Pos(5)  inz(0);
              
    MsgId             char(7)    Pos(9);
              
    Resvd             char(1)    Pos(16);
              
    Exdta             char(240)  Pos(17);
              
    Exdta52           char(51)   overlay(Exdta);
           
    end-ds;
     
          
    // API DataStructure
           
    dcl-ds Share;
              
    Length            bindec(4)  Pos(1);
              
    ShareName         char(12)   Pos(5);
              
    DevType           bindec(4)  Pos(17);
              
    Permiss           bindec(4)  Pos(21);
              
    MaxUsr            bindec(4)  Pos(25);
              
    CurUsr            bindec(4)  Pos(29);
              
    SplFType          bindec(4)  Pos(33);
              
    OfsOfPathNam      bindec(4)  Pos(37);
              
    LenOfPathNam      bindec(4)  Pos(41);
              
    QuaOutQ           char(20)   Pos(45);
              
    PrtDrvTyp         char(50)   Pos(65);
              
    Text              char(50)   Pos(115);
              
    PathName          char(1024Pos(165);
           
    end-ds;
     
          
    // PROCESSING
          // ------------------------------------------------------------------------
     
          // upper cases for inPath
            
    iPath StringConvert(inPath 0);                              // convert inPath upper
     
          // Create User-Space
            
    SpaceName SpaceName;
            
    SpaceExtA SpaceExtA;
            
    CrtUsrSpc (SpaceName SpaceExtA SpaceSize SpaceInit SpaceAut
                       
    SpaceText SpaceRepl DS_Error  SpaceDom);
     
          
    // Retrieve Net-Shares ZLSL0100
            
    QZLSLSTI   (SpaceName LstFormat InfoQ I_O_Err);
            
    NbrEntries GetNumEnt(SpaceName);
     
          
    // Transfer SpaceName to API structure ZLSL0100
            
    For Count 1 to NbrEntries;
              
    Share  =  GetSpcEnt(SpaceName Count);
              
    // Get Share Name
              
    clear uPath;
              
    uPath StringConvert(PathName 0);
              
    Pos = %scan(iPath uPath);
              if 
    Pos 0;
                
    outShare ShareName;
              endif;
            EndFor;
     
          
    // Delete SpaceName
            
    DltUsrSpc(SpaceName:Error);
            *
    InLr = *On;
     
     
          
    // internal PROCEDURES
          // ------------------------------------------------------------------------
     
          // Procedure Name:  GetNumEnt
          // --------------------------
            
    dcl-proc GetNumEnt export;
              
    dcl-pi *n bindec(9:0);
                
    UsrSpcName            like(SpaceName) const;
              
    end-pi;
     
          
    // Local Variables
              
    dcl-s UsrSpcPntr        pointer;
              
    dcl-s Bigfield          char(32767based(UsrSpcPntr);
     
          
    // Get the pointer for the user space
              
    GetUsrSpc(UsrSpcName UsrSpcPntr);              // Move the based on pointer to
              
    QUSH0100 BigField;                             // Return number of list entries
     
              
    return QUSNBRLE;
            
    end-proc;
     
     
          
    // Procedure Name:  GetUsrSpcP
          // ---------------------------
            
    dcl-proc GetUsrSpcP export;
              
    dcl-pi *n pointer;
                
    UsrSpcName            like(SpaceName) const;
              
    end-pi;
     
          
    // Local Variables
              
    dcl-s SpacePoint        pointer;
     
          
    // Set error code structure to use basic feedback
              
    QUSBPRV 16;
     
          
    // Get the pointer for the user space
              
    GetUsrSpc(UsrSpcName SpacePoint QUSEC);      // Move the based on pointer to
     
              
    return SpacePoint;
            
    end-proc;
     
     
          
    // Procedure Name:  GetSpcEnt
          // --------------------------
            
    dcl-proc GetSpcEnt export;
              
    dcl-pi *n               char(32767);
                
    UsrSpcName            like(SpaceName) const;
                
    EntNumber             bindec(9:0value;
              
    end-pi;
     
          
    // Local Variables
              
    dcl-s UsrSpcPntr        pointer;
              
    dcl-s ListPntr          pointer;
              
    dcl-s Bigfield          char(32767based(ListPntr);
              
    dcl-s BigfldOut         char(32767);
     
              
    UsrSpcPntr GetUsrSpcP(UsrSpcName);  // Get the pointer for the user space
              
    ListPntr UsrSpcPntr;                             // Move the based on pointer to get header information
              
    QUSH0100 BigField;                             // Return number of list entries
     
          // Check to see if  entry requested is <= user space number entries
          // If not, return a blank field
               
    if EntNumber QUSNBRLE;
                 
    BigFldOut = *BLANKS;
                 return 
    BigFldOut;
               endif;
     
          
    // Return specific list entry
               
    EntNumber -= 1;
               
    ListPntr ListPntr QUSOLD + (QUSSEE EntNumber);
               
    BigFldOut = %SUBST(BigField:1:QUSSEE);
               return 
    BigFldOut;
            
    end-proc;
     
     
          
    // Procedure Name:  StringConvert
          // ------------------------------
            
    dcl-proc StringConvert export;
              
    dcl-pi *n               varchar(65535);
                
    InputData             varchar(65535) const;
                
    Modus                 bindec(9value;         // 0=upper, 1=lower
              
    end-pi;
     
              
    dcl-pr ConvertCase extproc('QlgConvertCase');          // Convert upper case
                
    *n                    like(QLGIDRCB00);              // request
                
    *n                    char(65535) const options(*varsize);    // input
                
    *n                    char(1options(*varsize);     // output
                
    *n                    int(10) const;                 // data length
                
    *n                    like(QUSEC)options(*nopass);   // error ds
              
    end-pr ;
     
           
    // Declarations
           
    /copy qsysinc/qrpglesrc,qlg
              dcl
    -s OutputData        char(1024);
     
              
    QUSBPRV 0;                                     // use exceptions for errors
              
    QLGIDRCB00 = *loval;                             // set input structure to x'00'
              
    QLGTOR02 1;                                    // use CCSID for monocasing
              
    QLGIDOID00 0;                                  // use the job CCSID
              
    QLGCR00 Modus;                                 // convert to upper/lower case
     
              
    clear OutputData;
              
    ConvertCaseQLGIDRCB00 :InputData :OutputData
                         
    :%len(%trimr(InputData)) :QUSEC);
              return %
    trimr(OutputData);
            
    end-proc
    Achtung OS: V7R1 - TR7!
    kf

  9. #9
    Registriert seit
    Nov 2003
    Beiträge
    2.304
    Probier mal mit X'00000800' (4stellig hexadezimal) anstelle von 2048 (dezimal) im CLP.

  10. #10
    Registriert seit
    Jan 2007
    Beiträge
    904
    Zitat Zitat von Pikachu Beitrag anzeigen
    Probier mal mit X'00000800' (4stellig hexadezimal) anstelle von 2048 (dezimal) im CLP.
    Hi,

    Das CLP ist kein Problem, wie auch der API-Aufruf nicht. Ich hab mir bloss mit einem falsch gesetzten Pointer im RPGLE den User Space zerschossen. Jetzt ist alles gut, das CLP brauch ich nicht mehr.
    kf

Similar Threads

  1. SQL Wochende ermitteln
    By Miles in forum IBM i Hauptforum
    Antworten: 4
    Letzter Beitrag: 15-07-14, 07:21
  2. Kalenderwoche ermitteln
    By tarkusch in forum NEWSboard Programmierung
    Antworten: 5
    Letzter Beitrag: 18-06-14, 12:07
  3. Zeitdauer ermitteln in RPG
    By sepp in forum IBM i Hauptforum
    Antworten: 2
    Letzter Beitrag: 09-07-02, 17:09
  4. Größe des IFS, wie ermitteln?
    By Spirou in forum IBM i Hauptforum
    Antworten: 6
    Letzter Beitrag: 17-04-02, 10:54
  5. Satzlänge in CL ermitteln
    By kschmidt in forum IBM i Hauptforum
    Antworten: 5
    Letzter Beitrag: 19-06-01, 18:35

Berechtigungen

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