|
Jon - just to let you know that I changed a test version of my program and inserted your code strictly for testing, at one of the EXFMT's . I then ran the program in debug. IT WORKED LIKE A CHARM All I can say is - MUCH appreciated Alan Shore NBTY, Inc (631) 244-2000 ext. 5019 AShore@xxxxxxxx rpg400-l-bounces+alanshore=nbty.com@xxxxxxxxxxxx wrote on 02/14/2007 02:56:37 PM:
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.