home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / wps / com / pmcomm / tools / printd.cmd < prev    next >
Encoding:
Text File  |  1992-05-07  |  9.7 KB  |  345 lines
  1. /*---------------------------------------------------------------
  2.  
  3.   Program:    PRINTD.CMD
  4.   Op Sys:     OS/2 1.3 or later
  5.   Runtime:    REXX/2
  6.   Libraries:  none
  7.   Author:     Brad Berson
  8.   Date:       April 28, 1992
  9.   History:    1.00  Original conversion from QuickBASIC!
  10.  
  11. -----------------------------------------------------------------
  12.  
  13.   PrintDir  Copyright (C) 1992  Brad Berson  Psycho Psoftware
  14.               All Rights Reserved.  So There.
  15.  
  16.   You are entitled to freely distribute this file unmodified
  17.   and accompanied by PRINTD.DOC.  Modified versions may not
  18.   be distributed without written permission from author.
  19.   Evaluation is free.  If you find PrintDir useful and you
  20.   wish to continue using it, you should consider sending a
  21.   Shareware donation amount of $10 (or more!) to Brad Berson,
  22.   #2 Chaparral Road, Chestnut Ridge, New York 10977.
  23.  
  24.   Technical support available via CIS:[71631,132], the Ilink
  25.   OS/2 conference or USPS.
  26.  
  27.   This program reads Multi-Net's PMcomm dialing directory
  28.   files (*.FON) and creates a human-readable text file of
  29.   the information therein, suitable for viewing or for
  30.   printing in 132-column format.  See the accompanying
  31.   PRINTD.DOC for more info.
  32.  
  33.   Invocation:  PRINTD [PMcomm.FON] [PMcomm.LST]
  34.   Switches:    none
  35.   PrintDir dialogue will request info for items not included.
  36.  
  37. -----------------------------------------------------------------
  38.  
  39.       name        c21   1
  40.       number      c21   22    PMCOMM.FON file format:
  41.       baud        c7    43    int 2 byte, long 4 byte (unsigned)
  42.       parity      c5    50    null-terminated/padded strings
  43.       datab       c2    55
  44.       stopb       c2    57    timeson     int   84
  45.       script      c13   59    filesdl     int   86
  46.       protocol    int   72    filesul     int   88
  47.       prefix      int   74    cpsul       int   90
  48.       suffix      int   76    termtype    int   92
  49.       laston      long  78    autosel     int   94
  50.       cpsdl       int   82    fill        c27   96
  51.  
  52. ---------------------------------------------------------------*/
  53.  
  54. cr='0d'x
  55. lf='0a'x
  56. nul='0'x
  57. crlf=cr||lf
  58. recsdone=0
  59. pmreclen=122
  60. maxlines=1000
  61. totitems=maxlines
  62. infile='PMCOMM.FON'
  63. outfile='PMCOMM.LST'
  64. mndays.1=0
  65. mndays.2=31
  66. mndays.3=59
  67. mndays.4=90
  68. mndays.5=120
  69. mndays.6=151
  70. mndays.7=181
  71. mndays.8=212
  72. mndays.9=243
  73. mndays.10=273
  74. mndays.11=304
  75. mndays.12=334
  76. mndays.13=365
  77.  
  78. SIGNAL ON HALT NAME ERRH
  79. SIGNAL ON ERROR NAME ERRH
  80. SIGNAL ON SYNTAX NAME ERRH
  81. PARSE UPPER ARG inarg outarg
  82.  
  83. SAY ' '
  84. SAY '* PrintDir/REXX 1.00, Copyright 1992 Brad Berson'
  85. SAY '* The PMcomm .FON dialing directory printer'
  86. SAY ' '
  87.  
  88. IF POS('?',inarg)>0 THEN DO
  89.   SAY 'Invocation:  PRINTD [PMcomm.FON] [PMcomm.LST]'
  90.   SAY 'Switches:    none'
  91.   SAY 'PrintDir dialogue will request info for items not included.'
  92.   EXIT
  93. END
  94.  
  95. IF inarg>'' THEN
  96.   infile=inarg
  97. ELSE DO
  98.   CALL CHAROUT ,'PMcomm FON file specification <'||infile||'>: '
  99.   pmans=LINEIN()
  100.   IF pmans>'' THEN infile=pmans
  101. END
  102.  
  103. IF outarg>'' THEN
  104.   outfile=outarg
  105. ELSE DO
  106.   CALL CHAROUT ,'Output listfile specification <'||outfile||'>: '
  107.   ofans=LINEIN()
  108.   IF ofans>'' THEN outfile=ofans
  109. END
  110.  
  111. IF RIGHT(infile,1)='\' THEN infile=infile||'PMCOMM'
  112. IF RIGHT(outfile,1)='\' THEN outfile=outfile||'PMCOMM'
  113. IF POS('.',infile,LENGTH(infile)-3)=0 THEN infile=infile||'.FON'
  114. IF POS('.',outfile,LENGTH(outfile)-3)=0 THEN outfile=outfile||'.LST'
  115.  
  116. /* Open PMCOMM.FON and get size) */
  117. pmstate=STREAM(infile,'c','open read')
  118. IF pmstate<>'READY:' THEN DO
  119.   SAY 'Failed to open 'infile'... 'pmstate
  120.   EXIT
  121. END
  122. pmlength=STREAM(infile,'c','query size')
  123. pmrecs=pmlength/pmreclen-1
  124.  
  125. /* Open PMCOMM.LST, scratch if exists */
  126. lfstate=STREAM(outfile,'c','open write')
  127. IF lfstate<>'READY:' THEN DO
  128.   SAY 'Failed to open 'outfile'... 'lfstate
  129.   EXIT
  130. END
  131. lfstate=STREAM(outfile,'c','seek =1')
  132.  
  133. SAY 'Creating 'outfile' from 'infile'...'
  134.  
  135. /* Get records and do translations */
  136. DO recnum=1 TO pmrecs BY 1
  137.   IF totitems=maxlines THEN DO
  138.     CALL LFHD
  139.     totitems=0
  140.   END
  141.   totitems=totitems+1
  142.   pmrecord=CHARIN(infile,,pmreclen)
  143.   CALL CHAROUT ,cr||'Processing record '||recnum
  144.   CALL BRPM
  145.   SELECT
  146.     WHEN protocol=0 THEN protocol='-unset-'
  147.     WHEN protocol=1 THEN protocol='Xmdm+Chk'
  148.     WHEN protocol=2 THEN protocol='Xmdm+CRC'
  149.     WHEN protocol=3 THEN protocol='Xmdm+1K'
  150.     WHEN protocol=4 THEN protocol='Ymdm+Bat'
  151.     WHEN protocol=5 THEN protocol='Ymdm+G'
  152.     WHEN protocol=234 THEN protocol='Xmdm-Chk'
  153.     WHEN protocol=233 THEN protocol='Xmdm-CRC'
  154.     WHEN protocol=228 THEN protocol='Xmdm-1K'
  155.     WHEN protocol=232 THEN protocol='Ymdm-Bat'
  156.     WHEN protocol=230 THEN protocol='Ymdm-G'
  157.     WHEN protocol=150 THEN protocol='CIS-B'
  158.     WHEN protocol=221 THEN protocol='IND$FILE'
  159.     WHEN protocol=222 THEN protocol='Kermit'
  160.     WHEN protocol=231 THEN protocol='Zmodem'
  161.     WHEN protocol=711 THEN protocol='ASCII'
  162.     OTHERWISE protocol=protocol||'?'
  163.   END
  164.   SELECT
  165.     WHEN termtype=0 THEN termtype='unset'
  166.     WHEN termtype=162 THEN termtype='TTY'
  167.     WHEN termtype=174 THEN termtype='ANSI'
  168.     WHEN termtype=161 THEN termtype='VT100'
  169.     WHEN termtype=145 THEN termtype='VT220'
  170.     OTHERWISE termtype=termtype||'?'
  171.   END
  172.   laston=CTIME(laston)
  173.   CALL PRLI
  174.   recsdone=recsdone+1
  175. END
  176. lfrecord=COPIES('=',132)||crlf
  177. lfstate=CHAROUT(outfile,lfrecord)
  178. lfrecord='  Total entries: '||recsdone||crlf
  179. lfstate=CHAROUT(outfile,lfrecord)
  180. lfrecord=COPIES('=',132)||crlf
  181. lfstate=CHAROUT(outfile,lfrecord)
  182.  
  183. /* Close files and do some begging */
  184. pmstate=STREAM(infile,'c','close')
  185. lfstate=STREAM(outfile,'c','close')
  186. CALL CHAROUT ,cr'PRINTD complete, 'recsdone' entries processed.'crlf
  187. SAY ' '
  188. SAY "If you find this program useful, consider the author's"
  189. SAY 'time and effort and pay for this quality Shareware.'
  190. SAY ' '
  191. SAY 'Brad Berson, ABC-TV, 47 W. 66th St., NY NY 10023'
  192. EXIP:
  193. EXIT
  194.  
  195. /* Subroutine to print entries to LST file */
  196. PRLI:
  197.   IF autosel=0 THEN
  198.     selind='  '
  199.   ELSE
  200.     selind='* '
  201.   lfrecord=selind||,
  202.            RPD(name,22)||,
  203.            RST(number,22)||,
  204.            RST(STRIP(baud),8)||,
  205.            LEFT(parity,1)||'-'||,
  206.            datab||'-'||,
  207.            RPD(stopb,3)||,
  208.            RPD(protocol,10)||,
  209.            RPD(termtype,7)||,
  210.            RST(timeson,6)||,
  211.            RPD(laston,10)||,
  212.            RST(filesdl,6)||,
  213.            RST(cpsdl,7)||,
  214.            RST(filesul,6)||,
  215.            RST(cpsul,7)||,
  216.            script||,
  217.            crlf
  218.   lfstate=CHAROUT(outfile,lfrecord)
  219.   RETURN
  220.  
  221. /* Subroutine to break PMcomm records into fields */
  222. BRPM:
  223.   name=C2R(SUBSTR(pmrecord,1,21))
  224.   number=C2R(SUBSTR(pmrecord,22,21))
  225.   baud=C2R(SUBSTR(pmrecord,43,7))
  226.   parity=C2R(SUBSTR(pmrecord,50,5))
  227.   datab=C2R(SUBSTR(pmrecord,55,2))
  228.   stopb=C2R(SUBSTR(pmrecord,57,2))
  229.   script=C2R(SUBSTR(pmrecord,59,13))
  230.   protocol=C2D(REVERSE(SUBSTR(pmrecord,72,2)),2)
  231.   laston=C2D(REVERSE(SUBSTR(pmrecord,78,4)),4)
  232.   cpsdl=C2D(REVERSE(SUBSTR(pmrecord,82,2)))
  233.   timeson=C2D(REVERSE(SUBSTR(pmrecord,84,2)))
  234.   filesdl=C2D(REVERSE(SUBSTR(pmrecord,86,2)))
  235.   filesul=C2D(REVERSE(SUBSTR(pmrecord,88,2)))
  236.   cpsul=C2D(REVERSE(SUBSTR(pmrecord,90,2)))
  237.   termtype=C2D(REVERSE(SUBSTR(pmrecord,92,2)))
  238.   autosel=C2D(REVERSE(SUBSTR(pmrecord,94,2)))
  239.   RETURN
  240.  
  241. /* Subroutine to print directory heading */
  242. LFHD:
  243.   header='Contents of PMcomm directory file '||infile||,
  244.   ': Created by PrintDir/REXX 1.0 Copyright 1992 Brad Berson'
  245.   lfrecord=COPIES('=',132)||crlf
  246.   lfstate=CHAROUT(outfile,lfrecord)
  247.   lfrecord=CENTER(header,132)||crlf
  248.   lfstate=CHAROUT(outfile,lfrecord)
  249.   lfrecord=COPIES('-',132)||crlf
  250.   lfstate=CHAROUT(outfile,lfrecord)
  251.   lfrecord='      Name                      '||,
  252.            'Number         '||,
  253.            'Baud   '||,
  254.            'P-D-S  '||,
  255.            'Protocol  '||,
  256.            'Emul  '||,
  257.            '#Calls  '||,
  258.            'Last on   '||,
  259.            'D/Ls, CPS    '||,
  260.            'U/Ls, CPS   '||,
  261.            'Script name'||,
  262.            crlf
  263.   lfstate=CHAROUT(outfile,lfrecord)
  264.   lfrecord=COPIES('=',132)||crlf
  265.   lfstate=CHAROUT(outfile,lfrecord)
  266.   RETURN
  267.  
  268. /* Function to convert C string to raw string */
  269. C2R: PROCEDURE
  270.   string=arg(1)
  271.   nulpos=POS('0'x,string)-1
  272.   string=SUBSTR(string,1,nulpos)
  273.   RETURN string
  274.  
  275. /* Function to right-pad character strings */
  276. RPD: PROCEDURE
  277.   string=arg(1)
  278.   fsize=arg(2)
  279.   string=string||COPIES(' ',fsize-length(string))
  280.   RETURN string
  281.  
  282. /* Function to right-set(+2) character strings */
  283. RST: PROCEDURE
  284.   string=arg(1)
  285.   fsize=arg(2)-2
  286.   string=COPIES(' ',fsize-length(string))||string||'  '
  287.   RETURN string
  288.  
  289. /* Function returns two-place zero-padded string */
  290. DPD: PROCEDURE
  291.   dpad=arg(1)
  292.   IF dpad < 10 THEN
  293.     dpad='0'||dpad
  294.   ELSE
  295.     dpad=''||dpad
  296.   RETURN dpad
  297.  
  298. /* Function to determine leap year or not */
  299. GETLEAP: PROCEDURE
  300.   year=arg(1)
  301.   IF (year/4)=(year%4) THEN
  302.     leap=1
  303.   ELSE
  304.     leap=0
  305.   RETURN leap
  306.  
  307. /* Convert 'C' time value to a MM/DD/YY string */
  308. CTIME: PROCEDURE EXPOSE mndays.
  309.   inpval=arg(1)
  310.   days=1 ; mnth=1 ; year=1970
  311.   inpval=inpval%86400
  312.   IF inpval < 5475 THEN DO
  313.     ctime='        '
  314.     RETURN ctime
  315.   END
  316.   leap=GETLEAP(year)
  317.   DO WHILE inpval > 365+leap
  318.     inpval=inpval-(365+leap)
  319.     year=year+1
  320.     leap=GETLEAP(year)
  321.   END
  322.   IF inpval > 31 THEN
  323.     DO mnth=2 TO 12 BY 1
  324.       tmnth=mnth+1
  325.       IF mndays.tmnth+leap >= inpval THEN LEAVE
  326.     END
  327.   days=inpval-mndays.mnth
  328.   IF mnth>2 THEN days=days-leap
  329.   days=format(days)
  330.   ctime=dpd(mnth)||'/'||dpd(days)||'/'||right(year,2)
  331.   RETURN ctime
  332.   
  333. /* Error handler */
  334. ERRH:
  335.   SAY ' '
  336.   IF RC='RC' THEN
  337.     SAY 'REXX/2 ERROR in line 'sigl
  338.   ELSE
  339.     SAY 'REXX/2 ERROR 'rc' in line 'sigl': 'ERRORTEXT(rc)
  340.   SAY SOURCELINE(sigl)
  341.   SAY 'Condition: 'CONDITION('C')
  342.   SAY 'PROGRAM ABENDED.'
  343.   EXIT
  344.  
  345.