× 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.


  • Subject: Re: Generating PC file formats from AS/400 data
  • From: jpcarr@xxxxxxxxxxxx
  • Date: Tue, 8 Aug 2000 21:30:08 -0400





Ok here it is.   Convert the below to Courier font and just put it in a
source file(two of them) and
take an Action Option 15 in PDM to create module then use CRTPGM to create
the program
from the module.

You don't even have to under stand it.   It work for youl.    Just change

FILEX to your file
XXXSRCNO
&
XXXDESC

to your field names in the file.  Change the HEADING subroutine to put out
the Column Headings in the file.
Put  your target name in instead of the contents of FileName .

If you have any questions running it let me know.   I just ran it just now
so I know it works.
Bring up Excel,  click OPEN,  click on Network Neighborhood,   You should
see your AS/400
name.   If you don't    You should.   Talk to your network people and ask
why you don't see
the AS/400's IFS there.

You can make this alot better,  as I said in a previous post.    Chain to
multiple files,
write out a composite record of different stuff.

Thought you folks would like it.

If you want to see more.   come to COMMON and catch my sessions.
Or sign up for one of my classes from 400school.com

Respectfully
John Carr





D*=================================================================
D*    Write out a .CSV file
D*=================================================================
FFILEX     IF   E             DISK

D*=================================================================
D*    @IFS - Prototypes for API's
D*=================================================================

D/COPY srclib/srcfile,@IFS

D*-----------------------------------------------------------------
D*        Replace the contents of FileName with your IFS file name to be
created.
D*-----------------------------------------------------------------
  D Comma           C                   CONST(',')
D Quote           C                   CONST('"')
D Null            C                   CONST(x'00')

D FileName        S             80    INZ('/thtc/GL.csv')

D ERR_FLAG        S             10I 0
D oflag           S             10I 0
D rc              S             10I 0

D CodePage        S             10U 0 INZ(819)
D omode           S             10U 0
D BufLen          S             10U 0

D OutRec          S            256
D str             S              3  0
D EOLA            S              2    INZ(x'0d25')

D NUM             S             20    VARYING

C**========================================================
C**       T O P   O F   T H E    C A L C S
C**========================================================

C                   EXSR      CRT_FILE

C                   EXSR      OPN_FILE

C                   EXSR      HEADING

C                   DOU       %EOF(FILEX)
C                   READ      FILEX
C                   IF        %EOF(FILEX)
C                   LEAVE
C                   ENDIF

C                   EXSR      BLDREC

C                   EXSR      WRT_IFS

C                   ENDDO

C                   EVAL      RC         =  close(ERR_FLAG)

C                   EXSR      EXIT
C*
C**================================================================
C**   CRT_FILE   - Create file with correct code page, authority &
everything.
C**================================================================
C     CRT_FILE      BEGSR

C                   EVAL      Oflag  = O_CREAT + O_CODEPAGE + O_RDWR

C                   EVAL      Omode  = S_IRWXU  + S_IROTH

C                   EVAL      FILENAME = %TRIM(FILENAME) + NULL

C                   EVAL      ERR_FLAG   =  OPEN(%ADDR(FILENAME): OFLAG:
C                                                OMODE: CODEPAGE)

C                   IF        ERR_FLAG < 0
C                   EXSR      EXIT
C                   ENDIF

C                   EVAL      RC = CLOSE(ERR_FLAG)

C                   ENDSR
C**====================================================================
C**    Just start adding to the OUTREC field.  Each field separated by a
comma
C**    my fields are the XXXSRCNO and XXXDESC replace them with yours.
C**====================================================================
C     BLDREC        BEGSR

C                   EVAL      NUM        =  %EDITC(XXXSRCNO:'P')
C                   EVAL      outrec     =  %trim(OUTREC)  +
C                                           %trim(NUM)     + ','

C                   EVAL      outrec     =  %trim(OUTREC) +
C                                           %trim(XXXDESC)  +  ','

C                   EVAL      outrec     =  %TRIM(outrec) + EOLA

C                   ENDSR
C**====================================================================
C**   OPN_FILE
C**====================================================================
C     OPN_FILE      BEGSR

