IFS Share Name ermitteln

[malzusrex]

Hmm,
das Programm ist bei mir noch genau so im Einsatz.

Gruß
Ronald

[Fuerchau]

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.

[camouflage]

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)

[Fuerchau]

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.

[camouflage]

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.

        ctl-opt DftActGrp(*no) Option(*NoDebugIO : *NoExpDDS : *SrcStmt);
 
      // Retrieve NetServer share informations
      // API: QZLSLSTI - ZLSL0100
      // ------------------------------------------------------------------------
 
          dcl-pi *n;
            inPath          char(50) options(*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(9) value;
       end-pr;
 
      // Prototype for DltUsrSpc procedure  (Delete User Space)
       dcl-pr DltUsrSpc extpgm('QUSDLTUS');
         *n         char(20) const;
         *n         char(32767) options(*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(9) value;                                    // 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(1024) Pos(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(32767) based(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:0) value;
          end-pi;
 
      // Local Variables
          dcl-s UsrSpcPntr        pointer;
          dcl-s ListPntr          pointer;
          dcl-s Bigfield          char(32767) based(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(9) value;         // 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(1) options(*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;
          ConvertCase( QLGIDRCB00 :InputData :OutputData
                     :%len(%trimr(InputData)) :QUSEC);
          return %trimr(OutputData);
        end-proc; 

Achtung OS: V7R1 - TR7!

[Pikachu]

Probier mal mit X'00000800' (4stellig hexadezimal) anstelle von 2048 (dezimal) im CLP.

[camouflage]

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.