home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1996 September / Simtel-MSDOS-Sep1996-CD1.iso / 00_info / simcvt.exc < prev    next >
Text File  |  1996-02-24  |  3KB  |  79 lines
  1. /* SIMCVT EXEC.  Version of 12 Dec 1989 */
  2. /* Removed references to NODESCR IDX */
  3. /* First line of preamble.  Version of 12 Dec 1989 */
  4.    current_preamble_date = '12 Dec 1989'
  5.    signal on ERROR; signal on NOVALUE; signal on SYNTAX; address COMMAND
  6. /* trace r */
  7. /* end of preamble */
  8. /* SIMCVT3 EXEC.  Version of 21 Nov 1989 */
  9. /* This software is provided free on an as-is basis. Use at your own   */
  10. /* risk.                                                               */
  11. /* Report problems to Peter Jones, UQAM, (514)-987-3542 (voice)        */
  12. /*                                       (514)-987-7098 (FAX)          */
  13. /*                                       MAINT@UQAM     (BITNET)       */
  14. /*                                                                     */
  15. /* Requires ARCUTIL MODULE, available from LISTSERV@RPIECS             */
  16. /*     e.g. TELL LISTSERV AT RPIECS GETND ARCUTIL PACKAGE              */
  17. /*                                                                     */
  18. /* end of preamble */
  19. /* Bombs if SIMIBM.ARC not present, or in wrong format */
  20. /* SIMCVTC EXEC.  Version of 2 Sep 1989 */
  21. /* Start from SIMIBM.ARC */
  22.    'ARCUTIL UNARC SIMIBM ARC (REPLACE EBCDIC MEMBER SIMIBM  IDX'
  23. /* Rewrite of SIMCVT.BAS in REXX */
  24. /* Read the file SIMIBM.IDX (from Simtel.Net), and print a readable form */
  25. /* in  a file called SIMIBM.LST. */
  26. /* On CMS, ths filetype was changed to LISTING, to use carriage control */
  27. /* Check input file exists */
  28.    'ESTATE SIMIBM  IDX *'
  29.    signal off ERROR; 'FINIS  SIMIBM  IDX *'; signal on ERROR
  30.    'EXECIO 1 EMSG (STRING SIMCVT001I SIMIBM LISTING A is being generated.'
  31.    simeof = 0;
  32.    lastfs = ''; lastdir = ''
  33.    call simget
  34. /* Print heading on output file */
  35.    signal off ERROR; 'ERASE SIMIBM LISTING A'; signal on ERROR
  36.    write_output = 'EXECIO 1 DISKW SIMIBM LISTING A'
  37.    write_output '1 V 132 (STRING',
  38.       "1Simtel.Net Public Domain, Freeware and Shareware list as of" date('O')
  39.    call output "0NOTE: Type B is Binary; Type A is ASCII"
  40.    do while simeof = 0; call simprt; end
  41.    'EXECIO 1 EMSG (STRING SIMCVT002I SIMIBM LISTING A has been generated.'
  42.    'ERASE SIMIBM  IDX'
  43.    exit
  44. /* Supporting I/O routines */
  45. simprt:
  46.    if simfs^=lastfs | simdir^=lastdir then call newfsdir
  47.    if simbits=8 then simbits = 'B'; else simbits = 'A'
  48.    call output ' 'left(simflnm,14)||simbits||right(simlngth,7),
  49.       right(simdt,7) ' 'simdescr
  50.    lastfs = simfs; lastdir = simdir
  51.    if simeof = 0 then call simget
  52.    return
  53. newfsdir:
  54.    call output '0Directory' simfs||simdir
  55.    call output '  Filename   Type Length   Date    Description'
  56.    call output ' =============================================='
  57.    return
  58. output: procedure expose write_output
  59.    parse arg string
  60.    write_output '(STRING' string
  61.    return
  62. /* Routine for input */
  63. simget:
  64.    signal off ERROR
  65.       'EXECIO 1 DISKR' 'SIMIBM  IDX * (VAR SIMREC'
  66.    signal on ERROR
  67.    if rc = 0 then parse var simrec '"'simfs'","'simdir'","'simflnm'",',
  68.       simrev','simlngth','simbits','simdt',"'simdescr'"'
  69.    else simeof = 1
  70.    return
  71. /* first line of postamble */
  72. error: trace 'O'; rcsave = rc
  73.    parse source . . source_fn source_ft source_fm .
  74.    source_id = source_fn source_ft source_fm;
  75.    'EXECIO 1 EMSG(STRING INSRCB001T Unexpected return code' rc,
  76.       'in file named '''source_id''' near line' sigl'.'
  77.    address COMMAND 'DROPBUF'; exit rcsave
  78. /* end of postamble */
  79.