-
Da gibt es ein API dafür
PHP-Code:
*************************************************************************
*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
PHP-Code:
*ˆ************************************************************************
*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
Similar Threads
-
By mott in forum IBM i Hauptforum
Antworten: 3
Letzter Beitrag: 22-05-17, 17:21
-
By Chris.jan in forum IBM i Hauptforum
Antworten: 3
Letzter Beitrag: 01-07-14, 11:04
-
By cs400_de in forum NEWSboard SAP
Antworten: 12
Letzter Beitrag: 18-04-07, 10:08
-
By Marlin in forum NEWSboard Windows
Antworten: 0
Letzter Beitrag: 04-03-03, 08:34
-
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
-
Foren-Regeln
|
Erweiterte Foren Suche
Google Foren Suche
Forum & Artikel
Update eMail
AS/400 / IBM i
Server Expert Gruppen
Unternehmens IT
|
Kategorien online Artikel
- Big Data, Analytics, BI, MIS
- Cloud, Social Media, Devices
- DMS, Archivierung, Druck
- ERP + Add-ons, Business Software
- Hochverfügbarkeit
- Human Resources, Personal
- IBM Announcements
- IT-Karikaturen
- Leitartikel
- Load`n`go
- Messen, Veranstaltungen
- NEWSolutions Dossiers
- Programmierung
- Security
- Software Development + Change Mgmt.
- Solutions & Provider
- Speicher – Storage
- Strategische Berichte
- Systemmanagement
- Tools, Hot-Tips
Auf dem Laufenden bleiben
|
![[NEWSboard IBMi Forum]](images/duke/nblogo.gif)
[professional_User]
Mit Zitat antworten
Bookmarks