× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@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 thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 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.