Liste der IFS-Freigaben via RPG

[wolfgang.w]

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.

[malzusrex]

Da gibt es ein API dafür


************************************************** ***********************
*Programm erstellen mit:
* CRTRPGMOD MODULE(mylib/DSPshare) SRCFILE(mylib/QRPGLESRC)
* CRTPGM PGM(mylib/dspshare) BNDSRVPGM(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 + 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




*ˆ************************************************ ************************
*Service - PGM erstellen mit:
* CRTRPGMOD MODULE(mylib/#USRSPAPI) SRCFILE(mylib/QRPGLESRC)
* CRTSRVPGM SRVPGM(mylib/#USRSPAPI) EXPORT(*ALL)
************************************************** ***********************
*
************************************************** ************************
*
* Program Name: FunctUsp
* Program Title: User 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

[wolfgang.w]

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!

[malzusrex]

Vor ein "paar" Tagen hatten wir das schon mal..
http://www.newsolutions.de/forum-systemi-as400-i5-iseries/threads/19249-IFS-Share-Name-ermitteln?highlight=QZLSLSTI

[Fuerchau]

Hier hat Birgitta mal die Links auf SQL-Routinen reingestellt:
http://newsolutions.de/forum-systemi-as400-i5-iseries/threads/22023-QSYS2-Dateien?highlight=qsys2

https://www.ibm.com/support/knowledgecenter/ssw_ibm_i_74/rzajq/rzajqservicesdb2.htm
https://www.ibm.com/support/knowledgecenter/ssw_ibm_i_74/rzajq/rzajqservicessys.htm

Vielleicht ist da ja was dabei;-).

[wolfgang.w]

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.

[Fuerchau]

Es hindert dich ja keiner, mit obigen API's und Birgittas Hinweisen zu "TableFunction" eine eigene SQL-Funktion zu stricken:

select * from table ( mytableshares() )