-
QUERY und LVLCHK
 Zitat von Fuerchau
Nun jein.
Es gab da mal ein MI-Programm zum Auslesen der verwendeten Dateien.
Da die interne Query-Struktur nicht dokumentiert ist, kann man sicherlich mal mit DMPSYSOBJ ein QRYDFN analysieren.
Irgendwo stehen die Formatebenen-ID's rum, die dann nur ersetzt werden müssen.
Allerdings: siehe LVLCHK
Für den Update *QRYDFN füge ich ein RPG-PGM an. Das Thema gabs schon mal. Die genannten Einschräkungen für den Austausch der FormatLevel-ID müssen beachtet werden.
M.Steibert
PHP-Code:
h datfmt(*ISO)
* to compile
*
D*B CRTSQLRPGI UPDQRYF
D*B+ COMMIT(*NONE)
D*B+ OBJTYPE(*MODULE)
D*B+ DATFMT(*ISO)
D*B+ DBGVIEW(*SOURCE)
D*B CRTPGM UPDQRYF
D*B+ BNDDIR(QC2LE)
D*B+ ACTGRP(UPDQRYF)
*--- Prototypes Export ----------------------------------------
D UPDQRYF PR EXTPGM('UPDQRYF')
d QueryName 10A const
d QueryLib 10A const
*-------------------------------------------------------------------
* Resolve System Pointer
D rslvsp Pr * ProcPtr ExtProc( 'rslvsp' )
D ObjTyp 2a Value
D ObjNam * Value Options( *String )
D ObjLib * Value Options( *String )
D AutReq 2a Value
*-------------------------------------------------------------------
* set Space Pointer from Systempointer
D setsppfp Pr * ExtProc( 'setsppfp' )
D Object * Value ProcPtr
*
*-------------------------------------------------------------------
* set Spacepointer offset
D setsppo Pr * ExtProc( 'setsppo' )
D SpcPtr * Value
D Offset 10i 0 Value
*-------------------------------------------------------------------
* copy memory from address to address
D MemCpy Pr * ExtProc( 'memcpy' )
D pOutMem * Value
D pInpMem * Value
D iMemSiz 10u 0 Value
*-------------------------------------------------------------------
* Send program message
D SendSysMsg PR EXTPGM('QMHSNDPM')
D Message_ID 7A CONST
D Message_File 20A CONST
D Message_Data 512 CONST
D Length 10I 0 CONST
D Message_Type 10A CONST
D Message_Q 10A CONST
D Pgm_Stack 10I 0 CONST
D Message_Key LIKE(QMHSNDPM_MSGKEY)
D* Message Error
D Msg_Error LIKE(QMHSNDPM_MSGERR)
**
dGetFileDescription...
d pr extpgm('QDBRTVFD')
d Receiver 1 options(*varsize)
d LenReceiver 10i 0 const
d QualFileName 20
d Format 8 const
d QualFileName 20 const
d RcdFmtName 10 const
d OvrPrc 1 const
d System 10 const
d FmtType 10 const
d ApiError likeds(ApiError)
**
D ApiError DS qualified
D BytesProvided 10i 0 Inz( %Size( ApiError ))
D BytesAvailable 10i 0 Inz
D MsgID 7a
D 1a
D MsgData 256a
*
DQMHSNDPM_MSGKEY s 4A
DQMHSNDPM_MSGERR DS
D PROVID 1 4B 0
D AVAIL 5 8B 0
D RTNMSG 9 15
D RSVR 16 16
D RTNDTA 17 256
* extract from
* /COPY QSYSINC/QRPGLESRC,QDBRTVFD
DQDBQ41 DS 256
* Header information
D QDBDFSEQ 81 93
* Level Identifier
*--- Prototypes Import ----------------------------------
*--- local Prototypes ----------------------------------
d posObjectspace pr
d get1stFormatID pr 13a
d infile 10a value
d inlib 10a value
d switchFormatID pr
d logout pr
*--- Constants and Types ----------------------------------
d TRUE c *ON
d FALSE c *OFF
*
d UPDQRYF PI
d QueryName 10A const
d QueryLib 10A const
*--- statefull Variables ----------------------------------
d curFormatID s 13A inz
d oldFormatID s 13A inz
**
**-- Query object (*qrydfn) program state
**
D pQryObject s * ProcPtr
D pQryTemplate s *
D QryTemplate s 32767a Based( pQryTemplate )
**
** object header
d objectType s 2a inz(x'1911')
**
** inputfile definition
**
D InpFilesHeader Ds inz qualified
D Totlen 10i 0
D 10i 0
D 10i 0
D 5i 0
D NbrFiles 5i 0
D InpFilesDetail Ds 80 inz qualified Dim( 32 )
D 5i 0 Overlay( InpFilesDetail: 1 )
D Name 10a Overlay( InpFilesDetail: 3 )
D 5i 0 Overlay( InpFilesDetail: 13 )
D Library 10a Overlay( InpFilesDetail: 15 )
D 5i 0 Overlay( InpFilesDetail: 25 )
D Member 10a Overlay( InpFilesDetail: 27 )
D 5i 0 Overlay( InpFilesDetail: 37 )
D Recordfmt 10a Overlay( InpFilesDetail: 39 )
D 5i 0 Overlay( InpFilesDetail: 49 )
D FileID 3a Overlay( InpFilesDetail: 51 )
D 5i 0 Overlay( InpFilesDetail: 55 )
D RecordID 13a Overlay( InpFilesDetail: 57 )
D 11a Overlay( InpFilesDetail: 70 )
*--- work Variables SQL ----------------------------------
d offset s 5i 0 inz
d posInputfiles s 5i 0 inz(46)
d offsetInputfiles...
d s 5i 0 inz
D i s 5i 0
/free
posObjectspace();
pQryTemplate = setsppo( pQryTemplate: posInputfiles );
MemCpy( %Addr( offsetInputfiles )
: pQryTemplate
: %Size( offsetInputfiles )
) ;
pQryTemplate = setsppo( pQryTemplate: offsetInputfiles );
MemCpy( %Addr( InpFilesHeader )
: pQryTemplate
: %Size( InpFilesHeader )
) ;
Offset = offsetInputfiles + %Size( InpFilesHeader ) ;
for i = 1 to InpFilesHeader.NbrFiles;
pQryTemplate = setsppo( pQryTemplate: Offset ) ;
MemCpy( %Addr( InpFilesDetail(i) )
: pQryTemplate
: %Size( InpFilesDetail )
) ;
switchFormatID();
offset = offset + %Size( InpFilesDetail );
endfor;
return;
/end-free
*-------------------------------------------------------------
P posObjectspace b
d posObjectspace pi
/free
pQryObject =
rslvsp( objectType
: %TrimR( QueryName )
: %TrimR( QueryLib )
: x'0000'
);
pQryTemplate = setsppfp( pQryObject );
return;
/end-free
P posObjectspace e
*-------------------------------------------------------------
p get1stFormatID b
d get1stFormatID pi 13a
d infile 10a value
d inlib 10a value
d FileLib ds
d File 10
d Lib 10
dOutfile s 20a inz
dFormatID s 13a inz
/free
Lib = inlib;
File = inFile;
ApiError.BytesProvided = 0;
monitor;
GetFileDescription(
QDBQ41
: %size(QDBQ41)
: Outfile
: 'FILD0200'
: FileLib
: '*FIRST'
: '0'
: '*LCL'
: '*EXT'
: ApiError
);
on-error;
return ' ';
endmon;
if ApiError.MsgID <> ' ';
Clear FormatID ;
else;
FormatID = QDBDFSEQ;
endif;
return FormatID ;
/end-free
p get1stFormatID e
*-------------------------------------------------------------
P switchFormatID b
d switchFormatID pi
/free
curFormatID
= get1stFormatID(
InpFilesDetail(i).Name
: InpFilesDetail(i).Library );
oldFormatID
= InpFilesDetail(i).RecordID;
if curFormatID <> *BLANK and curFormatID <> oldFormatID;
InpFilesDetail(i).RecordID = curFormatID;
MemCpy( pQryTemplate
: %Addr( InpFilesDetail(i) )
: %Size( InpFilesDetail )
) ;
logout();
endif;
return;
/end-free
P switchFormatID e
*-------------------------------------------------------------
P logout b
d logout pi
d message S 1024 inz
d Length s 10I 0 inz
/free
message = 'Recordlevel-ID changed from ' +
oldFormatID +
' to ' +
curFormatID +
' for file: ' +
%trim(InpFilesDetail(i).Library) + '/' +
%trim(InpFilesDetail(i).Name) +
' in QRYDFN: ' +
%trim(QueryLib) + '/' + %trim(QueryName)
;
Length = %len( %trim(message) );
SendSysMsg(
' '
: ' '
: message
: Length
: '*INFO '
: '*CTLBDY '
: 1
: QMHSNDPM_MSGKEY
: QMHSNDPM_MSGERR
);
return;
/end-free
P logout e
*-------------------------------------------------------------
Similar Threads
-
By Frank Ziegler in forum IBM i Hauptforum
Antworten: 14
Letzter Beitrag: 10-12-06, 10:21
-
By Kaufmann in forum IBM i Hauptforum
Antworten: 6
Letzter Beitrag: 29-11-06, 18:07
-
By Azubiiiiii in forum IBM i Hauptforum
Antworten: 6
Letzter Beitrag: 03-08-06, 09:44
-
By dino in forum IBM i Hauptforum
Antworten: 1
Letzter Beitrag: 09-05-06, 07:45
-
By Hubert Brethauer in forum IBM i Hauptforum
Antworten: 6
Letzter Beitrag: 05-05-06, 12:37
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)
[User]
Mit Zitat antworten
Bookmarks