IFS Share Name ermitteln

[camouflage]

Hallo,

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

Danke für den Input.

[malzusrex]

Schaue mal bei den NetServer-APIs.

http://www-01.ibm.com/support/knowledgecenter/ssw_i5_54/rzahl/rzahlapiguide.htm?lang=en

Gruß
Ronald

Habe da noch eine alte Quelle gefunden



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 + 7 'Maximale Anzahl User'
o + 4 'Aktuelle User'
o + 4 'Beschreibung'
o e Zeile 1
o Name
o Path + 1
o Zugriff + 1
o AnzMaxU + 4
o AnzCurU + 14
o Text + 7




/IF NOT DEFINED(FUSPCP)
************************************************** ************************
*
* Program Name: FunctUSPcp
* Program Title: Copy Member for User Space Prototypes
* Origin Date: 10/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-as400-i5-iseries/threads/18141-wrksplf-in-outfile

[camouflage]

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

[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.