home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1997 March / Simtel-MSDOS-Mar1997-CD2.iso / 00_info / simcvt2.exc < prev    next >
Text File  |  1997-01-27  |  4KB  |  138 lines
  1. /* SIMCVT EXEC.  Original by Peter Jones Maint@Uqam.Bitnet
  2. Rewritten by (Robocop). 03.25.90. <Vivanco@Utfsm.Bitnet> Disca. */
  3. trace 'O'
  4. address ''
  5. arg yip
  6. yip=strip(yip)
  7. if yip='?'|yip='HELP' then signal help
  8. signal on syntax
  9. inp='SIMIBM IDX'
  10. out='SIMIBM LISTING'
  11. h='DMSSIM'
  12. 'ESTATE 'inp
  13. if rc^=0 then do
  14.    say h'028E Input file "'inp'" doesn''t exist.'
  15.    exit rc
  16. end
  17. 'MAKEBUF'
  18. nbuf=rc
  19. 'LISTF 'inp' * (LIFO ALL NOH'
  20. pull . . fm . len .
  21. 'DROPBUF 'nbuf
  22. fm=strip(fm)
  23. inp=inp fm
  24. len=strip(len)
  25. if len>132 then do
  26.    say h'001E Input file "'inp'" is in packed format.'
  27.    exit 1
  28. end
  29. push''
  30. pull lastfs lastdir dir
  31. say'Select your output disk: A, B, C, ...  Z. Default is "A".'
  32. parse upper external mod .
  33. mod=left(strip(mod),1)
  34. if mod=''|pos(mod,'ABCDEFGHIJKLMNOPQRSTUVWXYZ')=0 then mod='A'
  35. 'MAKEBUF'
  36. nbuf=rc
  37. 'QUERY DISK R/W (LIFO'
  38. if queued()>1 then do queued()-1
  39.    pull 12 $ 13
  40.    dir=dir $
  41. end
  42. 'DROPBUF 'nbuf
  43. if find(dir,mod)=0 then do
  44.    say h'036W Disk "'mod'" isn''t in write access mode.'
  45.    exit 36
  46. end
  47. out=out mod
  48. resp=''
  49. 'ESTATE 'out
  50. if rc=0 then do
  51.    say h'00IW Output file "'out'" already exists. Select your option:'
  52.    say'A=Generate append ; R=Replace existing file ; other key=exit.'
  53.    parse upper external resp .
  54.    resp=left(strip(resp),1)
  55.    if resp='R' then do
  56.       'ERASE 'out
  57.       if rc^=0 then do
  58.          say h'028E Output file "'out'" couldn''t be erased.'
  59.          exit rc
  60.       end
  61.    end
  62.    else if resp^='A' then exit
  63.    'FINIS 'out
  64. end
  65. say h'001I Output file "'out'" is being generated now.'
  66. input='EXECIO 1 DISKR 'inp
  67. output='EXECIO 1 DISKW 'out
  68. outp4='EXECIO 4 DISKW 'out' (NOTYPE STEM LIN.'
  69. tic='1SimTel.Net Public Domain, Freeware and Shareware list as of' 'DATE'('O')
  70. if resp^='A' then output' 1 V 132 (NOTYPE VAR TIC'
  71. else output' (NOTYPE VAR TIC'
  72. lin.4='0NOTE: Type B is Binary; Type A is ASCII'
  73. output=output' (NOTYPE VAR LIN.4'
  74. output
  75. lin.2='  Filename   Type Length   Date    Description'
  76. lin.3=' 'copies('=',46)
  77. input' 1 (STRIP VAR SIMREC'
  78. input=input' (STRIP VAR SIMREC'
  79. do while rc=0
  80.    parse var simrec '"'simfs'","'simdir'","'simflnm'",',
  81.    simrev','simlngth','simbits','simdt',"'simdescr'"'
  82.    if simbits=8 then simbits='B'
  83.    else simbits='A'
  84.    lin.4=' 'left(simflnm,14)||simbits||right(simlngth,7),
  85.    right(simdt,7) ' 'simdescr
  86.    if simfs simdir^=lastfs lastdir then do
  87.       lin.1='0Directory 'simfs||simdir
  88.       outp4
  89.       lastfs=simfs
  90.       lastdir=simdir
  91.    end
  92.    else output
  93.    if rc=0 then input
  94. end
  95. if rc=2 then do
  96.    say h'002I Output file "'out'" has been generated.'
  97.    'FINIS 'out
  98.    'FINIS 'inp
  99.    rcc=0
  100.    if yip='ERASE' then do
  101.       'ERASE 'inp
  102.       rcc=rc
  103.       if rc^=0 then say h'028E Input file "'inp'" couldn''t be erased.'
  104.    end
  105. end
  106. else do
  107.    rcc=rc
  108.    parse source . . fn ft fm .
  109.    say h||right(rc,3,0)' Unexpected return code rc 'rcc,
  110.    'in file named "'source_id'" near line' sigl'.'
  111.    'FINIS 'inp
  112.    'FINIS 'out
  113.    say'Explanation is: 'errortext(rcc)
  114. end
  115. exit rcc
  116. Syntax:
  117. say'Syntax error rc= 'rc' in line 'sigl'. Line is:'
  118. say sourceline(sigl)
  119. say'Explanations is:'
  120. say errortext(rc)
  121. exit rc
  122. Help:
  123. say'Simcvt exec uses file "simibm idx" to generate "simibm listing".'
  124. say'@Copyright 1990 by Peter Jones <Maint@Uqam.Bitnet>.'
  125. say'Rewritten by C. Valderrama C. <Vivanco@Utfsm.Bitnet>. 1991.'
  126. say
  127. say'Simcvt ?       Calls this brief explanation.'
  128. say'Simcvt ERASE',
  129. '  Erases source file "simibm idx" if process finishs correctly.'
  130. say
  131. say'If "simibm listing" already exists, simcvt will ask you what do'
  132. say'you want to do before continue.'
  133. say'Use "Arcutil module" available from Listserv@Rpiecs to convert',
  134. '"simibm arc"'
  135. say'into "simibm idx":   Arcutil unarc simibm arc (rep e m simibm idx'
  136. say' or use:   Arcutil uud simibm arc (eb'
  137. exit 100
  138.