-
 Zitat von rischer
... allerdings braucht ein DSPOBJD in ein Outfile über eine grosse Bibliothek ewig lange.
Aber nur beim ersten Mal nach langer Zeit ...
-
Ich denke API ist schneller wie DSPOBJD.
QUSLOBJ müsste es glaube sein.
Gruß
Ronald
-
Wenn ich mich nicht irre, dann hatte ich das mal mit foglenden Programm umgesetzt..
DDS
PHP-Code:
* SatzFormat
R GROBJDP1
* Felder
OBJNAME 10 TEXT('Objekt Name ')
OBJLIB 10 TEXT('Objekt Lib ')
OBJTYPE 10 TEXT('Objekt Type ')
OBJTYPE1 10 TEXT('Objekt Type erweitert ')
OBJTEXT 50 TEXT('Beschreibung ')
OBJEIGNER 10 TEXT('ObjektEigner ')
OBJDOMAIN 2 TEXT('*U = User *S = System ')
CRTDATE 8S 0 TEXT('Erstellt Datum ')
CRTTIME 6S 0 TEXT('Erstellt Zeit ')
CHGDATE 8S 0 TEXT('Geändert Datum ')
CHGTIME 6S 0 TEXT('Geändert Zeit ')
SRCFILE 10 TEXT('Source File ')
SRCLIB 10 TEXT('Source Lib ')
SRCMBR 10 TEXT('Source Menber ')
SRCUPDT 13 TEXT('Source File Update ')
CRTUSER 10 TEXT('Erstellt von ')
CRTSYSTEM 8 TEXT('Erstellt System ')
SYSLEVEL 9 TEXT('System Version ')
USEDATE 8S 0 TEXT('Last Use Datum ')
USETIME 6S 0 TEXT('Last Use Time ')
USEDAYS 6S 0 TEXT('Days used ')
CURRCD 10S 0 TEXT('Anzahl Sätze ')
DELRCD 10S 0 TEXT('Gelöschte Sätze ')
FILESIZE 10S 0 TEXT('File Größe ')
RPG
PHP-Code:
* ************************************************************************
* Programm erstellen mit:
* CRTRPGMOD MODULE(MyLib/DSPOBJLST) SRCFILE(MyLib/QRPGLESRC)
* CRTPGM PGM(MyLib/DSPOBJLST) BNDSRVPGM(MyLib/#USRSPAPI)
* ************************************************************************
h bnddir('QC2LE')
fgrobjdp uf a e disk
D* UserSpace für Obj-Info's
D UserOK S 1A
D UserSpace S 20A INZ('QUSLOBJ QTEMP ')
D UsrSpcExtA S 10A INZ('PROD')
D UsrSpcText S 50A INZ('Objekt Infos ')
D LstFormat S 8A INZ('OBJL0700')
D Obj_Lib s 20A
D ObjType s 10A Inz('*ALL')
D I_O_Err s *
D
D* UserSpace für ILLE-Info's
D UserOK1 S 1A
D UserSpace1 S 20A INZ('QBNLPGMI QTEMP ')
D UsrSpcExtA1 S 10A INZ('PROD')
D UsrSpcText1 S 50A INZ('ILLE Infos')
D LstFormat1 S 8A INZ('PGML0100')
D
D* Für File-Infos
D Mbrd0200_Size S 4b 0
D LstFormat2 S 8A INZ('MBRD0200')
d Obj_Lib2 s 20a
D MbrName S 10A inz('*FIRST ')
D OvrProc S 1A inz('0')
D NbrEntries s 10U 0
D Count s 10U 0
D
D InputFormat s 10a Inz('*DTS' )
D OutPutFormat s 10a Inz('*YYMD' )
d Obj_Lib1 s 20a
d Bibliothek s 10a
D MBRD0200 ds
D CurRecNbr 141 144B 0
D DelRecNbr 145 148B 0
D DataSize 149 152B 0
d nix 261 266
D
D PGML0100 ds
d xSourceFile 41 50
d xSourceLib 51 60
d xSourceMember 61 70
d xSourceFileUp 94 106
d
D OBJL0700 ds
D ObjektName 1 10
D ObjektLib 11 20
D ObjektType 21 30
D ObjektTyp1 32 41
D ObjektText 42 91
D ObjektEigner 113 122
D ObjektDomain 123 124
D Erstellt 125 132
d Geaendert 133 140
d SourceFile 173 182
d SourceLib 183 192
d SourceMember 193 202
d SourceFileUp 203 215
d CreateUser 216 225
d CreateSystem 226 233
d SystemLevel 234 242
d LastUse 533 540
d UsedDays 549 552b 0
d
* Prototype Lists
D/COPY QRPGLESRC,FUSPCP
D System pr 10i 0 extproc('system')
D * value options(*string)
D
D Get_Date pr 8s 0
D 8 Time-Stamp
D Get_Time pr 6s 0
D 8 Time-Stamp
c Eval UserOK = CrtUsrSpc(UserSpace :
c UsrSpcExtA :
c UsrSpcText )
c Eval UserOK1 = CrtUsrSpc(UserSpace1 :
c UsrSpcExtA1 :
c UsrSpcText1 )
c
c Eval Obj_Lib = '*ALL ' +
c Bibliothek
c Call 'QUSLOBJ'
c Parm UserSpace
c Parm LstFormat
c Parm Obj_Lib
c Parm ObjType
c Parm I_O_Err
c
c
c Eval NbrEntries = GetNumEnt(UserSpace)
c
c For Count = 1 to NbrEntries
c Eval OBJL0700 = GetSpcEnt(UserSpace : Count)
c
c If ObjektType = '*PGM' and
c (ObjektTyp1 = 'RPGLE' or
c ObjektTyp1 = 'CLLE' or
c ObjektTyp1 = 'CLE')
c ExSr Get_ILLE_Src
c EndIf
c ExSr Ausgabe
c EndFor
c
c Eval UserOK = DltUsrSpc(UserSpace)
c Eval UserOK1 = DltUsrSpc(UserSpace1)
c
c Eval *InLr = *On
c Get_File_Info BegSr
c*
c Eval Mbrd0200_Size = %Size( MBRD0200 )
c Eval Obj_Lib2 = ObjektName + ObjektLib
c Call (e) 'QUSRMBRD'
c Parm MBRD0200
c Parm Mbrd0200_Size
c Parm LstFormat2
c Parm Obj_Lib2
c Parm MbrName
c Parm OvrProc
c Parm I_O_Err
c
c If not %Error
c Eval CurRcd = CurRecNbr
c Eval DelRcd = DelRecNbr
c Eval FileSize = DataSize
c EndIf
c*
c EndSr
c Get_ILLE_Src BegSr
c*
c Eval Obj_Lib1 = ObjektName + ObjektLib
c Call (e) 'QBNLPGMI'
c Parm UserSpace1
c Parm LstFormat1
c Parm Obj_Lib1
c Parm I_O_Err
c
c If not %Error
c Eval PGML0100 = GetSpcEnt(UserSpace1 : 1)
c Eval SourceFile = xSourceFile
c Eval SourceLib = xSourceLib
c Eval SourceMember = xSourceMember
c Eval SourceFileUp = xSourceFileUp
c EndIf
c*
c EndSr
c Ausgabe BegSr
c*
c Clear grobjdp1
c
c Eval objname = ObjektName
c Eval objlib = ObjektLib
c Eval objtype = ObjektType
c Eval objtype1 = ObjektTyp1
c Eval objtext = ObjektText
c Eval objeigner = ObjektEigner
c Eval objdomain = ObjektDomain
c Eval crtdate = Get_Date(Erstellt )
c Eval crttime = Get_Time(Erstellt )
c Eval chgdate = Get_Date(Geaendert)
c Eval chgtime = Get_Time(Geaendert)
c Eval srcfile = SourceFile
c Eval srclib = SourceLib
c Eval srcmbr = SourceMember
c Eval srcupdt = SourceFileUp
c Eval crtuser = CreateUser
c Eval crtsystem = CreateSystem
c Eval syslevel = SystemLevel
c If UsedDays > 0
c Eval usedate = Get_Date(LastUse )
c Eval usetime = Get_Time(LastUse )
c EndIf
c Eval usedays = UsedDays
c If ObjektType = '*FILE' and
c (ObjektTyp1 = 'PF' or
c ObjektTyp1 = 'LF')
c ExSr Get_File_Info
c EndIf
c
c Write grobjdp1
c*
c EndSr
c *InzSr BegSr
c*
c *Entry Plist
c Parm Bibliothek
c*
c EndSr
P Get_Date b
d pi 8s 0
d Input_Time_S 8
d
d ds
d Datum_Zeit 17a
d Datum 1 8s 0
d Uhr 9 14s 0
C Call (e) 'QWCCVTDT'
C Parm InputFormat
C Parm Input_Time_S
C Parm OutputFormat
c Parm Datum_Zeit
c Parm I_O_Err
c
c If not %Error
c Return Datum
c Else
c Return 0
c EndIf
c
p Get_Date e
P Get_Time b
d pi 6s 0
d Input_Time_S 8
d
d ds
d Datum_Zeit 17a
d Datum 1 8s 0
d Uhr 9 14s 0
C Call (e) 'QWCCVTDT'
C Parm InputFormat
C Parm Input_Time_S
C Parm OutputFormat
c Parm Datum_Zeit
c Parm I_O_Err
c
c If not %Error
c Return Uhr
c Else
c Return 0
c EndIf
c
p Get_Time e
CMD
PHP-Code:
cmd 'Sammeln Objekt-Informationen'
parm bibi +
type(*name) +
dft(*USRLIBL) +
spcval((*ALLUSR) (*USRLIBL) (*LIBL)) +
min(0) +
max(3) +
prompt('Bibliothek')
Programm dürfe so ca. 10-12 Jahr alt sein.
Einfachmal testen und anpassen.
Gruß
Ronald
Nachrag:
#USRSPAPI
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 QRPGLESRC,FUSPCp
* Generic Error Structure
D/COPY dipsrvpgm/QRPGLESRC,QUSEC
* User Space Generic Structure
D/COPY dipsrvpgm/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
-
Was glaubst du wohl, wie DSPOBJD an seine Daten kommt?
Das API von dir verwendet dürfte da nicht so viel schneller sein.
Die Alternative wäre eher, die CRT-Befehle für Public/PGMR zu sperren und z.B. D*B's Compiler-Aufrufe unter Owner laufen zu lassen.
a) flexiblere Erstellmöglichkeiten
b) Anpassbar bzgl. Logging-Funktionen
c) APP-User-Integration durch Ersteller quasi automatisch
Ggf. kann man ähnliches auch vom RDi aus verwenden.
Similar Threads
-
By MGJ79 in forum NEWSboard Programmierung
Antworten: 11
Letzter Beitrag: 12-11-14, 12:26
-
By malzusrex in forum IBM i Hauptforum
Antworten: 1
Letzter Beitrag: 23-04-03, 18:15
-
By Gimli in forum IBM i Hauptforum
Antworten: 3
Letzter Beitrag: 04-04-03, 13:15
-
By sho1 in forum IBM i Hauptforum
Antworten: 2
Letzter Beitrag: 31-01-02, 16:08
-
By Markus in forum IBM i Hauptforum
Antworten: 3
Letzter Beitrag: 31-01-01, 14:51
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]
[professional_User]
Mit Zitat antworten
Bookmarks