C                   EVAL      OFLAG      =  O_WRONLY + O_TEXTDATA

C                   EVAL      ERR_FLAG   =  OPEN(%ADDR(FILENAME): OFLAG)

C                   IF        ERR_FLAG < 0
C                   EXSR      EXIT
C                   ENDIF

C                   ENDSR
C**====================================================================
C**   WRT_IFS                          (yes, I know,   convert this to
buflen = %size(%trim(outrec))
C**====================================================================
C     WRT_IFS       BEGSR

C     EOLA          SCAN      OUTREC:1      STR
C                   EVAL      BufLen     =  (STR + 1)

C                   EVAL      RC  =  WRITE(ERR_FLAG: %ADDR(OUTREC): BUFLEN)
C

C                   CLEAR                   OUTREC

C                   ENDSR
C**====================================================================
C**   Heading - Write out first Record with Column Headings
C**====================================================================
C     HEADING       BEGSR

C                   EVAL      outrec     =  'Source Number'    + ','  +
C                                           'Description'      + ','  +
C                                            EOLA

C                   EXSR      WRT_IFS
C                   ENDSR
C**==================================================================
C**   EXIT - EXIT SUBROUTINE, Only Way Out Of Program
C**==================================================================
C     EXIT          BEGSR

C                   EVAL      *INLR      =  *ON

C                   RETURN

C                   ENDSR


------------------

This is the /copy in all my IFS programs
-----------
D*--------------------------------------------------------------------
D*    ProtoTypes and definitions for working with the IFS
D*--------------------------------------------------------------------
D*
D*--------------------------------------------------------------------
D*    OPEN - Open an IFS file
D*--------------------------------------------------------------------
D open            PR            10I 0 EXTPROC('open')
D   filename                      *   VALUE
D   openflags                   10I 0 VALUE
D   mode                        10U 0 VALUE options(*nopass)
D   codepage                    10U 0 VALUE options(*nopass)
D*
D*--------------------------------------------------------------------
D*    READ - Read an IFS file
D*------------------------------------------------------------
D read            PR            10I 0 EXTPROC('read')
D   filehandle                  10I 0 VALUE
D   datarcved                     *   VALUE
D   nbytes                      10U 0 VALUE
D*
D*------------------------------------------------------------
D*    Write - Write record to IFS File
D*------------------------------------------------------------
D write           PR            10I 0 EXTPROC('write')
D   filehandle                  10I 0 VALUE
D   datatowrt                     *   VALUE
D   nbytes                      10U 0 VALUE
D*
 D*----------------------------------------------------------------
 D*    Close - Close IFS File
 D*----------------------------------------------------------------
 D close           PR            10I 0 EXTPROC('close')
 D   filehandle                  10I 0 VALUE
 D*
 D*----------------------------------------------------------------
 D*    RC = IFS API Return code
 D*----------------------------------------------------------------

 D O_APPEND        S             10I 0 INZ(256)
 D O_CODEPAGE      S             10I 0 INZ(8388608)
 D O_CREAT         S             10I 0 INZ(8)
 D O_EXCL          S             10I 0 INZ(16)
 D O_RDONLY        S             10I 0 INZ(1)
 D O_RDWR          S             10I 0 INZ(4)
 D O_TEXTDATA      S             10I 0 INZ(16777216)

 D O_TRUNC         S             10I 0 INZ(64)
 D O_WRONLY        S             10I 0 INZ(2)

 D S_IRUSR         S             10I 0 INZ(256)
 D S_IWUSR         S             10I 0 INZ(128)
 D S_IXUSR         S             10I 0 INZ(64)
 D S_IRWXU         S             10I 0 INZ(448)

 D S_IRGRP         S             10I 0 INZ(32)
 D S_IWGRP         S             10I 0 INZ(16)
 D S_IXGRP         S             10I 0 INZ(8)
 D S_IRWXG         S             10I 0 INZ(56)

 D S_IROTH         S             10I 0 INZ(4)
 D S_IWOTH         S             10I 0 INZ(2)
 D S_IXOTH         S             10I 0 INZ(1)
 D S_IRWXO         S             10I 0 INZ(7)















+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---

As an Amazon Associate we earn from qualifying purchases.

This thread ...


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.