home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 3 Comm / 03-Comm.zip / PMAC10.ZIP / QMTOPM.CMD < prev    next >
OS/2 REXX Batch file  |  1992-05-07  |  12KB  |  379 lines
  1. /*---------------------------------------------------------------
  2.  
  3.   Program:    QMTOPM.CMD
  4.   Op Sys:     OS/2 1.3
  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.   QMtoPM  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 QMTOPM.DOC.  Modified versions may not
  18.   be distributed without written permission from author.
  19.   Evaluation is free.  If you use the output of QMtoPM and
  20.   are satisfied that it has performed the best it could
  21.   within the limitations enforced by Qmodem and PMcomm, you
  22.   should consider sending a Shareware donation amount of $10
  23.   (or more!) to:  Brad Berson, #2 Chaparral Road, Chestnut
  24.   Ridge, New York 10977.
  25.  
  26.   Technical support available via CIS:[71631,132] or USPS.
  27.  
  28.   This program converts dialing directory files (*.FON)
  29.   from Forbin Project / Mustang's Qmodem 4.3 to Multi-Net's
  30.   PMcomm version 1.09/1.10.  Eases migration from DOS to
  31.   OS/2.  See accompanying QMTOPM.DOC for more info.
  32.  
  33.   Invocation:  QMTOPM [Qmodem.FON] [PMcomm.FON] [switches]
  34.   Switches:    [Y|N][T|B][A|O] in any order, no spaces.
  35.   QMtoPM Dialogue will request info for items not included.
  36.  
  37. -----------------------------------------------------------------
  38.  
  39.          Qmodem          File formats          PMcomm
  40.  
  41.       name        c28   1                name        c21   1
  42.       fill        c2    29               number      c21   22
  43.       number      c20   31               baud        c7    43
  44.       fill        c2    51               parity      c5    50
  45.       datab       int   53               datab       c2    55
  46.       stopb       int   55               stopb       c2    57
  47.       parity      c1    57               script      c13   59
  48.       script      c13   58               protocol    int   72
  49.       laston      uint  71               prefix      int   74
  50.       timeson     long  80               suffix      int   76
  51.       fill        c2    84               laston      long  78
  52.       protocol    c1    86               cpsdl       int   82
  53.       echo        c1    87               timeson     int   84
  54.       password    c15   88               filesdl     int   86
  55.       entrynum    int   103              filesul     int   88
  56.       marked      c1    105              cpsul       int   90
  57.       emulation   c1    106              termtype    int   92
  58.       learntag    c1    107              autosel     int   94
  59.       notenum     int   108              fill        c27   96
  60.       hasnote     c1    110
  61.       noprefix    c1    111    String field formats:
  62.       baud        long  112    Qmodem: len byte + nul-padded str
  63.       fill        c3    116    PMcomm: null-terminated string
  64.  
  65. ---------------------------------------------------------------*/
  66.  
  67. bl='07'x
  68. cr='0d'x
  69. lf='0a'x
  70. nul='0'x
  71. crlf=cr||lf
  72. pmrecnum=0
  73. recsdone=0
  74. qmreclen=118
  75. pmreclen=122
  76. maxlines=1000
  77. totitems=maxlines
  78. infile='QMODEM.FON'
  79. outfile='PMCOMM.FON'
  80. lstfile='PMCOMM.PWD'
  81. SIGNAL ON HALT NAME ERRH
  82. SIGNAL ON ERROR NAME ERRH
  83. SIGNAL ON SYNTAX NAME ERRH
  84. PARSE UPPER ARG qmarg pmarg switches
  85.  
  86. SAY ' '
  87. SAY '* QMtoPM/REXX 1.00, Copyright 1992 Brad Berson'
  88. SAY '* The Qmodem to PMcomm .FON file converter'
  89. SAY ' '
  90.  
  91. IF POS('?',qmarg)>0 THEN DO
  92.   SAY 'Invocation:  QMTOPM [Qmodem.FON] [PMcomm.FON] [switches]'
  93.   SAY 'Switches:    [Y|N][T|B][A|O] in any order, no spaces.'
  94.   SAY 'QMtoPM Dialogue will request info for items not included.'
  95.   SIGNAL EXIP
  96. END
  97.  
  98. IF qmarg>'' THEN
  99.   infile=qmarg
  100. ELSE DO
  101.   CALL CHAROUT ,'Qmodem FON file specification <'||infile||'>: '
  102.   qmans=LINEIN()
  103.   IF qmans>'' THEN infile=qmans
  104. END
  105.  
  106. IF pmarg>'' THEN
  107.   outfile=pmarg
  108. ELSE DO
  109.   CALL CHAROUT ,'PMcomm FON file specification <'||outfile||'>: '
  110.   pmans=LINEIN()
  111.   IF pmans>'' THEN outfile=pmans
  112. END
  113.  
  114. IF POS('Y',switches)=0 & POS('N',switches)=0 THEN DO
  115.   DO FOREVER
  116.     CALL CHAROUT ,'Create a password list PMCOMM.PWD from QMODEM.FON? <Y/N> '
  117.     pwans=TRANSLATE(LINEIN())
  118.     IF pwans='Y' | pwans='N' THEN DO
  119.       LEAVE
  120.     END
  121.   END
  122. END
  123.  
  124. IF POS('T',switches)=0 & POS('B',switches)=0 THEN DO
  125.   DO FOREVER
  126.     CALL CHAROUT ,'<T>ranslate script names to *.CMD or leave them <B>lank? '
  127.     xlans=TRANSLATE(LINEIN())
  128.     IF xlans='T' | xlans='B' THEN DO
  129.       LEAVE
  130.     END
  131.   END
  132. END
  133.  
  134. IF POS('A',switches)=0 & POS('O',switches)=0 THEN DO
  135.   DO FOREVER
  136.     CALL CHAROUT ,'<A>ppend new records to PMCOMM.FON or <O>ver-write file? '
  137.     aoans=TRANSLATE(LINEIN())
  138.     IF aoans='A' | aoans='O' THEN DO
  139.       LEAVE
  140.     END
  141.   END
  142. END
  143.  
  144. IF switches>'' THEN DO
  145.   IF POS('Y',switches)>0 THEN pwans='Y'
  146.   IF POS('N',switches)>0 THEN pwans='N'
  147.   IF POS('T',switches)>0 THEN xlans='T'
  148.   IF POS('B',switches)>0 THEN xlans='B'
  149.   IF POS('A',switches)>0 THEN aoans='A'
  150.   IF POS('O',switches)>0 THEN aoans='O'
  151. END
  152.  
  153. IF RIGHT(infile,1)='\' THEN infile=infile||'QMODEM'
  154. IF RIGHT(outfile,1)='\' THEN outfile=outfile||'PMCOMM'
  155. IF POS('.',infile,LENGTH(infile)-3)=0 THEN infile=infile||'.FON'
  156. IF POS('.',outfile,LENGTH(outfile)-3)=0 THEN outfile=outfile||'.FON'
  157.  
  158. SAY 'Creating 'outfile' from 'infile'...'
  159.  
  160. qmstub=LEFT(infile,LASTPOS('.',infile)-1)
  161. pmstub=LEFT(outfile,LASTPOS('.',outfile)-1)
  162.  
  163. qmstate=STREAM(infile,'c','open read')
  164. IF qmstate<>'READY:' THEN DO
  165.   SAY 'Failed to open 'infile'... 'qmstate
  166.   EXIT
  167. END
  168. qmlength=STREAM(infile,'c','query size')
  169. qmrecs=qmlength/qmreclen
  170.  
  171. pmstate=STREAM(outfile,'c','open write')
  172. IF pmstate<>'READY:' THEN DO
  173.   SAY 'Failed to open 'outfile'... 'pmstate
  174.   EXIT
  175. END
  176. pmlength=STREAM(outfile,'c','query size')
  177. IF pmlength > 0 THEN pmrecnum=pmlength/pmreclen-1
  178. IF aoans='O' THEN DO
  179.   pmstate=STREAM(outfile,'c','seek =1')
  180.   pmrecnum=0 ; END
  181. ELSE DO
  182.   pmstate=STREAM(outfile,'c','seek <'pmreclen)
  183. END
  184.  
  185. IF pwans='Y' THEN DO
  186.   lstfile=pmstub||'.PWD'
  187.   lfstate=STREAM(lstfile,'c','open write')
  188.   IF lfstate<>'READY:' THEN DO
  189.     SAY 'Failed to open 'lstfile'... 'lfstate
  190.     EXIT
  191.   END
  192. END
  193.  
  194. DO recnum=1 TO qmrecs BY 1
  195.   qmrecord=CHARIN(infile,,qmreclen)
  196.   IF LEFT(qmrecord,1) > nul THEN DO  /* skip empty entries */
  197.     CALL CHAROUT ,cr||'Processing record '||recnum
  198.     CALL BRQM
  199.     pmcpsdl=D2C(0,2)  /* nulls into non-xlatable fields */
  200.     pmcpsul=D2C(0,2)
  201.     pmfilesdl=D2C(0,2)
  202.     pmfilesul=D2C(0,2)
  203.     pmautosel=D2C(0,2)
  204.     pmprefix=REVERSE(D2C(1,2))
  205.     pmsuffix=REVERSE(D2C(1,2))
  206.     pmname=R2CS(qmname,21)
  207.     pmnumber=R2CS(qmnumber,21)
  208.     pmdatab=R2CS(qmdatab,2)
  209.     pmstopb=R2CS(qmstopb,2)
  210.     pmbaud=R2CS(qmbaud,7)
  211.     pmtimeson=REVERSE(D2C(qmtimeson,2))
  212.     pmtermtype=REVERSE(D2C(174,2))  /* ANSI */
  213.     pmfill=COPIES(nul,27)
  214.     SELECT
  215.       WHEN qmparity='N' THEN pmparity=R2CS('None',5)
  216.       WHEN qmparity='E' THEN pmparity=R2CS('Even',5)
  217.       WHEN qmparity='O' THEN pmparity=R2CS('Odd',5)
  218.       WHEN qmparity='M' THEN pmparity=R2CS('Mark',5)
  219.       WHEN qmparity='S' THEN pmparity=R2CS('Spac',5)
  220.       OTHERWISE pmparity=R2CS('None',5)
  221.     END
  222.     SELECT
  223.       WHEN qmprotocol='X' THEN pmprotocol=REVERSE(D2C(234,2))
  224.       WHEN qmprotocol='R' THEN pmprotocol=REVERSE(D2C(234,2))
  225.       WHEN qmprotocol='C' THEN pmprotocol=REVERSE(D2C(233,2))
  226.       WHEN qmprotocol='O' THEN pmprotocol=REVERSE(D2C(228,2))
  227.       WHEN qmprotocol='Y' THEN pmprotocol=REVERSE(D2C(232,2))
  228.       WHEN qmprotocol='G' THEN pmprotocol=REVERSE(D2C(230,2))
  229.       WHEN qmprotocol='B' THEN pmprotocol=REVERSE(D2C(150,2))
  230.       WHEN qmprotocol='K' THEN pmprotocol=REVERSE(D2C(222,2))
  231.       WHEN qmprotocol='Z' THEN pmprotocol=REVERSE(D2C(231,2))
  232.       WHEN qmprotocol='A' THEN pmprotocol=REVERSE(D2C(711,2))
  233.       OTHERWISE pmprotocol=REVERSE(D2C(234,2))  /* Xmodem if ? */
  234.     END
  235.     IF POS('.',qmscript)>0 & xlans='T' THEN DO
  236.       dotpos=POS('.',qmscript)
  237.       pmscript=R2CS(LEFT(qmscript,dotpos)||'CMD',13) ; END
  238.     ELSE DO
  239.       pmscript=COPIES(nul,13)
  240.     END
  241.     IF qmlaston<29200 | qmlaston=65535 THEN
  242.       pmlaston=REVERSE(D2C(0,4))
  243.     ELSE DO
  244.       laston=qmlaston-25566
  245.       tmplaston=FORMAT(laston*86400,9)
  246.       pmlaston=REVERSE(D2C(tmplaston,4))
  247.     END
  248.     CALL PUPM
  249.     IF pwans='Y' THEN CALL PRLI
  250.     pmrecnum=pmrecnum+1
  251.     recsdone=recsdone+1
  252.   END
  253. END
  254. pmrecord=COPIES(nul,pmreclen)  /* end with blank record */
  255. pmstate=CHAROUT(outfile,pmrecord)
  256.  
  257. qmstate=STREAM(infile,'c','close')
  258. pmstate=STREAM(outfile,'c','close')
  259. IF pwans='Y' THEN DO
  260.   lfrecord=COPIES('=',75)||crlf
  261.   lfstate=CHAROUT(lstfile,lfrecord)
  262.   lfrecord='EOF'crlf
  263.   lfstate=CHAROUT(lstfile,lfrecord)
  264.   lfrecord=COPIES('=',75)||crlf
  265.   lfstate=CHAROUT(lstfile,lfrecord)
  266.   lfstate=STREAM(lstfile,'c','close')
  267. END
  268.  
  269. CALL CHAROUT ,cr||qmrecs' entries processed; '
  270. CALL CHAROUT ,recsdone' entries converted.'crlf
  271. SAY 'PMcomm directory now has 'pmrecnum' entries.'
  272. SAY ' '
  273. SAY 'If this program saved you hours of tedium while'
  274. SAY "making the switch to OS/2, consider the author's"
  275. SAY 'time and effort and pay for this quality Shareware.'
  276. SAY ' '
  277. SAY 'Brad Berson, ABC-TV, 47 W. 66th St., NY NY 10023'
  278. EXIP:
  279. EXIT
  280.  
  281. /* Subroutine to break Qmodem records into fields */
  282. BRQM:
  283.   qmname=TP2R(SUBSTR(qmrecord,1,28))
  284.   qmnumber=TP2R(SUBSTR(qmrecord,31,20))
  285.   qmdatab=C2D(REVERSE(SUBSTR(qmrecord,53,2)),2)
  286.   qmstopb=C2D(REVERSE(SUBSTR(qmrecord,55,2)),2)
  287.   qmparity=SUBSTR(qmrecord,57,1)
  288.   qmscript=TP2R(SUBSTR(qmrecord,58,13))
  289.   qmlaston=C2D(REVERSE(SUBSTR(qmrecord,71,2)))
  290.   qmtimeson=C2D(REVERSE(SUBSTR(qmrecord,80,4)),4)
  291.   qmprotocol=SUBSTR(qmrecord,86,1)
  292.   qmpword=TP2R(SUBSTR(qmrecord,88,15))
  293.   qmnotenum=C2D(REVERSE(SUBSTR(qmrecord,108,2)),2)
  294.   qmbaud=C2D(REVERSE(SUBSTR(qmrecord,112,4)),4)
  295.   RETURN
  296.  
  297. /* Subroutine to write PMcomm records from fields */
  298. PUPM:
  299.   pmrecord=pmname||pmnumber||pmbaud||pmparity||pmdatab||pmstopb||,
  300.            pmscript||pmprotocol||pmprefix||pmsuffix||pmlaston||,
  301.            pmcpsdl||pmtimeson||pmfilesdl||pmfilesul||pmcpsul||,
  302.            pmtermtype||pmautosel||pmfill
  303.   pmstate=CHAROUT(outfile,pmrecord)
  304.   RETURN
  305.  
  306. /* Subroutine to print entries to LST file */
  307. PRLI:
  308.   notefile=STREAM(qmstub||'.'||qmnotenum,'c','query exists')
  309.   IF qmpword>' ' | notefile>' ' THEN DO
  310.     IF totitems=maxlines THEN DO
  311.       CALL LFHD
  312.       totitems=0
  313.     END
  314.     totitems=totitems+1
  315.     lfrecord=pmname||COPIES('.',20-LENGTH(qmpword))||qmpword
  316.     IF notefile>' ' THEN DO
  317.       lfrecord=lfrecord||COPIES(' ',45-LENGTH(lfrecord))||notefile
  318.     END
  319.     lfstate=CHAROUT(lstfile,lfrecord||crlf)
  320.   END
  321.   RETURN
  322.  
  323. /* Subroutine to print password file heading */
  324. LFHD:
  325.   header='Passwords & notefiles for '||outfile||,
  326.   ': QMtoPM/REXX (C) 1992 Brad Berson'
  327.   lfrecord=COPIES('=',75)||crlf
  328.   lfstate=CHAROUT(lstfile,lfrecord)
  329.   lfrecord=CENTER(header,75)||crlf
  330.   lfstate=CHAROUT(lstfile,lfrecord)
  331.   lfrecord=COPIES('-',75)||crlf
  332.   lfstate=CHAROUT(lstfile,lfrecord)
  333.   lfrecord='  Entry name               '||,
  334.            'Password          '||,
  335.            'Notefile name'||,
  336.            crlf
  337.   lfstate=CHAROUT(lstfile,lfrecord)
  338.   lfrecord=COPIES('=',75)||crlf
  339.   lfstate=CHAROUT(lstfile,lfrecord)
  340.   RETURN
  341.  
  342. /* Function to convert TPASCAL string to raw string */
  343. TP2R: PROCEDURE
  344.   string=arg(1)
  345.   lenbyte=C2D(SUBSTR(string,1,1))
  346.   IF lenbyte > 0 THEN
  347.     string=STRIP(SUBSTR(string,2,lenbyte))
  348.   ELSE
  349.     string=''
  350.   RETURN string
  351.  
  352. /* Function to convert raw string to C string */
  353. R2CS: PROCEDURE
  354.   string=arg(1)
  355.   strlen=arg(2)
  356.   string=LEFT(string,strlen-1)
  357.   string=SUBSTR(string,1,strlen,'0'x)
  358.   RETURN string
  359.  
  360. /* Function to convert TPASCAL string to C string */
  361. TP2C: PROCEDURE
  362.   string=arg(1)
  363.   strlen=arg(2)
  364.   string=R2CS(TP2R(string),strlen)
  365.   RETURN string
  366.  
  367. /* Error handler */
  368. ERRH:
  369.   SAY ' '
  370.   IF RC='RC' THEN
  371.     SAY 'REXX/2 ERROR in line 'sigl
  372.   ELSE
  373.     SAY 'REXX/2 ERROR 'rc' in line 'sigl': 'ERRORTEXT(rc)
  374.   SAY SOURCELINE(sigl)
  375.   SAY 'Condition: 'CONDITION('C')
  376.   SAY 'PROGRAM ABENDED.'
  377.   EXIT
  378.  
  379.