Hallo Kollegen,
neulich hatte ich die Aufgabe PDF's direkt aus dem IFS zu drucken. Hierzu gibt es ein kleines RPG von Scott Klement, das ich in RPG-Free portiert habe.
Es werden alle Drucker unterstützt, die PDF's native drucken können
Code:
/*********************************************************************/
/* */
/* PRINT STREAMFILE */
/* */
/****************** */
/* R.ROSS 10.2021 * PGM PRTSTMF */
/*********************************************************************/
CMD PROMPT('Print Stream File')
PARM KWD(STMF) TYPE(*CHAR) LEN(256) MIN(1) +
VARY(*YES *INT2) CHOICE('IFS PATH') +
PROMPT('Stream File to print')
PARM KWD(OUTQ) TYPE(*CHAR) LEN(10) DFT(PRT01) +
PROMPT('Output Queue to print on')
/*********************************************************************/
Code:
ctl-opt dftactgrp(*no) alloc(*teraspace);
//------------------------------------------------------------------//
// //
// Print Streamfile //
// //
//----------------- //
// R.Ross 10.2021 * //
//------------------------------------------------------------------//
// Files //
//------------------------------------------------------------------//
dcl-f QSYSPRT printer(132) usage(*output) usropn;
//------------------------------------------------------------------//
// Input Parameter //
//------------------------------------------------------------------//
dcl-pi *n;
PiStmf varchar(256) const;
PiOutq char(10) const;
end-pi;
//------------------------------------------------------------------//
// QCMDEXC //
//------------------------------------------------------------------//
dcl-pr QCMDEXC extpgm;
Command char(32702) const options(*varsize);
Length packed(15:5) const;
end-pr;
//------------------------------------------------------------------//
// Open-File //
//------------------------------------------------------------------//
dcl-pr open int(10) extproc(*dclcase);
Filename pointer value options(*string);
Openflags int(10) value;
Mode uns(10) value options(*nopass);
Fileccsid uns(10) value options(*nopass);
Dataccsid uns(10) value options(*nopass);
end-pr;
//------------------------------------------------------------------//
// Read-File //
//------------------------------------------------------------------//
dcl-pr read int(10) extproc(*dclcase);
Filedesc int(10) value;
Buffer pointer value;
Bytes uns(10) value;
end-pr;
//------------------------------------------------------------------//
// Close-File //
//------------------------------------------------------------------//
dcl-pr close int(10) extproc(*dclcase);
Filedesc int(10) value;
end-pr;
//------------------------------------------------------------------//
// Constants IFS Parameter //
//------------------------------------------------------------------//
dcl-c O_Rdonly 1; // Read Only
//------------------------------------------------------------------//
// Processing //
//------------------------------------------------------------------//
main();
*inlr = *on;
//------------------------------------------------------------------//
// Main //
//------------------------------------------------------------------//
dcl-proc main;
dcl-ds DsLine qualified;
Line char(132);
end-ds;
dcl-s LocCommand varchar(256); // Command
dcl-s LocBuffer char(132); // Buffer
dcl-s LocFd int(10); // FileDescriptor
LocCommand = 'OVRPRTF FILE(QSYSPRT) DEVTYPE(*USERASCII) ' +
'OUTQ(' + %trim(PiOutq) + ')';
QCMDEXC(LocCommand: %len(LocCommand));
open QSYSPRT;
LocFd = open(PiStmf:O_RDONLY);
If LocFd < *zero;
ReportError();
endif;
LocBuffer = *allx'20';
dow (read(LocFd: %addr(LocBuffer): %size(LocBuffer)) > 0);
DsLine.Line = LocBuffer;
write QSYSPRT DsLine;
LocBuffer = *allx'20';
enddo;
callp close(LocFd);
close QSYSPRT;
LocCommand = 'DLTOVR FILE(QSYSPRT)';
QCMDEXC(LocCommand: %len(LocCommand));
end-proc;
//------------------------------------------------------------------//
// Report Error //
//------------------------------------------------------------------//
dcl-proc reportError;
dcl-pr get_errno pointer extproc('__errno');
end-pr;
dcl-s LocErr_p pointer; // Error-Pointer
dcl-s LocErrNo int(10) based(LocErr_p); // Error-Number
dcl-pr SndPgmMsg extpgm('QMHSNDPM');
MsgId char(07) const;
MsgFile char(20) const;
Data char(256) const;
DataLength int(10) const;
Type char(10) const;
CStEnt char(10) const;
CStCnt int(10) const;
Key char(04);
Error like(DsApierr);
end-pr;
dcl-ds DsApierr qualified inz; // API-Error
BytesProv int(10) inz(%size(DsApierr)); // Bytes Provided
BytesAvail int(10); // Bytes Avail
MsgId char(07); // ErrorMessageId
*n char(01);
ErrData char(256); // ErrorData
end-ds;
dcl-s LocMsgKey char(04);
dcl-s LocMsgId char(07);
LocErr_p = get_errno();
LocMsgId = 'CPE' + %char(LocErrno);
SndPgmMsg(LocMsgId:'QCPFMSG *LIBL':' ':0:'*ESCAPE':
'*PGMBDY':1:LocMsgKey:DsApierr);
end-proc;
//------------------------------------------------------------------//
Viel Spaß
Rainer Ross
Bookmarks