vielen Dank für Eure Hilfe,
- leider bringt *PGMBDY nichts
- auch mit der Prozedur von Frank gab's kein Erfolg...
- muss man vielleicht was in der Aktivierungsgruppe einstellen (ACTGROUP *NEW ...) ?
....
anbei die komplette Source:
Code:
H DECEDIT('0,') DATEDIT(*DMY.)
H DFTACTGRP(*NO) OPTION(*NODEBUGIO)
H* ***************************************************************
*
//-----------------------------------
// Prototypenbeschreibung für Module
// und Serviceprogramme einbinden
//-----------------------------------
D/COPY QSYSINC/QRPGLESRC,QUSROBJD
*
//-----------------------------------------
// Prozeduren für Exterene Programmaufrufe
//-----------------------------------------
D USROBJD PR EXTPGM('QUSROBJD')
D R_RTN 527A
D R_LEN 4B 0
D R_FMT 8A
D R_OBJ 20A
D R_OBJT 10A
*
//-----------------------------------------
// übersicht interne Prozeduren/Funktionen
//-----------------------------------------
D GET_SIZE PR
D V_OBJ 10A VALUE
D V_LIBL 10A VALUE
D V_SIZE 9S 0 OPTIONS(*NOPASS)
D V_OK N OPTIONS(*NOPASS)
*
* Prozedurenprototyp für Prozedur 'QMHSNDPM'
*
dQMHSNDPM PR ExtPgm('QMHSNDPM')
d 7A Const
d 20A Const
d 32767A Const Options(*VarSize)
d 10I 0 Const
d 10A Const
d 256A Const
d 10I 0 Const
d 4A
d 32767A Options(*VarSize)
d 10I 0 Const Options(*NoPass)
d 20A Const Options(*NoPass)
d 10I 0 Const Options(*NoPass)
d 10A Const Options(*NoPass)
d 10I 0 Const Options(*NoPass)
*
* Datenstruktur für Format 'ERRC0100' für Fehlercode
*
dERRC0100 DS
d ERRCBytePrv 10I 0 Inz(272)
d ERRCByteAvl 10I 0
d ERRCExcId 7A
d ERRCRsrvd 1A
d ERRCExcDta 256A
*
//------------------------------------------
// Variablendeklaration
//------------------------------------------
*
D OK S N Inz(*Off)
d ITMsgKey S 4A
D P_MsgData S 32767A
D P_DataLength S 10I 0
D SIZE S 9S 0
*
‚*-------------------------------------------------------------------
‚* PARAMETER
‚*-------------------------------------------------------------------
C *ENTRY PLIST
C PARM PAFILE 10
C PARM PALIBL 10
*
C*‚********************************************************************
C*š* MAIN-PROGRAM *
C*‚********************************************************************
*
* // Größe der Datei ermitteln
C CALLP(E) GET_SIZE(PAFILE:PALIBL:SIZE:OK)
*
C EXSR SND_MSG
*
*š // Programmende einleiten
C MOVE *ON *INLR
C*
*=====================================================================
*= SND_MSG - Nachricht in die Messagesubfile schreiben
*=====================================================================
C SND_MSG BEGSR
*
* // Vorhergehende Verarbeitung ok ?
C IF OK
C EVAL P_MsgData = 'Datei: ' + %TRIM(PAFILE) +
C ' - Größe: ' +
C %TRIM(%EDITC(SIZE:'K')) + ' Byte'
C ELSE
C EVAL P_MsgData = 'Datei wurde nicht gefunden...'
C ENDIF
*
C EVAL P_DataLength = %SIZE(P_MsgData)
*
* //Nachricht in die Messagesubfile senden
c Reset ERRC0100
c CallP QMHSNDPM('CPF9897' :
c 'QCPFMSG *LIBL' :
c P_MsgData :
c P_DataLength :
c '*INFO' :
c '*' :
c 2 :
c ITMsgKey :
c ERRC0100 :
c 1 :
c '*NONE *NONE' :
c 0)
*
C ENDSR
*
//--------------------------------------------------------------------
// Funktion GET_SIZE : Dateigröße ermitteln
//--------------------------------------------------------------------
P GET_SIZE B
D GET_SIZE PI
D V_OBJ 10A VALUE
D V_LIBL 10A VALUE
D V_SIZE 9S 0 OPTIONS(*NOPASS)
D V_OK N OPTIONS(*NOPASS)
//------------------
// Lokale Variablen
//------------------
D L_LEN S 4B 0 INZ
D L_FMT S 8A INZ
D L_OBJ S 20A INZ
D L_OBJT S 10A INZ
D L_TEST S 527A INZ
//--------------------------------------------------------------------
C CLEAR QUSD0400
*
C IF V_LIBL = *BLANKS
C EVAL L_OBJ = V_OBJ + '*LIBL'
C ELSE
C EVAL L_OBJ = V_OBJ + '' + %TRIM(V_LIBL)
C ENDIF
*
C EVAL L_OBJT = '*FILE'
C EVAL L_LEN = %SIZE(QUSD0400)
C EVAL L_FMT = 'OBJD0400'
C CALLP(E) USROBJD(L_TEST:L_LEN:L_FMT:L_OBJ:L_OBJT)
C EVAL QUSD0400 = L_TEST
C IF NOT %ERROR()
C EVAL V_SIZE = QUSOBJS00
C EVAL V_OK = *ON
C ELSE
C EVAL V_OK = *OFF
C ENDIF
*
C RETURN
*
//--------------------------------------------------------------------
P GET_SIZE E
Gruß
Bratmaxxe
Bookmarks