home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 3 Comm
/
03-Comm.zip
/
PMAC10.ZIP
/
PRINTD.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1992-05-07
|
10KB
|
345 lines
/*---------------------------------------------------------------
Program: PRINTD.CMD
Op Sys: OS/2 1.3 or later
Runtime: REXX/2
Libraries: none
Author: Brad Berson
Date: April 28, 1992
History: 1.00 Original conversion from QuickBASIC!
-----------------------------------------------------------------
PrintDir Copyright (C) 1992 Brad Berson Psycho Psoftware
All Rights Reserved. So There.
You are entitled to freely distribute this file unmodified
and accompanied by PRINTD.DOC. Modified versions may not
be distributed without written permission from author.
Evaluation is free. If you find PrintDir useful and you
wish to continue using it, you should consider sending a
Shareware donation amount of $10 (or more!) to Brad Berson,
#2 Chaparral Road, Chestnut Ridge, New York 10977.
Technical support available via CIS:[71631,132], the Ilink
OS/2 conference or USPS.
This program reads Multi-Net's PMcomm dialing directory
files (*.FON) and creates a human-readable text file of
the information therein, suitable for viewing or for
printing in 132-column format. See the accompanying
PRINTD.DOC for more info.
Invocation: PRINTD [PMcomm.FON] [PMcomm.LST]
Switches: none
PrintDir dialogue will request info for items not included.
-----------------------------------------------------------------
name c21 1
number c21 22 PMCOMM.FON file format:
baud c7 43 int 2 byte, long 4 byte (unsigned)
parity c5 50 null-terminated/padded strings
datab c2 55
stopb c2 57 timeson int 84
script c13 59 filesdl int 86
protocol int 72 filesul int 88
prefix int 74 cpsul int 90
suffix int 76 termtype int 92
laston long 78 autosel int 94
cpsdl int 82 fill c27 96
---------------------------------------------------------------*/
cr='0d'x
lf='0a'x
nul='0'x
crlf=cr||lf
recsdone=0
pmreclen=122
maxlines=1000
totitems=maxlines
infile='PMCOMM.FON'
outfile='PMCOMM.LST'
mndays.1=0
mndays.2=31
mndays.3=59
mndays.4=90
mndays.5=120
mndays.6=151
mndays.7=181
mndays.8=212
mndays.9=243
mndays.10=273
mndays.11=304
mndays.12=334
mndays.13=365
SIGNAL ON HALT NAME ERRH
SIGNAL ON ERROR NAME ERRH
SIGNAL ON SYNTAX NAME ERRH
PARSE UPPER ARG inarg outarg
SAY ' '
SAY '* PrintDir/REXX 1.00, Copyright 1992 Brad Berson'
SAY '* The PMcomm .FON dialing directory printer'
SAY ' '
IF POS('?',inarg)>0 THEN DO
SAY 'Invocation: PRINTD [PMcomm.FON] [PMcomm.LST]'
SAY 'Switches: none'
SAY 'PrintDir dialogue will request info for items not included.'
EXIT
END
IF inarg>'' THEN
infile=inarg
ELSE DO
CALL CHAROUT ,'PMcomm FON file specification <'||infile||'>: '
pmans=LINEIN()
IF pmans>'' THEN infile=pmans
END
IF outarg>'' THEN
outfile=outarg
ELSE DO
CALL CHAROUT ,'Output listfile specification <'||outfile||'>: '
ofans=LINEIN()
IF ofans>'' THEN outfile=ofans
END
IF RIGHT(infile,1)='\' THEN infile=infile||'PMCOMM'
IF RIGHT(outfile,1)='\' THEN outfile=outfile||'PMCOMM'
IF POS('.',infile,LENGTH(infile)-3)=0 THEN infile=infile||'.FON'
IF POS('.',outfile,LENGTH(outfile)-3)=0 THEN outfile=outfile||'.LST'
/* Open PMCOMM.FON and get size) */
pmstate=STREAM(infile,'c','open read')
IF pmstate<>'READY:' THEN DO
SAY 'Failed to open 'infile'... 'pmstate
EXIT
END
pmlength=STREAM(infile,'c','query size')
pmrecs=pmlength/pmreclen-1
/* Open PMCOMM.LST, scratch if exists */
lfstate=STREAM(outfile,'c','open write')
IF lfstate<>'READY:' THEN DO
SAY 'Failed to open 'outfile'... 'lfstate
EXIT
END
lfstate=STREAM(outfile,'c','seek =1')
SAY 'Creating 'outfile' from 'infile'...'
/* Get records and do translations */
DO recnum=1 TO pmrecs BY 1
IF totitems=maxlines THEN DO
CALL LFHD
totitems=0
END
totitems=totitems+1
pmrecord=CHARIN(infile,,pmreclen)
CALL CHAROUT ,cr||'Processing record '||recnum
CALL BRPM
SELECT
WHEN protocol=0 THEN protocol='-unset-'
WHEN protocol=1 THEN protocol='Xmdm+Chk'
WHEN protocol=2 THEN protocol='Xmdm+CRC'
WHEN protocol=3 THEN protocol='Xmdm+1K'
WHEN protocol=4 THEN protocol='Ymdm+Bat'
WHEN protocol=5 THEN protocol='Ymdm+G'
WHEN protocol=234 THEN protocol='Xmdm-Chk'
WHEN protocol=233 THEN protocol='Xmdm-CRC'
WHEN protocol=228 THEN protocol='Xmdm-1K'
WHEN protocol=232 THEN protocol='Ymdm-Bat'
WHEN protocol=230 THEN protocol='Ymdm-G'
WHEN protocol=150 THEN protocol='CIS-B'
WHEN protocol=221 THEN protocol='IND$FILE'
WHEN protocol=222 THEN protocol='Kermit'
WHEN protocol=231 THEN protocol='Zmodem'
WHEN protocol=711 THEN protocol='ASCII'
OTHERWISE protocol=protocol||'?'
END
SELECT
WHEN termtype=0 THEN termtype='unset'
WHEN termtype=162 THEN termtype='TTY'
WHEN termtype=174 THEN termtype='ANSI'
WHEN termtype=161 THEN termtype='VT100'
WHEN termtype=145 THEN termtype='VT220'
OTHERWISE termtype=termtype||'?'
END
laston=CTIME(laston)
CALL PRLI
recsdone=recsdone+1
END
lfrecord=COPIES('=',132)||crlf
lfstate=CHAROUT(outfile,lfrecord)
lfrecord=' Total entries: '||recsdone||crlf
lfstate=CHAROUT(outfile,lfrecord)
lfrecord=COPIES('=',132)||crlf
lfstate=CHAROUT(outfile,lfrecord)
/* Close files and do some begging */
pmstate=STREAM(infile,'c','close')
lfstate=STREAM(outfile,'c','close')
CALL CHAROUT ,cr'PRINTD complete, 'recsdone' entries processed.'crlf
SAY ' '
SAY "If you find this program useful, consider the author's"
SAY 'time and effort and pay for this quality Shareware.'
SAY ' '
SAY 'Brad Berson, ABC-TV, 47 W. 66th St., NY NY 10023'
EXIP:
EXIT
/* Subroutine to print entries to LST file */
PRLI:
IF autosel=0 THEN
selind=' '
ELSE
selind='* '
lfrecord=selind||,
RPD(name,22)||,
RST(number,22)||,
RST(STRIP(baud),8)||,
LEFT(parity,1)||'-'||,
datab||'-'||,
RPD(stopb,3)||,
RPD(protocol,10)||,
RPD(termtype,7)||,
RST(timeson,6)||,
RPD(laston,10)||,
RST(filesdl,6)||,
RST(cpsdl,7)||,
RST(filesul,6)||,
RST(cpsul,7)||,
script||,
crlf
lfstate=CHAROUT(outfile,lfrecord)
RETURN
/* Subroutine to break PMcomm records into fields */
BRPM:
name=C2R(SUBSTR(pmrecord,1,21))
number=C2R(SUBSTR(pmrecord,22,21))
baud=C2R(SUBSTR(pmrecord,43,7))
parity=C2R(SUBSTR(pmrecord,50,5))
datab=C2R(SUBSTR(pmrecord,55,2))
stopb=C2R(SUBSTR(pmrecord,57,2))
script=C2R(SUBSTR(pmrecord,59,13))
protocol=C2D(REVERSE(SUBSTR(pmrecord,72,2)),2)
laston=C2D(REVERSE(SUBSTR(pmrecord,78,4)),4)
cpsdl=C2D(REVERSE(SUBSTR(pmrecord,82,2)))
timeson=C2D(REVERSE(SUBSTR(pmrecord,84,2)))
filesdl=C2D(REVERSE(SUBSTR(pmrecord,86,2)))
filesul=C2D(REVERSE(SUBSTR(pmrecord,88,2)))
cpsul=C2D(REVERSE(SUBSTR(pmrecord,90,2)))
termtype=C2D(REVERSE(SUBSTR(pmrecord,92,2)))
autosel=C2D(REVERSE(SUBSTR(pmrecord,94,2)))
RETURN
/* Subroutine to print directory heading */
LFHD:
header='Contents of PMcomm directory file '||infile||,
': Created by PrintDir/REXX 1.0 Copyright 1992 Brad Berson'
lfrecord=COPIES('=',132)||crlf
lfstate=CHAROUT(outfile,lfrecord)
lfrecord=CENTER(header,132)||crlf
lfstate=CHAROUT(outfile,lfrecord)
lfrecord=COPIES('-',132)||crlf
lfstate=CHAROUT(outfile,lfrecord)
lfrecord=' Name '||,
'Number '||,
'Baud '||,
'P-D-S '||,
'Protocol '||,
'Emul '||,
'#Calls '||,
'Last on '||,
'D/Ls, CPS '||,
'U/Ls, CPS '||,
'Script name'||,
crlf
lfstate=CHAROUT(outfile,lfrecord)
lfrecord=COPIES('=',132)||crlf
lfstate=CHAROUT(outfile,lfrecord)
RETURN
/* Function to convert C string to raw string */
C2R: PROCEDURE
string=arg(1)
nulpos=POS('0'x,string)-1
string=SUBSTR(string,1,nulpos)
RETURN string
/* Function to right-pad character strings */
RPD: PROCEDURE
string=arg(1)
fsize=arg(2)
string=string||COPIES(' ',fsize-length(string))
RETURN string
/* Function to right-set(+2) character strings */
RST: PROCEDURE
string=arg(1)
fsize=arg(2)-2
string=COPIES(' ',fsize-length(string))||string||' '
RETURN string
/* Function returns two-place zero-padded string */
DPD: PROCEDURE
dpad=arg(1)
IF dpad < 10 THEN
dpad='0'||dpad
ELSE
dpad=''||dpad
RETURN dpad
/* Function to determine leap year or not */
GETLEAP: PROCEDURE
year=arg(1)
IF (year/4)=(year%4) THEN
leap=1
ELSE
leap=0
RETURN leap
/* Convert 'C' time value to a MM/DD/YY string */
CTIME: PROCEDURE EXPOSE mndays.
inpval=arg(1)
days=1 ; mnth=1 ; year=1970
inpval=inpval%86400
IF inpval < 5475 THEN DO
ctime=' '
RETURN ctime
END
leap=GETLEAP(year)
DO WHILE inpval > 365+leap
inpval=inpval-(365+leap)
year=year+1
leap=GETLEAP(year)
END
IF inpval > 31 THEN
DO mnth=2 TO 12 BY 1
tmnth=mnth+1
IF mndays.tmnth+leap >= inpval THEN LEAVE
END
days=inpval-mndays.mnth
IF mnth>2 THEN days=days-leap
days=format(days)
ctime=dpd(mnth)||'/'||dpd(days)||'/'||right(year,2)
RETURN ctime
/* Error handler */
ERRH:
SAY ' '
IF RC='RC' THEN
SAY 'REXX/2 ERROR in line 'sigl
ELSE
SAY 'REXX/2 ERROR 'rc' in line 'sigl': 'ERRORTEXT(rc)
SAY SOURCELINE(sigl)
SAY 'Condition: 'CONDITION('C')
SAY 'PROGRAM ABENDED.'
EXIT