|
midrange.com
Thanks Jon.
That looks to be what I am looking for.
I'll put this into a test version of the program and give it a shot
Alan Shore
NBTY, Inc
(631) 244-2000 ext. 5019
AShore@xxxxxxxx
"Jon Paris"
<Jon.Paris@Partne
r400.com> To
Sent by: <rpg400-l@xxxxxxxxxxxx>
rpg400-l-bounces+ cc
alanshore=nbty.co
m@xxxxxxxxxxxx Subject
RE: Screen data capture
02/14/2007 02:57
PM
Please respond to
RPG programming
on the AS400 /
iSeries
<rpg400-l@midrang
e.com>
I have a demo program based on an example that Carsten Flensburg posted
here
some time back which uses the DSM APIs. I have included it below since I
can't find the original in the archives. It is intended for debugging
purposes. I have used it as part of a PSSR (and similar) error diagnostics
processes.
There is also a more comprehensive set of code (albeit for a different
purpose) here that you could adapt to your needs. Mine simply grabs the
buffer - this one replaces the screen attribute characters so the whole
thing is readable - you'll certainly want to do something like that. Wrap
the calls up as subprocedures, plug them into appropriate spots and off you
go.
http://archive.midrange.com/midrange-l/200411/msg00471.html
Here's the real simple code:
// Based on original code by Carsten Flensburg - via Midrange-L
// This version intended as base code for a PSSR type routine.
H BndDir( 'QC2LE' ) Option( *SrcStmt )
D InpBufHdl s 10i 0
D InpDtaPtr s *
D Parm Ds
D Row 10i 0
D Col 10i 0
D NbrBytRtn 10i 0
D Screen 3564a
D GetCsrAdr Pr 10i 0 ExtProc( 'QsnGetCsrAdr' )
D Row 10i 0
D Col 10i 0
D LlvEnvHdl 10i 0 Const Options( *Omit )
D ApiError 1024a Options( *Omit: *VarSize )
D CrtInpBuf Pr 10i 0 ExtProc( 'QsnCrtInpBuf' )
D InpBufSiz 10i 0 Const
D BufIncSiz 10i 0 Const Options( *Omit )
D BufMaxSiz 10i 0 Const Options( *Omit )
D InpBufHdl 10i 0 Options( *Omit )
D ApiError 1024a Options( *Omit: *VarSize )
D ReadScr Pr 10i 0 ExtProc( 'QsnReadScr' )
D NbrBytRead 10i 0 Options( *Omit )
D InpBufHdl 10i 0 Const Options( *Omit )
D CmdBufHdl 10i 0 Const Options( *Omit )
D LlvEnvHdl 10i 0 Options( *Omit )
D ApiError 1024a Options( *Omit: *VarSize )
D RtvDta Pr * ExtProc( 'QsnRtvDta' )
D InpBufHdl 10i 0 Const
D InpDtaPtr * Options( *Omit )
D ApiError 1024a Options( *Omit: *VarSize )
D DltBuf Pr 10I 0 ExtProc( 'QsnDltBuf' )
D BufferHdl 10I 0 Const
D ApiError 1024a Options( *Omit: *VarSize )
D MemCpy Pr * ExtProc( 'memcpy' )
D pOutMem * Value
D pInpMem * Value
D InpMemSiz 10u 0 Value
/FREE
InpBufHdl = CrtInpBuf( 27 * 132
: *Omit
: *Omit
: *Omit
: *Omit ); // Create DSM input buffer
GetCsrAdr( Row
: Col
: *Omit
: *Omit ); // Determine cursor position on display
// Omit this if info not required
NbrBytRtn = ReadScr( *Omit
: InpBufHdl
: *Omit
: *Omit
: *Omit ); // Reads the screen data into buffer and returns
// count of number of bytes in buffer
InpDtaPtr = RtvDta( InpBufHdl
: *Omit
: *Omit ); // retrieve pointer to DSM buffer
MemCpy( %Addr( Screen )
: InpDtaPtr
: NbrBytRtn ); // and move the contents into your own field
// Could also use the InpDtaPtr as a basing
pointer
DltBuf( InpBufHdl: *Omit ); // delete the buffer when you're done with it
Return;
/END-FREE
Jon Paris
Partner400
www.Partner400.com
--
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
