|
midrange.com
Here's an example of call the Retrieve Member Description API in RPG IV.
I use this with CodeStudio to retrieve information about the member via FTP
which unfortunately requires you to send and Escape message. :(
But look at the example call to the QUSRMBRD API for an example of calling
it.
H BNDDIR('QC2LE') actgrp('QILE') DFTACTGRP(*NO)
**----------------------------------------------------------------
** RTVMBRD - Retrieve a member description
** and write as an *ESCAPE message to the FTP client.
** Used by CodeStudio to retrieve a member description
** (i.e., Source Type - SEU Attributes)
**----------------------------------------------------------------
** COMPILING INSTRUCTIONS:
** NOTE: This program is NOT Release Sensitive
** 1. Upload to the AS/400
** 2. Compile to the library of your choice
** a) CRTBNDRPG PGM(QGPL/RTVMBRD) SRCFILE(mylib/QRPLESRC) +
** DFTACTGRP(*NO)
** 3. In CodeStudio, on the TOOLS menu, select OPTIONS
** 4. Select the "Add-Ins" tab/page
** 5. Set the host program to call to this program name:
** a) Heading: CL command to retrieve member description...
** b) Entry: CALL QGPL/RTVMBRD PARM(&F &L &M)
**
** When these steps have been completed, this add-in will
** transfer the Source Member's SEU Type, Text, Last Change Date
** to CodeStudio when a member is selected for download.
**----------------------------------------------------------------
** int sprintf( char *buffer, const char *format [, argument] ... );
D sprintf4 PR 10I 0 ExtProc('sprintf')
D szRecvVar * VALUE Options(*STRING)
D szFormat * VALUE Options(*STRING)
D szData1 * VALUE OPTIONS(*STRING)
D szData2 * VALUE OPTIONS(*STRING: *NOPASS)
D szData3 * VALUE OPTIONS(*STRING: *NOPASS)
D szData4 * VALUE OPTIONS(*STRING: *NOPASS)
** The general purpose API error data structure that is usually
ignored.
D api_error S 21A
** The fields used by the SndPgmMsg API
D szMsgID S 7A Inz('CPF9898')
D szMsgFile S 20A Inz('QCPFMSG QSYS' )
D szMsgText S 255A
D nMsgLen S 10I 0
D szMsgType S 10A
D szToPgmQ S 10A
D nToPgmQ S 10I 0
D szMsgKey S 4A
** A pointer to the receiving buffer, used by sprintf
D pBuffer S *
D szBuffer S Like(szMsgText)
** Tells the APIs how long the buffers are that are being used.
D nBufLen S 10I 0
**----------------------------------------------------------------
**----------------------------------------------------------------
** The structure returned by the QusRMBRD API.
**----------------------------------------------------------------
**----------------------------------------------------------------
D szMbrd0100 DS INZ
D nBytesRtn 10I 0
D nBytesAval 10I 0
D szFileName 10A
D szLibName 10A
D szMbrName 10A
D szFileAttr 10A
D szSrcType 10A
D dtCrtDate 13A
D dtLstChg 13A
D szMbrText 50A
D bIsSource 1A
D pMbrText S *
**----------------------------------------------------------------
** Input Parameters for the program.
**----------------------------------------------------------------
** Source file name
D szSrcFile S 10A
D szSrcLib S 10A
D szSrcMbr S 10A
**----------------------------------------------------------------
** Input Parameters to the QUSRMBRD API
**----------------------------------------------------------------
** Format to be returned
D szFmt S 8A Inz('MBRD0100')
** Qualified source file and library name
D szQualName S 20A
** Whether or not to ignore overrides (0=Ignore, 1 = Apply)
D bOvr S 1A Inz('0')
**----------------------------------------------------------------
** Call this program with 3 parameters:
** Parm(QRPGLESRC myLibr ORDENTRY)
** srcfile srclib srcmbr
**----------------------------------------------------------------
C *ENTRY PLIST
C Parm szSrcFile
C Parm szSrcLib
C Parm szSrcMbr
** If we don't have at least 3 parameters, too bad for the caller!
C if %Parms < 3
C Eval szMsgText = 'CE3-Invalid parameter list'
C else
**----------------------------------------------------------------
** Call QusRMBRD to retrieve the specified source member's attributes
**----------------------------------------------------------------
C Eval szQualName = szSrcFile + szSrcLib
C Eval nBufLen = %size(szMbrD0100)
**----------------------------------------------------------------
C Call(E) 'QUSRMBRD'
C Parm szMbrD0100
C Parm nBufLen
C Parm szFmt
C Parm szQualName
C Parm szSrcMbr
C Parm bOvr
**----------------------------------------------------------------
** If RTFMBRD failed, we tell the FTP client that it failed.
**----------------------------------------------------------------
C if %Error
C Eval szMsgText = 'CE3-RTVMBRD Failed'
** Otherwise, just keep on going!
C else
** Although not required, C like NULL terminated strings
C Eval szBuffer= *ALLX'00'
C Eval pBuffer = %addr(szBuffer)
C eval szMbrText = %TrimR(szMbrText)+X'00'
C eval pMbrText = %addr(szMbrText)
**----------------------------------------------------------------
** Use the C runtime sprintf() to concatenate everything nicely
**----------------------------------------------------------------
C CallP sprintf4(pBuffer :
C 'CX3%s%s%s%s' :
C szSrcType :
C bIsSource :
C dtLstChg :
C pMbrText )
** The formatted response text gets sent as msg data
C Eval szMsgText = %str(pBuffer)
C endif
C endif
** Tell the API how long the message text (actually Msgdata) is.
C Eval nMsgLen = %Len(%trimr(szMsgText))
**----------------------------------------------------------------
** SndPgmMsg MSGID(CPF9898) MSGF(QSYS/QCPFMSG) TOPGMQ(*PRV) +
** MSGDTA(szMsgText) MSGTYPE(*ESCAPE)
**----------------------------------------------------------------
C Call 'QMHSNDPM'
C Parm 'CPF9898' szMsgID
C Parm szMsgFile
C Parm szMsgText
C Parm nMsgLen
C Parm '*ESCAPE' szMsgType
C Parm '*PGMBDY' szToPgmQ
C Parm 1 nToPgmQ
C Parm szMsgKey
C Parm api_error
** Note, we return here to improve performance for subsequent calls
** The program will end when the FTP server's job itself ends.
** If you are uncomfortable with this, uncomment the *INLR line:
C**** MOVE *ON *INLR
C return
Bob Cozzi
Cozzi Consulting
www.rpgiv.com
-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx [mailto:rpg400-l-bounces@xxxxxxxxxxxx]
On Behalf Of Peter Vidal
Sent: Wednesday, July 02, 2003 8:05 AM
To: RPG programming on the AS400 / iSeries
Subject: RE: RTV RPGLE SRC INFO WITH A PROGRAM
"THANK YOU,
A LIST OF API'S AND HOW TO USE THEM. THERE A BOOK?"
On which version level are you at?
Peter Vidal
Pall Aeropower Corp.
SR Programmer Analyst
WWW.Pall.com / 727-539-8448, x2414
"A good player makes himself look good; a great player makes the team look
good."
Author unknown
_______________________________________________
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-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.
