home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / cmd_.zip / $.CMD next >
OS/2 REXX Batch file  |  1993-03-12  |  69KB  |  2,129 lines
  1. /**
  2. *** ╔════════════════════════════════════════════════════════════════════╗
  3. *** ║                                                                    ║
  4. *** ║  $.CMD - version 2.05                                              ║
  5. *** ║                                                                    ║
  6. *** ║ ────────────────────────────────────────────────────────────────── ║
  7. *** ║                                                                    ║
  8. *** ║ This is a collection of small execs put into one place to keep the ║
  9. *** ║ directory clutter down a little bit.  It also allows for local-    ║
  10. *** ║ ization of global variables and the reuse of general purpose       ║
  11. *** ║ routines.                                                          ║
  12. *** ║                                                                    ║
  13. *** ║ Many of the routines listed here are intended to be run while      ║
  14. *** ║ there is no other activities on the machine.  As such, these       ║
  15. *** ║ routines also serve as a free suppliment to the product Chron      ║
  16. *** ║ currently marketed by Hilbert Computing.                           ║
  17. *** ║                                                                    ║
  18. *** ║ This can also serve as a working example of several REXX program-  ║
  19. *** ║ ming techniques.                                                   ║
  20. *** ║                                                                    ║
  21. *** ║ ────────────────────────────────────────────────────────────────── ║
  22. *** ║                                                                    ║
  23. *** ║ This code is provided on an as-is basis.  There is no warranty     ║
  24. *** ║ expressed or implied in the code.  There is no official support    ║
  25. *** ║ for this code.  However, you are welcome to contact Hilbert        ║
  26. *** ║ Computing for questions or comments on the code.  If you make your ║
  27. *** ║ own changes to the code and wish to upload the modified code to    ║
  28. *** ║ a public forum, please note your modifications to the code.        ║
  29. *** ║                                                                    ║
  30. *** ║ Many of the routines require the REXX suppliment DLLs found in     ║
  31. *** ║ OS/2 v2.0 and later.                                               ║
  32. *** ║                                                                    ║
  33. *** ║ I can be reached at:                                               ║
  34. *** ║                                                                    ║
  35. *** ║              Gary Murphy, Sr. Programmer                           ║
  36. *** ║              Hilbert Computing                                     ║
  37. *** ║              1022 N. Cooper                                        ║
  38. *** ║              Olathe, KS 66061                                      ║
  39. *** ║                                                                    ║
  40. *** ║              BBS...... (913) 829-2450 8N1 9600                     ║
  41. *** ║              CIS...... [73457,365]                                 ║
  42. *** ║              Prodigy.. VWSD07A                                     ║
  43. *** ║                                                                    ║
  44. *** ║ ────────────────────────────────────────────────────────────────── ║
  45. *** ║                                                                    ║
  46. *** ║            Copyright (c) 1992, 1993  Hilbert Computing             ║
  47. *** ║                                                                    ║
  48. *** ╚════════════════════════════════════════════════════════════════════╝
  49. **/
  50.  
  51.  
  52. /* Global variables */
  53.  
  54. machine = value("MACHINE", , "OS2ENVIRONMENT")
  55. parse upper var machine machine .
  56.  
  57. select
  58.    when machine = '8590-0H9' then
  59.       do
  60.       Dir.              = ''
  61.       Dir.Awk           = 'd:\awk'           /* AWK code                          */
  62.       Dir.Backup        = 'd:\backup'        /* Backups of critical files         */
  63.       Dir.BC            = 'n/a'              /* Borland C++ for OS/2              */
  64.       Dir.BCSource      = 'n/a'              /* Source code for B C++ programs    */
  65.       Dir.BCToolkit     = 'n/a'              /* Borland include files             */
  66.       Dir.Boot          = 'c:\'              /* Root of the boot drive            */
  67.       Dir.CommPass      = 'n/a'              /* Directory for Golden CommPass(tm) */
  68.       Dir.IBMC          = 'd:\ibmc'          /* IBM C Set/2                       */
  69.       Dir.IBMCSource    = 'd:\ibmc\source'   /* Source code for IBM C programs    */
  70.       Dir.IBMCPP        = 'd:\ibmcpp'        /* IBM C Set/2                       */
  71.       Dir.IBMCPPSource  = 'd:\ibmc\source'   /* Source code for IBM C programs    */
  72.       Dir.IBMWF         = 'd:\ibmwf'         /* IBM WorkFrame/2                   */
  73.       Dir.Maximus       = 'n/a'              /* Maximus BBS code.                 */
  74.       Dir.MSC           = 'd:\msc'           /* Microsoft C 6.0                   */
  75.       Dir.MSCSource     = 'd:\msc\source'    /* Source code for MS C programs     */
  76.       Dir.ProdCmd       = 'd:\products\cmd'  /* Shareware command files           */
  77.       Dir.ProdDat       = 'd:\products\data' /* Shareware data files              */
  78.       Dir.ProdDll       = 'd:\products\dll'  /* Shareware datalink libraries      */
  79.       Dir.Products      = 'd:\products'      /* Shareware executable directory    */
  80.       Dir.Rexx          = 'd:\rexx'          /* REXX code and Kedit macros        */
  81.       Dir.Server        = 'm:\os2nfs\backup' /* Directory for server backup       */
  82.       Dir.SprintMail    = 'd:\sprmail'       /* Directory for SprintMail          */
  83.       Dir.Temp          = 'd:\temp'          /* Temporary work directory          */
  84.       Dir.Toolkit13     = 'd:\toolkt13'      /* IBM Tools and Info for OS/2 v1.3  */
  85.       Dir.Toolkit20     = 'd:\toolkt20'      /* IBM Tools and Info for OS/2 v2.0  */
  86.       Dir.Unix          = 'd:\unix'          /* UNIX ports from GNU               */
  87.       Dir.VDisk         = 'e:\'              /* Virtual disk                      */
  88.       end
  89.    when machine = 'HILBERT' then
  90.       do
  91.       Dir.              = ''
  92.       Dir.Awk           = 'd:\awk'           /* AWK code                          */
  93.       Dir.Backup        = 'd:\backup'        /* Backups of critical files         */
  94.       Dir.BC            = 'd:\bc'            /* Borland C++ for OS/2              */
  95.       Dir.BCSource      = 'd:\bc\source'     /* Source code for B C++ programs    */
  96.       Dir.BCToolkit     = 'd:\topaz'         /* Borland include files             */
  97.       Dir.Boot          = 'c:\'              /* Root of the boot drive            */
  98.       Dir.CommPass      = 'd:\commpass'      /* Directory for Golden CommPass(tm) */
  99.       Dir.IBMC          = 'd:\ibmc'          /* IBM C Set/2                       */
  100.       Dir.IBMCSource    = 'd:\ibmc\source'   /* Source code for IBM C programs    */
  101.       Dir.IBMCPP        = 'd:\ibmcpp'        /* IBM C Set/2                       */
  102.       Dir.IBMCPPSource  = 'd:\ibmc\source'   /* Source code for IBM C programs    */
  103.       Dir.IBMWF         = 'd:\ibmwf'         /* IBM WorkFrame/2                   */
  104.       Dir.Maximus       = 'd:\maximus'       /* Maximus BBS code.                 */
  105.       Dir.MSC           = 'd:\msc'           /* Microsoft C 6.0                   */
  106.       Dir.MSCSource     = 'd:\msc\source'    /* Source code for MS C programs     */
  107.       Dir.ProdCmd       = 'd:\products\cmd'  /* Shareware command files           */
  108.       Dir.ProdDat       = 'd:\products\data' /* Shareware data files              */
  109.       Dir.ProdDll       = 'd:\products\dll'  /* Shareware datalink libraries      */
  110.       Dir.Products      = 'd:\products'      /* Shareware executable directory    */
  111.       Dir.Rexx          = 'd:\rexx'          /* REXX code and Kedit macros        */
  112.       Dir.Server        = 'n/a'              /* Directory for server backup       */
  113.       Dir.SprintMail    = 'n/a'              /* Directory for SprintMail          */
  114.       Dir.Temp          = 'd:\temp'          /* Temporary work directory          */
  115.       Dir.Toolkit13     = 'd:\toolkt13'      /* IBM Tools and Info for OS/2 v1.3  */
  116.       Dir.Toolkit20     = 'd:\toolkt20'      /* IBM Tools and Info for OS/2 v2.0  */
  117.       Dir.Unix          = 'd:\unix'          /* UNIX ports from GNU               */
  118.       Dir.VDisk         = 'g:\'              /* Virtual disk */
  119.       end
  120.    when machine = 'LPAR' then
  121.       do
  122.       Dir.              = ''
  123.       Dir.Awk           = 'd:\awk'           /* AWK code                          */
  124.       Dir.Backup        = 'd:\backup'        /* Backups of critical files         */
  125.       Dir.BC            = 'd:\bc'            /* Borland C++ for OS/2              */
  126.       Dir.BCSource      = 'd:\bc\source'     /* Source code for B C++ programs    */
  127.       Dir.BCToolkit     = 'd:\topaz'         /* Borland include files             */
  128.       Dir.Boot          = 'c:\'              /* Root of the boot drive            */
  129.       Dir.CommPass      = 'd:\commpass'      /* Directory for Golden CommPass(tm) */
  130.       Dir.IBMC          = 'd:\ibmc'          /* IBM C Set/2                       */
  131.       Dir.IBMCSource    = 'd:\ibmc\source'   /* Source code for IBM C programs    */
  132.       Dir.IBMCPP        = 'd:\ibmcpp'        /* IBM C Set/2                       */
  133.       Dir.IBMCPPSource  = 'd:\ibmc\source'   /* Source code for IBM C programs    */
  134.       Dir.IBMWF         = 'd:\ibmwf'         /* IBM WorkFrame/2                   */
  135.       Dir.Maximus       = 'd:\maximus'       /* Maximus BBS code.                 */
  136.       Dir.MSC           = 'd:\msc'           /* Microsoft C 6.0                   */
  137.       Dir.MSCSource     = 'd:\msc\source'    /* Source code for MS C programs     */
  138.       Dir.ProdCmd       = 'd:\products\cmd'  /* Shareware command files           */
  139.       Dir.ProdDat       = 'd:\products\data' /* Shareware data files              */
  140.       Dir.ProdDll       = 'd:\products\dll'  /* Shareware datalink libraries      */
  141.       Dir.Products      = 'd:\products'      /* Shareware executable directory    */
  142.       Dir.Rexx          = 'd:\rexx'          /* REXX code and Kedit macros        */
  143.       Dir.Server        = 'n/a'              /* Directory for server backup       */
  144.       Dir.SprintMail    = 'n/a'              /* Directory for SprintMail          */
  145.       Dir.Temp          = 'd:\temp'          /* Temporary work directory          */
  146.       Dir.Toolkit13     = 'd:\toolkt13'      /* IBM Tools and Info for OS/2 v1.3  */
  147.       Dir.Toolkit20     = 'd:\toolkt20'      /* IBM Tools and Info for OS/2 v2.0  */
  148.       Dir.Unix          = 'd:\unix'          /* UNIX ports from GNU               */
  149.       Dir.VDisk         = 'g:\'              /* Virtual disk */
  150.       end
  151.    otherwise
  152.       do
  153.       say 'Your MACHINE environment variable is not set or is not recognized.'
  154.       exit
  155.       end
  156. end /* select */
  157.  
  158. File.             = ''
  159. File.Max.Log      = 'maxaccum.log'
  160. File.BBS          = 'files.bbs'
  161. File.Temp.1       = Dir.Temp'\temp.1'
  162. File.Temp.2       = Dir.Temp'\temp.2'
  163. File.Temp.3       = Dir.Temp'\temp.3'
  164. File.Temp.ChkDsk  = Dir.Temp'\chkdsk.out'
  165. File.Temp.Space   = Dir.Temp'\space.out'
  166. File.Temp.Changed = Dir.Temp'\changed.out'
  167. File.Temp.Maxdl   = Dir.Temp'\maxdl.out'
  168. File.Temp.Offsite = Dir.Temp'\offsite.out'
  169.  
  170. Pgm.              = ''
  171. Pgm.Zip           = Dir.Unix'\zip.exe'
  172. Pgm.UnZip         = Dir.Unix'\unzip.exe'
  173. Pgm.Grep          = Dir.Unix'\grep.exe'
  174. Pgm.Editor        = Dir.Products'\kedit.exe'
  175. Pgm.CalcCrc       = Dir.Products'\calccrc.exe'
  176. Pgm.Awk           = Dir.Unix'\gawk.exe'
  177. Pgm.Tail          = Dir.Unix'\tail.exe'
  178. Pgm.Notify        = Dir.Products'\pmmessag.exe'
  179.  
  180. Grep.            = ''
  181. Grep.Options     = ''
  182. Grep.Re.LogKeep  = '"^[\+\=]"'
  183. Grep.Re.LogCall  = '"^\+.*calling ("'
  184.  
  185. Upm.             = ''
  186. Upm.Userid       = 'Hilbert'
  187. Upm.Password     = ''
  188.  
  189. /* Load the REXX DLL entry points */
  190.  
  191. call LoadFunctions
  192.  
  193. /* Parse the command */
  194.  
  195. parse arg cmd parms
  196. parse upper var cmd cmd
  197.  
  198. /* Save the current directory */
  199.  
  200. Dir.Current = directory()
  201. select
  202.    when abbrev('BACKUP'     ,cmd,  3) then call Backup        parms
  203.    when abbrev('BKUP'       ,cmd,  2) then call Backup        parms
  204.    when abbrev('CHANGED'    ,cmd,  3) then call Changed       parms
  205.    when abbrev('CHECK'      ,cmd,  3) then call Check         parms
  206.    when abbrev('CHK'        ,cmd,  3) then call Check         parms
  207.    when abbrev('CK'         ,cmd,  2) then call Check         parms
  208.    when abbrev('COPY'       ,cmd,  2) then call Copy          parms
  209.    when abbrev('CRC'        ,cmd,  2) then call CrcSum        parms
  210.    when abbrev('ENVIRONMENT',cmd,  3) then call Environment   parms
  211.    when abbrev('FIND'       ,cmd,  2) then call WhereIs       parms
  212.    when abbrev('INSTALL'    ,cmd,  1) then call Install       parms
  213.    when abbrev('LOADFUNC'   ,cmd,  3) then call LoadFunctions parms
  214.    when abbrev('LOADSYSTEM' ,cmd,  3) then call LoadFunctions parms
  215.    when abbrev('MAXIMUS'    ,cmd,  3) then call Maximus       parms
  216.    when abbrev('MIGRATE'    ,cmd,  3) then call Migrate       parms
  217.    when abbrev('PROFILE'    ,cmd,  2) then call Profile       parms
  218.    when abbrev('SPACE'      ,cmd,  2) then call Space         parms
  219.    when abbrev('TEST'       ,cmd,  2) then call Test          parms
  220.    when abbrev('WHEREIS'    ,cmd,  2) then call WhereIs       parms
  221.    when abbrev('VDISKLOAD'  ,cmd,  2) then call VDiskLoad     parms
  222.    when abbrev('REXXUNPACK' ,cmd,  2) then call RexxUnpack    parms
  223.    when abbrev('ZIP'        ,cmd,  1) then call Zip           parms
  224.    otherwise
  225.       say "Command '"cmd"' not recognized"
  226. end /* Select */
  227.  
  228. /* Return to the starting directory */
  229.  
  230. Dir.Current = directory(Dir.Current)
  231. exit
  232.  
  233.  
  234. /**
  235. *** ╔══════════════════════════════════════════════════════════════════════╗
  236. *** ║                    Command Processor Subroutines                     ║
  237. *** ╚══════════════════════════════════════════════════════════════════════╝
  238. **/
  239.  
  240. /**
  241. *** ┌──────────────────────────────────────────────────────────────────────┐
  242. *** │                            Zip Subroutines                           │
  243. *** └──────────────────────────────────────────────────────────────────────┘
  244. **/
  245.  
  246. Zip: procedure expose Pgm.
  247.    /**
  248.    ***  This will call a compression program to create a package in
  249.    ***  the correct directory.  It looks for a zip list file of with an
  250.    ***  extension of ".ZPL"
  251.    **/
  252.  
  253.  
  254.    parse arg ZipFile .
  255.  
  256.    /* If there wasn't a zip file passed, use the project environment  */
  257.    /* for the name.                                                   */
  258.  
  259.    if ZipFile = '' then
  260.       do
  261.       ZipFile = value("PROJECT", , "OS2ENVIRONMENT")
  262.       if ZipFile = '' then
  263.          do
  264.          say "Project environment variable not set."
  265.          return
  266.          end
  267.  
  268.       call directory('archive')
  269.       end
  270.  
  271.  
  272.    '@'Pgm.Zip '-o@' ZipFile'.zip  <' ZipFile'.zpl'
  273.    return
  274.  
  275. /**
  276. *** ┌──────────────────────────────────────────────────────────────────────┐
  277. *** │                           Copy Subroutines                           │
  278. *** └──────────────────────────────────────────────────────────────────────┘
  279. **/
  280.  
  281. Copy: procedure expose Pgm.
  282.    /**
  283.    ***  This will call a C routine to calculate the checksum and CRC
  284.    ***  values for a file.  It either stores the calculated values or compares
  285.    ***  the calculated value to the stored value.
  286.    **/
  287.  
  288.  
  289.    parse arg Src Dest .
  290.  
  291.    if Dest = '' then
  292.       Dest = "A:"
  293.  
  294.    call SysFileTree Src, 'Source', 'F'
  295.  
  296.    BytesCopied = 0
  297.    do i = 1 to Source.0
  298.       parse var Source.i . . BytesFile . FullSource
  299.  
  300.       /* Extract just the file name */
  301.  
  302.       PathEnd = lastpos('\',FullSource)
  303.       FullDest = Dest'\'substr(FullSource, (PathEnd+1))
  304.  
  305.       Retries = 0
  306.       do until (CheckOk = 1) | (Retries >= 3)
  307.          '@copy' FullSource FullDest '> nul'
  308.  
  309.          SrcCheckWord = CalculateCheckWord(FullSource)
  310.          DstCheckWord = CalculateCheckWord(FullDest)
  311.  
  312.          if SrcCheckWord = DstCheckWord then
  313.             do
  314.             CheckOk = 1
  315.             say FullSource
  316.             end
  317.          else
  318.             do
  319.             CheckOk = 0
  320.             Retries = Retries + 1
  321.             say 'Copy for' FullSource 'failed verification.  Retry #'Retries'.'
  322.             end
  323.       end /* do until */
  324.       if Retries >= 3 then
  325.          do
  326.          say "Too many failures.  Aborting..."
  327.          return
  328.          end
  329.       BytesCopied = BytesCopied + BytesFile
  330.    end
  331.    say '        'Source.0 'file(s) ['BytesCopied' bytes] copied.'
  332.    return
  333.  
  334.  
  335. /**
  336. *** ┌──────────────────────────────────────────────────────────────────────┐
  337. *** │                        VDISK Load Subroutines                        │
  338. *** └──────────────────────────────────────────────────────────────────────┘
  339. **/
  340.  
  341. VDiskLoad: procedure expose Dir.
  342.    /**
  343.    ***  This will load the virtual disks with the files for the optimal
  344.    ***  use of the RAM disk.
  345.    **/
  346.  
  347.    parse arg cmd parms
  348.    parse upper var cmd cmd
  349.  
  350.    select
  351.       when abbrev('IBMC'   ,cmd, 3)      then call VDiskLoadIBMC     parms
  352.       otherwise
  353.          say "Subcommand (VDISKLOAD): '"cmd"' not recognized"
  354.    end /* Select */
  355.    return
  356.  
  357.  
  358. VdiskLoadOptions: procedure expose VDiskOpt.
  359.    /**
  360.    ***  This will parse the VDiskLoad parameters and return them in an
  361.    ***  exposed stem variable.
  362.    **/
  363.  
  364.    arg options
  365.  
  366.    VDiskOpt.      = ''
  367.    VDiskOpt.H     = 1     /* Copy header files */
  368.    VDiskOpt.EXE   = 1     /* Copy EXE files */
  369.    VDiskOpt.IPMD  = 1     /* Copy debugger files */
  370.  
  371.    VDiskOpt.CLEAR = 1     /* Delete everything on the RAM disk */
  372.  
  373.    do i = 1 to words(options)
  374.       option = word(options, i)
  375.       parse upper var option option
  376.       select
  377.          when option = "H"         then VDiskOpt.H     = 1
  378.          when option = "NOH"       then VDiskOpt.H     = 0
  379.          when option = "EXE"       then VDiskOpt.EXE   = 1
  380.          when option = "NOEXE"     then VDiskOpt.EXE   = 0
  381.          when option = "DEBUG"     then VDiskOpt.IPMD  = 1
  382.          when option = "NODEBUG"   then VDiskOpt.IPMD  = 0
  383.          when option = "IPMD"      then VDiskOpt.IPMD  = 1
  384.          when option = "NOIPMD"    then VDiskOpt.IPMD  = 0
  385.          when option = "CLEAR"     then VDiskOpt.CLEAR = 1
  386.          when option = "DELETE"    then VDiskOpt.CLEAR = 1
  387.          when option = "REMOVE"    then VDiskOpt.CLEAR = 1
  388.          when option = "APPEND"    then VDiskOpt.CLEAR = 0
  389.          when option = "ALL"       then
  390.             do
  391.             VDiskOpt.IPMD  = 1
  392.             VDiskOpt.EXE   = 1
  393.             VDiskOpt.H     = 1
  394.             end
  395.          when option = "NONE"    then
  396.             do
  397.             VDiskOpt.IPMD  = 0
  398.             VDiskOpt.EXE   = 0
  399.             VDiskOpt.H     = 0
  400.             end
  401.          otherwise
  402.             say "Warning: Unrecognized option" option". It was ignored"
  403.       end /* select */
  404.    end
  405.    return
  406.  
  407.  
  408. VDiskLoadIBMC: procedure expose Dir.
  409.    /**
  410.    ***  This loads the compiler, etc to the virtual disk
  411.    **/
  412.  
  413.    parse arg parms
  414.  
  415.    /* Clear out the stuff that is there already */
  416.  
  417.    if "n/a" = Dir.VDisk then
  418.       return
  419.  
  420.    call VDiskLoadOptions parms
  421.  
  422.    if VDiskOpt.CLEAR then
  423.       "@rm" Dir.VDisk"*"
  424.  
  425.    /* Copy the files */
  426.  
  427.    if VDiskOpt.EXE then
  428.       do
  429.       "@xcopy" Dir.IBMC"\bin\dd*.exe"         Dir.VDisk
  430.       "@xcopy" Dir.IBMC"\bin\icc*.exe"        Dir.VDisk
  431.       end
  432.  
  433.    if VDiskOpt.H then
  434.       do
  435.       "@xcopy" Dir.Toolkit20"\c\os2h\pm*.h"   Dir.VDisk
  436.       "@xcopy" Dir.Toolkit20"\c\os2h\bse*.h"  Dir.VDisk
  437.       end
  438.  
  439.    if VDiskOpt.IPMD then
  440.       do
  441.       "@xcopy d:\ipmd3aw\ipmd*.exe"       Dir.VDisk
  442.       end
  443.    return
  444.  
  445. /**
  446. *** ┌──────────────────────────────────────────────────────────────────────┐
  447. *** │                     CRC and Checksum Subroutines                     │
  448. *** └──────────────────────────────────────────────────────────────────────┘
  449. **/
  450.  
  451. CrcSum: procedure
  452.    /**
  453.    ***  This will call a C routine to calculate the checksum and CRC
  454.    ***  values for a file.  It either stores the calculated values or compares
  455.    ***  the calculated value to the stored value.
  456.    **/
  457.  
  458.  
  459.    parse arg cmd parms
  460.    parse upper var cmd cmd
  461.  
  462.    select
  463.       when abbrev('ADD'   ,cmd,  1)      then call CrcSumAdd         parms
  464.       when abbrev('QUERY' ,cmd,  1)      then call CrcSumQuery       parms
  465.       when abbrev('GET'   ,cmd,  1)      then call CrcSumQuery       parms
  466.       when abbrev('CHECK' ,cmd,  1)      then call CrcSumCheck       parms
  467.       otherwise
  468.          say "Subcommand (PROFILE): '"cmd"' not recognized"
  469.    end /* Select */
  470.    return
  471.  
  472.  
  473. CrcSumQuery: procedure Expose Pgm.
  474.    /**
  475.    ***  This will display the calculated CRC and Checksum to the extended
  476.    ***  attributes
  477.    **/
  478.  
  479.    arg file options
  480.  
  481.    RCode = SysGetEA(file, "Checkword", "CheckWord")
  482.    if RCode = 0 then
  483.       do
  484.       if CheckWord = '' then
  485.          say "The check word for" file "doesn't exist."
  486.       else
  487.          say "The check word for" file "is" CheckWord"."
  488.       end
  489.    else
  490.       say "Return code" RCode "from EA query."
  491.    return CheckWord
  492.  
  493.  
  494. CrcSumAdd: procedure expose Pgm.
  495.    /**
  496.    ***  This will add the calculated CRC and Checksum to the extended
  497.    ***  attributes
  498.    **/
  499.  
  500.    arg file options
  501.    CheckWord = CalculateCheckWork(file)
  502.    call SysPutEA file, 'CheckWord', Checkword
  503.    return
  504.  
  505.  
  506. CrcSumCheck: procedure expose Pgm.
  507.    /**
  508.    ***  This will compare the calculated CRC and Checksum to the extended
  509.    ***  attributes
  510.    **/
  511.  
  512.    arg file options
  513.    CheckWordCalc = CalculateCheckWord(file)
  514.    call SysGetEA file, "Checkword", "CheckWordEA"
  515.  
  516.    if CheckWordCalc <> CheckWordEA then
  517.       if CheckWordEA = "" then
  518.          say "File" file "has a check word mismatch because there was no stored EA."
  519.       else
  520.          say "File" file "has a check word mismatch."
  521.    return
  522.  
  523.  
  524. CalculateCheckWord: procedure expose Pgm.
  525.    /**
  526.    ***  This will calculate the check word for the file passed.
  527.    **/
  528.  
  529.    arg file .
  530.  
  531.    '@'Pgm.CalcCrc file '| rxqueue'
  532.    if rc <> 0 then
  533.       do
  534.       do i = 1 to queued()
  535.          parse pull msg
  536.          say msg
  537.       end
  538.       return "0000:0000"
  539.       end
  540.  
  541.    pull . Crc . Sum
  542.    return right(Crc,4,'0')':'right(Sum,4,'0')
  543.  
  544.  
  545. /**
  546. *** ┌──────────────────────────────────────────────────────────────────────┐
  547. *** │                         Migrate Subroutines                          │
  548. *** └──────────────────────────────────────────────────────────────────────┘
  549. **/
  550.  
  551. Migrate: procedure expose File. Dir.
  552.    /**
  553.    ***  This will move the file from the working directory to the production
  554.    ***  directory based on the file name if passed.  If the filename is not
  555.    ***  passed, it will migrate by the current directory and the project
  556.    ***  environment variable
  557.    **/
  558.  
  559.    arg FileSpec
  560.    if FileSpec = '' then
  561.       call MigrateByDir
  562.    else
  563.       call MigrateByExt FileSpec
  564.    return
  565.  
  566.  
  567.  
  568. MigrateByDir: procedure expose File. Dir.
  569.    /**
  570.    ***  This will migrate the file from the development directory to the
  571.    ***  production directory based on the current path and the project
  572.    ***  variable.
  573.    **/
  574.  
  575.    Project = value("PROJECT", , "OS2ENVIRONMENT")
  576.    if Project = '' then
  577.       do
  578.       say "Project environment variable not set."
  579.       return
  580.       end
  581.  
  582.    Current = UpperCase(directory())
  583.    select
  584.       when Current = UpperCase(Dir.Rexx)       then Ext = 'CMD'
  585.       when Current = UpperCase(Dir.IBMCSource) then Ext = 'EXE'
  586.       when Current = UpperCase(Dir.MSCSource)  then Ext = 'EXE'
  587.       otherwise Ext = ''
  588.    end /* select */
  589.    call MigrateByExt Project'.'Ext
  590.    return
  591.  
  592.  
  593.  
  594. MigrateByExt: procedure expose File. Dir.
  595.    /**
  596.    ***  This will migrate the file from the development directory to the
  597.    ***  production directory based on the file extension.
  598.    **/
  599.  
  600.    arg FileSpec
  601.  
  602.    if verify(FileSpec, '\*?:', 'Match') > 0 then
  603.       do
  604.       say "The file must be specified with no wildcard or path information."
  605.       return
  606.       end
  607.  
  608.    parse var FileSpec FileName '.' FileExt
  609.    select
  610.       when FileExt = 'DLL' then Target = Dir.ProdDll
  611.       when FileExt = 'CMD' then Target = Dir.ProdCmd
  612.       when FileExt = 'EXE' then Target = Dir.Products
  613.       otherwise
  614.          do
  615.          say "Unrecognized extension:" FileExt".  No action taken."
  616.          return
  617.          end
  618.    end /* select */
  619.    'copy' FileSpec Target
  620.    return
  621.  
  622.  
  623. /**
  624. *** ┌──────────────────────────────────────────────────────────────────────┐
  625. *** │                          Space Subroutines                           │
  626. *** └──────────────────────────────────────────────────────────────────────┘
  627. **/
  628.  
  629. RexxUnpack: procedure expose File. Pgm.
  630.    /**
  631.    ***  This will recurse through all the specified drives and generate
  632.    ***  a disk utilization report on the space used by directory.
  633.    **/
  634.  
  635.    arg RexxSource .
  636.  
  637.    /* Open the REXX source file. If not found, try appending a CMD on the end */
  638.  
  639.    if (\Exists(RexxSource)) then
  640.       do
  641.       RexxSource = RexxSource'.CMD'
  642.       if (\Exists(RexxSource)) then
  643.          do
  644.          say 'Error: Input file "'RexxSource'" doesn''t exist.'
  645.          return
  646.          end
  647.       end
  648.  
  649.    RexxSource = Open(RexxSource 'READ')
  650.  
  651.    Indent = 0
  652.    do while(lines(RexxSource) > 0)
  653.       SourceLine= linein(RexxSource)
  654.  
  655.       /* Keep breaking the line into semicolon-delimited lines until there */
  656.       /* are no more.                                                      */
  657.  
  658.       do until SourceLine = ''
  659.          parse var SourceLine FirstStmt ';' SourceLine
  660.  
  661.          parse upper var FirstStmt Keyword .
  662.  
  663.  
  664.          /* Look for statements that will indent a block */
  665.  
  666.          select
  667.             when Keyword = 'DO'     then Indent = Indent + 3
  668.             when Keyword = 'SELECT' then Indent = Indent + 3
  669.             otherwise
  670.                nop
  671.          end /* select */
  672.  
  673.          /* Display the line */
  674.  
  675.          say copies(" ", max(0,Indent)) FirstStmt
  676.  
  677.          /* Check for keywords that un-indent the block */
  678.  
  679.          select
  680.             when Keyword = 'END'    then Indent = Indent - 3
  681.             otherwise
  682.                nop
  683.          end /* select */
  684.       end
  685.    end /* while */
  686.  
  687.    RexxSource = Close(RexxSource)
  688.    return
  689.  
  690. /**
  691. *** ┌──────────────────────────────────────────────────────────────────────┐
  692. *** │                          Space Subroutines                           │
  693. *** └──────────────────────────────────────────────────────────────────────┘
  694. **/
  695.  
  696. Space: procedure expose File. Pgm.
  697.    /**
  698.    ***  This will recurse through all the specified drives and generate
  699.    ***  a disk utilization report on the space used by directory.
  700.    **/
  701.  
  702.    arg DisplayLevel DriveList
  703.  
  704.    Report.  = ''
  705.    Report.0 = 0
  706.  
  707.    /* Give defaults for missing parameters */
  708.  
  709.    if DisplayLevel = ''  then DisplayLevel = 32768
  710.    if DisplayLevel = '*' then DisplayLevel = 32768
  711.    if DisplayLevel = '.' then DisplayLevel = 32768
  712.  
  713.    if DriveList = '' then DriveList = SysDriveMap('C:', 'LOCAL')
  714.  
  715.  
  716.    do i = 1 to words(DriveList)
  717.       Drive = word(DriveList, i)
  718.       BytesDrive = SpaceDirectory(Drive'\*.*', 0, DisplayLevel)
  719.    end
  720.  
  721.    /* Erase the old and open a new file */
  722.  
  723.    '@erase' File.Temp.Space '> nul'
  724.    ReportFile = Open(File.Temp.Space 'WRITE')
  725.  
  726.    /* Write the headers */
  727.  
  728.    call lineout ReportFile, center("File", 10) center("w/ Child", 12) center("Directory", 54)
  729.    call lineout ReportFile, copies('-', 10)    copies("-", 12)        copies("-", 54)
  730.  
  731.    /* Write the space utilization report */
  732.  
  733.    do i = Report.0 to 1 by -1
  734.       call lineout ReportFile, Report.i
  735.    end
  736.    ReportFile = Close(ReportFile)
  737.  
  738.    /* Start the editor on the report file */
  739.  
  740.    ''Pgm.Editor File.Temp.Space
  741.    return
  742.  
  743.  
  744. SpaceDirectory: procedure expose File. Report. Pgm.
  745.    /**
  746.    ***  This will generate a space utilization report for a given drive
  747.    **/
  748.  
  749.    arg Directory, Level, DisplayLevel
  750.  
  751.    /* Sum the size of all files in this directory */
  752.  
  753.    call SysFileTree Directory, 'Current', 'F'
  754.  
  755.    BytesDir = 0
  756.    do i = 1 to Current.0
  757.       parse var Current.i . . BytesFile . FileName
  758.       BytesDir = BytesDir + BytesFile
  759.    end
  760.  
  761.    /* Determine the size of all the files in all the subtrees under this */
  762.    /* directory.                                                         */
  763.  
  764.    call SysFileTree Directory, 'Current', 'D'
  765.  
  766.    BytesChildren = 0
  767.    do i = 1 to Current.0
  768.       parse var Current.i . . BytesFile . SubDirName
  769.       SubDirName = strip(SubDirName, 'Both')
  770.       BytesChildren = BytesChildren + SpaceDirectory(SubDirName'\*.*', (Level+1), DisplayLevel)
  771.    end
  772.  
  773.    /* Generate the statistics for this directory and its descendants */
  774.  
  775.    BytesSum = BytesDir + BytesChildren
  776.  
  777.    if DisplayLevel >= Level then
  778.       do
  779.  
  780.       /* Format the line for column output and add to the report */
  781.  
  782.       BytesDirFmt = FormatComma(BytesDir)
  783.       BytesSumFmt = FormatComma(BytesSum)
  784.       Report.0 = Report.0 + 1
  785.       q = Report.0
  786.       Report.q = right(BytesDirFmt, 10) right(BytesSumFmt, 12) copies(" ", Level*3) Directory
  787.       end
  788.    return BytesSum
  789.  
  790. /**
  791. *** ┌──────────────────────────────────────────────────────────────────────┐
  792. *** │                         Changed Subroutines                          │
  793. *** └──────────────────────────────────────────────────────────────────────┘
  794. **/
  795.  
  796. Changed: procedure expose File. Pgm.
  797.    /**
  798.    ***  This will recurse through all the specified drives and generate
  799.    ***  a byte count on the files with the archive bit on
  800.    **/
  801.  
  802.    arg DisplayLevel DriveList
  803.  
  804.    Report.  = ''
  805.    Report.0 = 0
  806.  
  807.    /* Give defaults for missing parameters */
  808.  
  809.    if DisplayLevel = ''  then DisplayLevel = 32768
  810.    if DisplayLevel = '*' then DisplayLevel = 32768
  811.    if DisplayLevel = '.' then DisplayLevel = 32768
  812.  
  813.    if DriveList = '' then DriveList = SysDriveMap('C:', 'LOCAL')
  814.  
  815.  
  816.    do i = 1 to words(DriveList)
  817.       Drive = word(DriveList, i)
  818.       BytesDrive = ChangedDirectory(Drive'\*.*', 0, DisplayLevel)
  819.    end
  820.  
  821.    /* Erase the old and open a new file */
  822.  
  823.    '@erase' File.Temp.Changed '> nul'
  824.    ReportFile = Open(File.Temp.Changed 'WRITE')
  825.  
  826.    /* Write the headers */
  827.  
  828.    call lineout ReportFile, center("File", 10) center("w/ Child", 12) center("Directory", 54)
  829.    call lineout ReportFile, copies('-', 10)    copies("-", 12)        copies("-", 54)
  830.  
  831.    /* Write the space utilization report */
  832.  
  833.    do i = Report.0 to 1 by -1
  834.       call lineout ReportFile, Report.i
  835.    end
  836.    ReportFile = Close(ReportFile)
  837.  
  838.    /* Start the editor on the report file */
  839.  
  840.    ''Pgm.Editor File.Temp.Changed
  841.    return
  842.  
  843.  
  844. ChangedDirectory: procedure expose File. Report. Pgm.
  845.    /**
  846.    ***  This will generate a changed files report for a given drive
  847.    **/
  848.  
  849.    arg Directory, Level, DisplayLevel
  850.  
  851.    /* Sum the size of all files in this directory */
  852.  
  853.    call SysFileTree Directory, 'Current', 'F', '+****'
  854.  
  855.    BytesDir = 0
  856.    Detail.  = ''
  857.    Detail.0 = 0
  858.  
  859.    do i = 1 to Current.0
  860.       parse var Current.i . . BytesFile . FileName
  861.       FileName = strip(FileName, 'Both')
  862.       BytesDir = BytesDir + BytesFile
  863.       if DisplayLevel = 0 then
  864.          do
  865.          Detail.0 = Detail.0 + 1
  866.          q = Detail.0
  867.          Detail.q = copies(" ", 25+Level*3) FileName
  868.          end
  869.    end
  870.  
  871.    /* Determine the size of all the files in all the subtrees under this */
  872.    /* directory.                                                         */
  873.  
  874.    call SysFileTree Directory, 'Current', 'D'
  875.  
  876.    BytesChildren = 0
  877.    do i = 1 to Current.0
  878.       parse var Current.i . . BytesFile . SubDirName
  879.       SubDirName = strip(SubDirName, 'Both')
  880.       BytesChildren = BytesChildren + ChangedDirectory(SubDirName'\*.*', (Level+1), DisplayLevel)
  881.    end
  882.  
  883.    /* Generate the statistics for this directory and its descendants */
  884.  
  885.    BytesSum = BytesDir + BytesChildren
  886.  
  887.    if (DisplayLevel = 0) | (DisplayLevel >= Level) then
  888.       do
  889.  
  890.       if DisplayLevel = 0 then
  891.          do i = 1 to Detail.0
  892.             Report.0 = Report.0 + 1
  893.             q = Report.0
  894.             Report.q = Detail.i
  895.          end
  896.  
  897.       /* Format the line for column output and add to the report */
  898.  
  899.       BytesDirFmt = FormatComma(BytesDir)
  900.       BytesSumFmt = FormatComma(BytesSum)
  901.       Report.0 = Report.0 + 1
  902.       q = Report.0
  903.       Report.q = right(BytesDirFmt, 10) right(BytesSumFmt, 12) copies(" ", Level*3) Directory
  904.       end
  905.    return BytesSum
  906.  
  907. /**
  908. *** ┌──────────────────────────────────────────────────────────────────────┐
  909. *** │                     Environment Subroutines                          │
  910. *** └──────────────────────────────────────────────────────────────────────┘
  911. **/
  912.  
  913. Environment: procedure expose Dir.
  914.    /**
  915.    ***  This will list the contents of the environment variable in a list.
  916.    ***  It was designed to list those environment variables that are a
  917.    ***  list of directories, separated by semicolons, such as a PATH or
  918.    ***  DPATH variable.  Although it is not an environment variable, this
  919.    ***  code will do the same for the LIBPATH by looking in the CONFIG.SYS
  920.    **/
  921.  
  922.    arg EnvVariable .
  923.  
  924.    /* Take care of the special case for LIBPATH */
  925.  
  926.    if EnvVariable = 'LIBPATH' then
  927.       do
  928.       call SysFileSearch 'LIBPATH=', Dir.Boot'CONFIG.SYS', 'Libpath'
  929.       if Libpath.0 \= 1 then
  930.          do
  931.          say "Warning. Possibly more than 1 LIBPATH in CONFIG.SYS"
  932.          return
  933.          end
  934.       EnvValue = substr(Libpath.1, 9)  /* Remove the "LIBPATH=" */
  935.       end /* if */
  936.    else
  937.       EnvValue = value(EnvVariable, , "OS2ENVIRONMENT")
  938.  
  939.    /* Create the list of directories and display them in a nicely formatted */
  940.    /* list.                                                                 */
  941.  
  942.    Count = PathSplit(EnvValue)       /* Set DirList. */
  943.    say "The following" Count "directories were found in the" EnvVariable
  944.    say copies("─",78)
  945.    do i = 1 to DirList.0
  946.       say "   " DirList.i
  947.    end
  948.    return
  949.  
  950.  
  951. /**
  952. *** ┌──────────────────────────────────────────────────────────────────────┐
  953. *** │                         Install Subroutines                          │
  954. *** └──────────────────────────────────────────────────────────────────────┘
  955. **/
  956.  
  957. Install: procedure expose Pgm. Dir. File.
  958.    /**
  959.    ***  This will install various packages into the correct directories from
  960.    ***  a ZIP file.
  961.    **/
  962.  
  963.    parse arg cmd parms
  964.    parse upper var cmd cmd
  965.  
  966.    select
  967.       when abbrev('KEDKIT',cmd,  3)      then call InstallKedKit     parms
  968.       when abbrev('KEDIT' ,cmd,  3)      then call InstallKedKit     parms
  969.       otherwise
  970.          say "Subcommand (INSTALL): '"cmd"' not recognized"
  971.    end /* Select */
  972.    return
  973.  
  974.  
  975. InstallKedKit: procedure expose Pgm. Dir. File.
  976.    /**
  977.    ***  This will install the Kedit programming kit in the correct directories
  978.    ***  on the disk.
  979.    **/
  980.  
  981.    arg From .
  982.  
  983.    if From = '' then
  984.       From = 'a:'
  985.  
  986.    '@'Pgm.UnZip '-o' From'\kedkit.zip' Dir.Temp '| rxqueue'
  987.  
  988.    do i = 1 to queued() until leader = 'SEARCHING'
  989.       pull leader .
  990.    end
  991.  
  992.    do i = 1 to queued()
  993.       parse pull . FileName .
  994.       FileName = translate(FileName, '\', '/')
  995.       call InstallKedKitFile(FileName)
  996.    end
  997.    return
  998.  
  999.  
  1000. InstallKedKitFile: procedure expose Dir.
  1001.    /**
  1002.    ***  This will copy the file passed to the appropriate directory and
  1003.    ***  remove it from the temp directory.
  1004.    **/
  1005.  
  1006.    arg FullFile .
  1007.  
  1008.    PathEnd = lastpos('\', FullFile)
  1009.    File = substr(FullFile, (PathEnd+1))
  1010.  
  1011.    select
  1012.       when File = "NMAKE386.INC"   then DestDir = Dir.IBMCSource
  1013.       when File = "PROFILE.KEX"    then DestDir = Dir.Products
  1014.       when File = "PROFILE.KML"    then DestDir = Dir.ProdCmd
  1015.       when File = "MMAKE.CMD"      then DestDir = Dir.ProdCmd
  1016.       when File = "X.CMD"          then DestDir = Dir.ProdCmd
  1017.       when File = "$.CMD"          then DestDir = Dir.ProdCmd
  1018.       when File = "BOX.KEX"        then DestDir = Dir.ProdCmd
  1019.       when File = "BOXNUM.KEX"     then DestDir = Dir.ProdCmd
  1020.       when File = "BOXSYM.KEX"     then DestDir = Dir.ProdCmd
  1021.       when File = "OSPORT.KEX"     then DestDir = Dir.ProdCmd
  1022.       when File = "SHTOLONG.KEX"   then DestDir = Dir.ProdCmd
  1023.       when File = "RINGLIST.KEX"   then DestDir = Dir.ProdCmd
  1024.       when File = "SPECSYM.KEX"    then DestDir = Dir.ProdCmd
  1025.       otherwise
  1026.          do
  1027.          say 'File' file 'not recognized.  It is left in' Dir.Temp
  1028.          return
  1029.          end
  1030.    end /* select */
  1031.    say  'Copying:' FullFile DestDir
  1032.    '@copy' FullFile DestDir '> nul'
  1033.    '@del' FullFile '> nul'
  1034.    return
  1035.  
  1036.  
  1037. /**
  1038. *** ┌──────────────────────────────────────────────────────────────────────┐
  1039. *** │                         Profile Subroutines                          │
  1040. *** └──────────────────────────────────────────────────────────────────────┘
  1041. **/
  1042.  
  1043. Profile: procedure expose Pgm. Grep. Dir. File.
  1044.    /**
  1045.    ***  The PROFILE command will configure an OS/2 command prompt session
  1046.    **/
  1047.  
  1048.    parse arg cmd parms
  1049.    parse upper var cmd cmd
  1050.  
  1051.    /* Change the number of lines on the screen */
  1052.  
  1053.    '@mode co80,34'
  1054.  
  1055.    select
  1056.       when abbrev('REXX'   ,cmd, 2)      then call ProfileRexx       parms
  1057.       when abbrev('MSFTC'  ,cmd, 2)      then call ProfileMS         parms
  1058.       when abbrev('MSC'    ,cmd, 2)      then call ProfileMS         parms
  1059.       when abbrev('IBMCPP' ,cmd, 5)      then call ProfileIBMCPP     parms
  1060.       when abbrev('IBMC'   ,cmd, 3)      then call ProfileIBM        parms
  1061.       when abbrev('CPP'    ,cmd, 5)      then call ProfileIBMCPP     parms
  1062.       when abbrev('CMD'    ,cmd, 2)      then call ProfileRexx       parms
  1063.       when abbrev('BORLAND',cmd, 3)      then call ProfileBorland    parms
  1064.       when abbrev('BCC'    ,cmd, 3)      then call ProfileBorland    parms
  1065.       when abbrev('AWK'    ,cmd, 1)      then call ProfileAWK        parms
  1066.       otherwise
  1067.          say "Subcommand (PROFILE): '"cmd"' not recognized"
  1068.    end /* Select */
  1069.    return
  1070.  
  1071.  
  1072. ProfileIBM: procedure expose Pgm. Grep. File. Dir.
  1073.    /**
  1074.    ***  This will configure an OS/2 session for using the IBM C/Set 2
  1075.    ***  compiler
  1076.    **/
  1077.  
  1078.    parse arg project
  1079.  
  1080.    '@echo off'
  1081.    Dir.Current = directory(Dir.IBMCSource)
  1082.  
  1083.    call SysCls
  1084.    say "Setting project ...."
  1085.  
  1086.    Env = value("PROJECT",      project,                                   "OS2ENVIRONMENT")
  1087.    Env = value("PCALLX",       project".c" ,                              "OS2ENVIRONMENT")
  1088.    Env = value("INCLUDE",      Dir.Toolkit20"\c\os2h;"Dir.IBMC"\include", "OS2ENVIRONMENT")
  1089.    Env = value("INCLUDETOOLS", Dir.Toolkit20"\c\os2h",                    "OS2ENVIRONMENT")
  1090.    Env = value("INCLUDEC",     Dir.IBMC"\include",                        "OS2ENVIRONMENT")
  1091.    Env = value("LIB",          Dir.Toolkit20"\os2lib;"Dir.IBMC"\lib" ,    "OS2ENVIRONMENT")
  1092.    Env = value("IPFC",         Dir.Toolkit20"\ipfc" ,                     "OS2ENVIRONMENT")
  1093.  
  1094.    EnvPath = value("PATH", , "OS2ENVIRONMENT")
  1095.    Count =   PathSplit(EnvPath)        /* Set DirList. */
  1096.  
  1097.    /* Remove all references to all compilers and toolkits */
  1098.  
  1099.    Count =   PathRemove(Dir.IBMC)
  1100.    Count =   PathRemove(Dir.IBMWF)
  1101.    Count =   PathRemove(Dir.Toolkit20)
  1102.    Count =   PathRemove(Dir.Toolkit13)
  1103.    Count =   PathRemove(Dir.MSC)
  1104.  
  1105.    /* Re-build the path with the executables for the compilers and toolkits */
  1106.    /* that we want for this session.                                        */
  1107.  
  1108.    EnvPath = PathBuild()
  1109.    EnvPath = value("PATH", Dir.VDisk";"Dir.IBMC"\bin;"Dir.IBMWF"\bin;"Dir.Toolkit20"\os2bin;"EnvPath, "OS2ENVIRONMENT")
  1110.  
  1111.    /* Do the same to the HELP environment variable */
  1112.  
  1113.    EnvHelp = value("HELP", , "OS2ENVIRONMENT")
  1114.    Count =   PathSplit(EnvHelp)        /* Set DirList. */
  1115.    Count =   PathRemove(Dir.Toolkit20)
  1116.    Count =   PathRemove(Dir.Toolkit13)
  1117.    Count =   PathRemove(Dir.MSC)
  1118.    EnvHelp = PathBuild()
  1119.    EnvHelp = value("HELP", Dir.IBMWF"\help;"Dir.Toolkit20"\os2help;"EnvHelp, "OS2ENVIRONMENT")
  1120.  
  1121.    /* Do the same to the BOOKSHELF environment variable */
  1122.  
  1123.    EnvBook = value("BOOKSHELF", , "OS2ENVIRONMENT")
  1124.    Count =   PathSplit(EnvBook)        /* Set DirList. */
  1125.    Count =   PathRemove(Dir.Toolkit20)
  1126.    Count =   PathRemove(Dir.Toolkit13)
  1127.    Count =   PathRemove(Dir.MSC)
  1128.    EnvBook = PathBuild()
  1129.    EnvBook = value("BOOKSHELF", Dir.IBMC"\book;"Dir.Toolkit20"\book;"EnvBook, "OS2ENVIRONMENT")
  1130.    return
  1131.  
  1132.  
  1133. ProfileIBMCPP: procedure expose Pgm. Grep. File. Dir.
  1134.    /**
  1135.    ***  This will configure an OS/2 session for using the IBM C++/Set 2
  1136.    ***  compiler
  1137.    **/
  1138.  
  1139.    parse arg project
  1140.  
  1141.    '@echo off'
  1142.    Dir.Current = directory(Dir.IBMCPPSource)
  1143.  
  1144.    call SysCls
  1145.    say "Setting project ...."
  1146.  
  1147.    Env = value("PROJECT",      project,                                   "OS2ENVIRONMENT")
  1148.    Env = value("PCALLX",       project".c" ,                              "OS2ENVIRONMENT")
  1149.    Env = value("INCLUDE",      Dir.Toolkit20"\c\os2h;"Dir.IBMCPP"\include;"Dir.IBMCPP"\ibmclass", "OS2ENVIRONMENT")
  1150.    Env = value("INCLUDETOOLS", Dir.Toolkit20"\c\os2h",                    "OS2ENVIRONMENT")
  1151.    Env = value("INCLUDEC",     Dir.IBMCPP"\include;"Dir.IBMCPP"\ibmclass","OS2ENVIRONMENT")
  1152.    Env = value("LIB",          Dir.Toolkit20"\os2lib;"Dir.IBMCPP"\lib" ,  "OS2ENVIRONMENT")
  1153.    Env = value("IPFC",         Dir.Toolkit20"\ipfc" ,                     "OS2ENVIRONMENT")
  1154.  
  1155.    EnvPath = value("PATH", , "OS2ENVIRONMENT")
  1156.    Count =   PathSplit(EnvPath)        /* Set DirList. */
  1157.  
  1158.    /* Remove all references to all compilers and toolkits */
  1159.  
  1160.    Count =   PathRemove(Dir.IBMC)
  1161.    Count =   PathRemove(Dir.IBMWF)
  1162.    Count =   PathRemove(Dir.Toolkit20)
  1163.    Count =   PathRemove(Dir.Toolkit13)
  1164.    Count =   PathRemove(Dir.MSC)
  1165.  
  1166.    /* Re-build the path with the executables for the compilers and toolkits */
  1167.    /* that we want for this session.                                        */
  1168.  
  1169.    EnvPath = PathBuild()
  1170.    EnvPath = value("PATH", Dir.IBMCPP"\bin;"Dir.IBMWF"\bin;"Dir.Toolkit20"\os2bin;"EnvPath, "OS2ENVIRONMENT")
  1171.  
  1172.    /* Do the same to the HELP environment variable */
  1173.  
  1174.    EnvHelp = value("HELP", , "OS2ENVIRONMENT")
  1175.    Count =   PathSplit(EnvHelp)        /* Set DirList. */
  1176.    Count =   PathRemove(Dir.Toolkit20)
  1177.    Count =   PathRemove(Dir.Toolkit13)
  1178.    Count =   PathRemove(Dir.MSC)
  1179.    EnvHelp = PathBuild()
  1180.    EnvHelp = value("HELP", Dir.IBMWF"\help;"Dir.Toolkit20"\os2help;"EnvHelp, "OS2ENVIRONMENT")
  1181.    return
  1182.  
  1183.  
  1184.  
  1185.  
  1186. ProfileBorland: procedure expose Pgm. Grep. File. Dir.
  1187.    /**
  1188.    ***  This will configure an OS/2 session for using the Borland C++ for OS/2
  1189.    ***  compiler
  1190.    **/
  1191.  
  1192.    parse arg project
  1193.  
  1194.    '@echo off'
  1195.    Dir.Current = directory(Dir.BCSource)
  1196.  
  1197.    call SysCls
  1198.    say "Setting project ...."
  1199.  
  1200.    Env = value("PROJECT",      project,                "OS2ENVIRONMENT")
  1201.    Env = value("PCALLX",       project".c" ,           "OS2ENVIRONMENT")
  1202.    Env = value("INCLUDE",      Dir.BCToolkit"\include","OS2ENVIRONMENT")
  1203.    Env = value("INCLUDETOOLS", Dir.BCToolkit"\include","OS2ENVIRONMENT")
  1204.    Env = value("INCLUDEC",     Dir.BCToolkit"\include","OS2ENVIRONMENT")
  1205.  
  1206.    EnvPath = value("PATH", , "OS2ENVIRONMENT")
  1207.    Count =   PathSplit(EnvPath)        /* Set DirList. */
  1208.  
  1209.    /* Remove all references to all compilers and toolkits */
  1210.  
  1211.    Count =   PathRemove(Dir.IBMC)
  1212.    Count =   PathRemove(Dir.IBMWF)
  1213.    Count =   PathRemove(Dir.Toolkit20)
  1214.    Count =   PathRemove(Dir.Toolkit13)
  1215.    Count =   PathRemove(Dir.MSC)
  1216.  
  1217.    /* Re-build the path with the executables for the compilers and toolkits */
  1218.    /* that we want for this session.                                        */
  1219.  
  1220.    EnvPath = PathBuild()
  1221.    EnvPath = value("PATH", Dir.BC"\bin;"Dir.Toolkit20"\os2bin;"EnvPath, "OS2ENVIRONMENT")
  1222.    return
  1223.  
  1224.  
  1225. ProfileMS: procedure expose Pgm. Grep. File. Dir.
  1226.    /**
  1227.    ***  This will configure an OS/2 session for using MSC and the OS/2 v1.3
  1228.    ***  Toolkit
  1229.    **/
  1230.  
  1231.    parse arg project
  1232.  
  1233.    '@echo off'
  1234.    Dir.Current = directory(Dir.MSCSource)
  1235.  
  1236.    call SysCls
  1237.    say "Setting project ...."
  1238.  
  1239.    Env = value("PROJECT",      project,                                    "OS2ENVIRONMENT")
  1240.    Env = value("PCALLX",       project".c" ,                               "OS2ENVIRONMENT")
  1241.    Env = value("INCLUDE",      Dir.Toolkit13"\c\include;"Dir.MSC"\include","OS2ENVIRONMENT")
  1242.    Env = value("INCLUDETOOLS", Dir.Toolkit13"\c\include",                  "OS2ENVIRONMENT")
  1243.    Env = value("INCLUDEC",     Dir.MSC"\include",                          "OS2ENVIRONMENT")
  1244.    Env = value("LIB",          Dir.Toolkit13"\lib;"Dir.MSC"\lib" ,         "OS2ENVIRONMENT")
  1245.    Env = value("IPFC",         Dir.Toolkit13"\ipfc" ,                      "OS2ENVIRONMENT")
  1246.  
  1247.    EnvPath = value("PATH", , "OS2ENVIRONMENT")
  1248.    Count =   PathSplit(EnvPath)        /* Set DirList. */
  1249.  
  1250.    /* Remove all references to all compilers and toolkits */
  1251.  
  1252.    Count =   PathRemove(Dir.IBMC)
  1253.    Count =   PathRemove(Dir.IBMWF)
  1254.    Count =   PathRemove(Dir.Toolkit20)
  1255.    Count =   PathRemove(Dir.Toolkit13)
  1256.    Count =   PathRemove(Dir.MSC)
  1257.  
  1258.    /* Re-build the path with the executables for the compilers and toolkits */
  1259.    /* that we want for this session.                                        */
  1260.  
  1261.    EnvPath = PathBuild()
  1262.    EnvPath = value("PATH", Dir.MSC"\bin;"Dir.Toolkit13"\bin;"EnvPath, "OS2ENVIRONMENT")
  1263.  
  1264.    /* Do the same to the HELP environment variable */
  1265.  
  1266.    EnvHelp = value("HELP", , "OS2ENVIRONMENT")
  1267.    Count =   PathSplit(EnvHelp)        /* Set DirList. */
  1268.    Count =   PathRemove(Dir.Toolkit20)
  1269.    Count =   PathRemove(Dir.Toolkit13)
  1270.    Count =   PathRemove(Dir.MSC)
  1271.    EnvHelp = PathBuild()
  1272.    EnvHelp = value("HELP", Dir.Toolkit20"\os2help;"EnvHelp, "OS2ENVIRONMENT")
  1273.    return
  1274.  
  1275.  
  1276. ProfileRexx: procedure expose Pgm. Grep. File. Dir.
  1277.    /**
  1278.    ***  This will configure an OS/2 session for working with REXX
  1279.    **/
  1280.  
  1281.    parse arg project
  1282.  
  1283.    '@echo off'
  1284.    'prompt [$p]'
  1285.  
  1286.    Dir.Current = directory(Dir.Rexx)
  1287.  
  1288.    call SysCls
  1289.    say "Setting project ...."
  1290.    Env = value("PROJECT", project, "OS2ENVIRONMENT")
  1291.    Env = value("PCALLX", project".cmd" , "OS2ENVIRONMENT")
  1292.    return
  1293.  
  1294.  
  1295.  
  1296. ProfileAWK: procedure expose Pgm. Grep. File. Dir.
  1297.    /**
  1298.    ***  This will configure an OS/2 session for AWK development
  1299.    **/
  1300.  
  1301.    parse arg project
  1302.  
  1303.    '@echo off'
  1304.  
  1305.    Dir.Current = directory(Dir.AWK)
  1306.  
  1307.    call SysCls
  1308.    say "Setting project ...."
  1309.    Env = value("PROJECT", project, "OS2ENVIRONMENT")
  1310.    Env = value("PCALLX", project".cmd" , "OS2ENVIRONMENT")
  1311.    return
  1312.  
  1313.  
  1314. /**
  1315. *** ┌──────────────────────────────────────────────────────────────────────┐
  1316. *** │                         Maximus Subroutines                          │
  1317. *** └──────────────────────────────────────────────────────────────────────┘
  1318. **/
  1319.  
  1320.  
  1321. Maximus: procedure expose Pgm. Grep. Dir. File.
  1322.    parse arg cmd parms
  1323.    parse upper var cmd cmd
  1324.  
  1325.    select
  1326.       when abbrev('CLEANLOG'  ,cmd,  6) then call MaximusCleanLog   parms
  1327.       when abbrev('CLEANFILES',cmd,  6) then call MaximusCleanFiles parms
  1328.       when abbrev('LOGONS'    ,cmd,  3) then call MaximusLogons     parms
  1329.       when abbrev('TODAY'     ,cmd,  3) then call MaximusToday      parms
  1330.       when abbrev('DOWNLOADS' ,cmd,  2) then call MaximusDownloads  parms
  1331.       when abbrev('DL'        ,cmd,  2) then call MaximusDownloads  parms
  1332.       otherwise
  1333.          say "Subcommand (MAXIMUS): '"cmd"' not recognized"
  1334.    end /* Select */
  1335.    return
  1336.  
  1337.  
  1338. MaximusCleanLog: procedure expose Pgm. Grep. File. Dir.
  1339.    /**
  1340.    ***  This will trim the log for the Maximus BBS by keeping only those
  1341.    ***  lines that being with a '+' or '='.  These are the logon, logoff
  1342.    ***  and download messages.
  1343.    **/
  1344.  
  1345.    '@echo off'
  1346.    Dir.Maximus = directory(Dir.Maximus)
  1347.    Pgm.Grep Grep.Options Grep.Re.LogKeep File.Max.Log '>' File.Temp.1
  1348.    'copy'  File.Temp.1 File.Max.Log
  1349.  
  1350.    /* Clean up the temporary files */
  1351.  
  1352.    'erase' File.Temp.1
  1353.    return
  1354.  
  1355.  
  1356. MaximusCleanFiles: procedure expose Pgm. File. Dir.
  1357.    /**
  1358.    ***  This will look for the files that are created by the Maximus BBS
  1359.    ***  when a path override is done by the sysop and a file is uploaded.
  1360.    ***  When those files are found, they are deleted.
  1361.    **/
  1362.  
  1363.    'erase' File.Temp.1
  1364.    map = SysDriveMap('C:', 'USED')
  1365.    i = 1
  1366.    drive = word(map, i)
  1367.    do while(drive \= '')
  1368.       call SysFileTree drive'\'File.BBS, 'Found', 'FSO'
  1369.       do j = 1 to Found.0
  1370.          'erase' found.j
  1371.       end
  1372.       i = i + 1
  1373.       drive = word(map, i)
  1374.    end /* do */
  1375.  
  1376.    return
  1377.  
  1378.  
  1379. MaximusLogons: procedure expose Pgm. Grep. File. Dir.
  1380.    /**
  1381.    ***
  1382.    **/
  1383.  
  1384.    '@echo off'
  1385.    Dir.Maximus = directory(Dir.Maximus)
  1386.    Pgm.Grep Grep.Options Grep.Re.LogCall File.Max.Log
  1387.    return
  1388.  
  1389.  
  1390. MaximusDownloads: procedure expose Pgm. File. Dir.
  1391.    /**
  1392.    ***
  1393.    **/
  1394.  
  1395.    '@echo off'
  1396.    Dir.Maximus = directory(Dir.Maximus)
  1397.    Pgm.Awk '-f' Dir.Awk'\MaxDLByFile.awk' File.Max.Log '>' File.Temp.MaxDl
  1398.    Pgm.Awk '-f' Dir.Awk'\MaxDL.awk' File.Max.Log '>>' File.Temp.MaxDl
  1399.    Pgm.Editor File.Temp.MaxDl
  1400.    return
  1401.  
  1402.  
  1403. MaximusToday: procedure expose Pgm. Grep. File. Dir.
  1404.    /**
  1405.    ***
  1406.    **/
  1407.  
  1408.    '@echo off'
  1409.    Dir.Maximus = directory(Dir.Maximus)
  1410.  
  1411.    parse value date('N') with dd mmm .
  1412.    dd = right(dd, 2, '0')
  1413.    Pgm.Grep '"'dd mmm'"' File.Max.Log '|' Pgm.Awk '-f' Dir.Awk'\MaxToday.AWK'
  1414.    return
  1415.  
  1416.  
  1417. /**
  1418. *** ┌──────────────────────────────────────────────────────────────────────┐
  1419. *** │                         Backup Subroutines                           │
  1420. *** └──────────────────────────────────────────────────────────────────────┘
  1421. **/
  1422.  
  1423.  
  1424. Backup: procedure expose Dir. File. Upm.
  1425.    parse arg cmd parms
  1426.    parse upper var cmd cmd
  1427.  
  1428.    select
  1429.       when abbrev('FILE'    ,cmd,  1) then call BackupFile     parms
  1430.       when abbrev('OFFSITE' ,cmd,  1) then call BackupOffsite  parms
  1431.       when abbrev('SERVER'  ,cmd,  1) then call BackupOffsite  parms
  1432.       when abbrev('CHRON'   ,cmd,  5) then call BackupChron    parms
  1433.       when abbrev('CONFIG'  ,cmd,  4) then call BackupConfig   parms
  1434.       when abbrev('CISMSGS' ,cmd,  4) then call BackupCISMsgs  parms
  1435.       when abbrev('DATABASE',cmd,  2) then call BackupDatabase parms
  1436.       when abbrev('DB'      ,cmd,  2) then call BackupDatabase parms
  1437.       otherwise
  1438.          say "Subcommand (BACKUP): '"cmd"' not recognized"
  1439.    end /* Select */
  1440.    return
  1441.  
  1442.  
  1443. BackupDatabase: procedure expose Dir. File. Upm.
  1444.    /**
  1445.    ***  This will backup the database passed on the command line.
  1446.    **/
  1447.  
  1448.    parse arg database password
  1449.  
  1450.    '@startdbm'
  1451.  
  1452.    /* If the password was passed on the command line, honor that.  Next,   */
  1453.    /* check the Upm stem variable to see if there was a default password   */
  1454.    /* specified there.  If not, let UPM prompt for it.                     */
  1455.  
  1456.    if password = '' then
  1457.       password = Upm.Password
  1458.  
  1459.    if password = '' then
  1460.      '@logon' Upm.Userid
  1461.    else
  1462.      '@logon' Upm.Userid '/P='password
  1463.  
  1464.    call dbm 'BACKUP DATABASE' database 'ALL TO 0'
  1465.    return
  1466.  
  1467.  
  1468. BackupCISMsgs: procedure expose Dir.
  1469.    /**
  1470.    ***  This will backup the message base from CompuServe.  The *.MSG files
  1471.    ***  are created by the (exceptional) Golden CommPass program from
  1472.    ***  Creative Systems, Inc.
  1473.    **/
  1474.  
  1475.    call SysFileTree Dir.Commpass'\*.MSG', 'Found', 'FT'
  1476.  
  1477.    do i = 1 to Found.0
  1478.       parse var Found.i FileName '.MSG' .
  1479.  
  1480.       /* Copy the file to the backup directory */
  1481.  
  1482.       FileExt = right(date("days"),3,"0")  /* Julian date padded w/ 0's */
  1483.       say 'copy' Found.0 Dir.Backup'\'FileName'.'FileExt /*«»*/
  1484.       if rc = 0 then
  1485.          say 'del' Found.0  /*«»*/
  1486.  
  1487.       DeleteCount = DeleteOldFiles(Dir.Backup'\'Filename'.*', 3)
  1488.    end /* do i = ... */
  1489.    return
  1490.  
  1491.  
  1492. BackupConfig: procedure expose Dir.
  1493.    /**
  1494.    ***  This will backup multiple generations of the CONFIG.SYS file.  It
  1495.    ***  will only back it up if it has changed (i.e. the archive bit is on)
  1496.    **/
  1497.  
  1498.    BootDrive = strip(Dir.Boot, 'Trailing', '\')
  1499.    call SysFileTree BootDrive'\CONFIG.SYS', 'Found', 'F', '+****', '-****'
  1500.    if Found.0 then
  1501.       do
  1502.       FileExt = right(date("days"),3,"0")  /* Julian date padded w/ 0's */
  1503.       'copy' BootDrive'\CONFIG.SYS' Dir.Backup'\CONFIG.'FileExt
  1504.       '@attrib -A' BootDrive'\CONFIG.SYS'
  1505.       end
  1506.  
  1507.    /* Keep the number of config backups to a reasonable number */
  1508.  
  1509.    DeleteCount = DeleteOldFiles(Dir.Backup'\CONFIG.*', 8)
  1510.    return;
  1511.  
  1512.  
  1513. BackupFile: procedure expose Dir.
  1514.    /**
  1515.    ***  This will backup multiple generations of the file passed.  It
  1516.    ***  will only back it up if it has changed (i.e. the archive bit is on)
  1517.    **/
  1518.  
  1519.    arg FileSpec Archives
  1520.  
  1521.    if FileSpec = '' then
  1522.       do
  1523.       say "No file specified."
  1524.       return
  1525.       end
  1526.  
  1527.    if Archives = '' then Archives = 12
  1528.    if Archives < 1  then Archives = 1
  1529.  
  1530.    call SysFileTree FileSpec, 'Found', 'F', '+****', '-****'
  1531.    do i = 1 to Found.0
  1532.       parse var Found.i . . . . FileSrc
  1533.  
  1534.       FileExt = right(date("days"),3,"0")  /* Julian date padded w/ 0's */
  1535.  
  1536.       /* Pull out the file name */
  1537.  
  1538.       psn = lastpos('\', FileSrc)
  1539.       FileName = substr(FileSrc, (psn+1))
  1540.  
  1541.       parse var FileName FileName '.' .
  1542.       '@copy' FileSrc Dir.Backup'\'FileName'.'FileExt '> nul'
  1543.       '@attrib -A' FileSrc
  1544.       DeleteCount = DeleteOldFiles(Dir.Backup'\'FileName'.*', Archives)
  1545.    end
  1546.    say "       " Found.0 "file(s) copied."
  1547.    return;
  1548.  
  1549.  
  1550. BackupOffsite: procedure expose Dir. File.
  1551.    /**
  1552.    ***  This will backup all of the files in the desired directories to the
  1553.    ***  server for offsite storage
  1554.    **/
  1555.  
  1556.    if (Dir.Server = 'n/a') then
  1557.       do
  1558.       say 'No backup server device specified'
  1559.       return
  1560.       end
  1561.  
  1562.    /* Make sure the dest drive exists */
  1563.  
  1564.    DriveList = SysDriveMap('C:')
  1565.    DestDrive = left(Dir.Server, 2)
  1566.    DestDrive = UpperCase(DestDrive)
  1567.    if (wordpos(DestDrive, DriveList) = 0) then
  1568.       do
  1569.       say "Destination drive ("DestDrive") not available"
  1570.       return
  1571.       end
  1572.  
  1573.    /* Delete the output file */
  1574.  
  1575.    if exists(File.Temp.Offsite) then
  1576.       "@erase" File.Temp.Offsite
  1577.  
  1578.    /* Backup the following directories.  If the dest directory doesn't */
  1579.    /* exist, XCOPY will prompt with the "Drive or file" question.      */
  1580.  
  1581.    call BackupOffsiteDirectory("c:\awk             \awk")
  1582.    call BackupOffsiteDirectory("c:\aix             \aix")
  1583.    call BackupOffsiteDirectory("c:\products        \products")
  1584.    call BackupOffsiteDirectory("c:\ibmc\source     \ibmc\source")
  1585.    call BackupOffsiteDirectory("c:\doc\notes       \doc\notes")
  1586.    call BackupOffsiteDirectory("c:\doc\sprint      \doc\sprint")
  1587.    return
  1588.  
  1589.  
  1590. BackupChron: procedure expose Dir.
  1591.    /**
  1592.    ***  This will backup the CHRON.DAT file.  If this is a daily backup,
  1593.    ***  the file is created with an extension equal to the first three
  1594.    ***  letters of the day of the week.  If this is a weekly backup, the
  1595.    ***  file is created with an extension of ".BKW".  Otherwise, the
  1596.    ***  file is ".SAV"
  1597.    **/
  1598.  
  1599.    arg parms
  1600.  
  1601.    select
  1602.       when abbrev('DAILY' ,parms, 1) then
  1603.          Destination = 'chron.'left(date('W'),3)
  1604.       when abbrev('WEEKLY',parms, 1) then
  1605.          Destination = 'chron.bkw'
  1606.       otherwise
  1607.          Destination = 'chron.sav'
  1608.    end /* select */
  1609.  
  1610.    Dir.ProdDat = directory(Dir.ProdDat)
  1611.    'copy chron.dat' Dir.Backup'\'Destination
  1612.    return;
  1613.  
  1614.  
  1615. BackupOffsiteDirectory: procedure expose Dir. File.
  1616.    /**
  1617.    ***  This will backup the changed files to the server for offsite
  1618.    ***  secure storage.
  1619.    **/
  1620.  
  1621.    arg source dest .
  1622.    '@echo Copying' source '──' Dir.Server || dest'... >>' File.Temp.Offsite
  1623.    '@xcopy /E /M' source Dir.Server || dest '>>' File.Temp.Offsite
  1624.    return
  1625.  
  1626.  
  1627. /**
  1628. *** ┌──────────────────────────────────────────────────────────────────────┐
  1629. *** │                          Check Subroutines                           │
  1630. *** └──────────────────────────────────────────────────────────────────────┘
  1631. **/
  1632.  
  1633.  
  1634. Check: procedure expose Dir. File. Pgm.
  1635.    parse arg cmd parms
  1636.    parse upper var cmd cmd
  1637.  
  1638.    select
  1639.       when abbrev('DIRECTORY',cmd,  2) then call CheckDir     parms
  1640.       when abbrev('DRIVES'   ,cmd,  2) then call CheckDrives  parms
  1641.       when abbrev('FLOPPY'   ,cmd,  2) then call CheckFloppy  parms
  1642.       when abbrev('FILE'     ,cmd,  1) then call CheckFile    parms
  1643.       when abbrev('SELF'     ,cmd,  4) then call CheckSelf    parms
  1644.       when abbrev('MAIL'     ,cmd,  1) then call CheckMail    parms
  1645.       otherwise
  1646.          say "Subcommand (CHECK): '"cmd"' not recognized"
  1647.    end /* Select */
  1648.    return
  1649.  
  1650.  
  1651. CheckMail: procedure expose File. Pgm. Dir.
  1652.    /**
  1653.    ***  This will see if there has been any new SprintMail loaded down.  It
  1654.    ***  checks by looking for the archive bit on the files in the IN box.
  1655.    ***  This is intended to be run by CHRON.
  1656.    **/
  1657.  
  1658.    call SysFileTree Dir.SprintMail'\IN.BOX\*.ASC', 'Found', 'F', '+****', '-****'
  1659.    if Found.0 then
  1660.       do
  1661.       '@start' Pgm.Notify 'You have new SprintMail'
  1662.       '@attrib -A' Dir.SprintMail'\IN.BOX\*.ASC'
  1663.       end
  1664.    return
  1665.  
  1666.  
  1667. CheckDrives: procedure expose File. Pgm.
  1668.    /**
  1669.    ***  This will run a CHKDSK on both the C: and D: drives and pipe the output
  1670.    ***  into a file.  Once both have been run, KEDIT is started with the
  1671.    ***  output file to display the results.   This is intended to be run by
  1672.    ***  CHRON.
  1673.    **/
  1674.  
  1675.    '@erase' File.Temp.ChkDsk
  1676.    map = SysDriveMap('C:', 'LOCAL')
  1677.    i = 1
  1678.    drive = word(map, i)
  1679.    do while(drive \= '')
  1680.       say "Checking drive" drive"..."
  1681.       "@echo Checking drive" drive"...   >>" File.Temp.Chkdsk
  1682.       "@chkdsk" drive                   ">>" File.Temp.Chkdsk
  1683.       "@echo" copies("─",78)            ">>" File.Temp.Chkdsk
  1684.       i = i + 1
  1685.       drive = word(map, i)
  1686.    end
  1687.  
  1688.    ''Pgm.Editor File.Temp.Chkdsk
  1689.    return
  1690.  
  1691.  
  1692. CheckFloppy: procedure expose File.
  1693.    /**
  1694.    ***  This will check the floppy for data integrity.  OS/2 v1.x had problems
  1695.    ***  with my setup.  This will excercise I/O to the floppy.  It can also
  1696.    ***  serve to stress test a new floppy drive.
  1697.    **/
  1698.  
  1699.    arg parms
  1700.  
  1701.    '@echo Starting floppy stress test:' date() time() '>' File.Temp.3
  1702.  
  1703.    Pass = 1
  1704.    do forever
  1705.       Say "Pass...." Pass
  1706.       '@copy /v c:\os2\help a: >>' File.Temp.3
  1707.       Say "Wait...."
  1708.       call SysSleep 120
  1709.       Pass = Pass + 1
  1710.    end
  1711.    return
  1712.  
  1713.  
  1714. CheckSelf: procedure expose Dir. File. Pgm.
  1715.    /**
  1716.    ***  This is a little self-test routine that will make sure that
  1717.    ***  the relevant directories and files in the global variables exist.
  1718.    **/
  1719.  
  1720.    say
  1721.    say 'Checking directories...'
  1722.    say
  1723.    call CheckDir(Dir.BC        )
  1724.    call CheckDir(Dir.BCSource  )
  1725.    call CheckDir(Dir.BCToolkit )
  1726.    call CheckDir(Dir.Boot      )
  1727.    call CheckDir(Dir.IBMCSource)
  1728.    call CheckDir(Dir.IBMCPPSource)
  1729.    call CheckDir(Dir.IBMCPP)
  1730.    call CheckDir(Dir.IBMWF     )
  1731.    call CheckDir(Dir.Maximus   )
  1732.    call CheckDir(Dir.MSC       )
  1733.    call CheckDir(Dir.MSCSource )
  1734.    call CheckDir(Dir.ProdCmd   )
  1735.    call CheckDir(Dir.ProdDat   )
  1736.    call CheckDir(Dir.ProdDll   )
  1737.    call CheckDir(Dir.Products  )
  1738.    call CheckDir(Dir.Rexx      )
  1739.    call CheckDir(Dir.Server    )
  1740.    call CheckDir(Dir.SprintMail)
  1741.    call CheckDir(Dir.Temp      )
  1742.    call CheckDir(Dir.Toolkit13 )
  1743.    call CheckDir(Dir.Toolkit20 )
  1744.    call CheckDir(Dir.Unix      )
  1745.    call CheckDir(Dir.VDisk     )
  1746.  
  1747.    say
  1748.    say 'Checking program files...'
  1749.    say
  1750.    call CheckFile(Pgm.Grep)
  1751.    call CheckFile(Pgm.Editor)
  1752.    call CheckFile(Pgm.CalcCrc)
  1753.    call CheckFile(Pgm.Zip)
  1754.    call CheckFile(Pgm.UnZip)
  1755.    call CheckFile(Pgm.Awk)
  1756.    call CheckFile(Pgm.Tail)
  1757.    call CheckFile(Pgm.Notify)
  1758.    return
  1759.  
  1760.  
  1761. CheckDir: procedure
  1762.    /**
  1763.    ***  This will check to see if a directory exists
  1764.    **/
  1765.  
  1766.    arg DirToCheck
  1767.  
  1768.    if DirToCheck = 'N/A' then
  1769.       return 1
  1770.  
  1771.    DirFound = directory(DirToCheck)
  1772.    if DirFound \= DirToCheck then
  1773.       do
  1774.       say "Directory '"DirToCheck"' was not found"
  1775.       return 0
  1776.       end
  1777.    else
  1778.       say "Directory '"DirToCheck"' was found"
  1779.  
  1780.    return 1
  1781.  
  1782.  
  1783. CheckFile: procedure
  1784.    /**
  1785.    ***  This reports on the existence of a file
  1786.    **/
  1787.  
  1788.    arg fid
  1789.  
  1790.    if Exists(fid) then
  1791.       say "File '"fid"' exists"
  1792.    else
  1793.       do
  1794.       say "File '"fid"' doesn't exist"
  1795.       return 0
  1796.       end
  1797.    return 1
  1798.  
  1799.  
  1800. /**
  1801. *** ┌──────────────────────────────────────────────────────────────────────┐
  1802. *** │                          Other Subroutines                           │
  1803. *** └──────────────────────────────────────────────────────────────────────┘
  1804. **/
  1805.  
  1806. LoadFunctions: procedure
  1807.    /**
  1808.    ***   This will load the DLL for the Rexx system functions supplied
  1809.    ***   with OS/2 v2.0
  1810.    ***
  1811.    ***   It is recommended that this been run at system startup to assure
  1812.    ***   that the system Rexx functions are available to execs that need
  1813.    ***   them.  This approach was chosen for loading the DLL every time the
  1814.    ***   Rexx exec was entered.
  1815.    **/
  1816.    call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  1817.    call SysLoadFuncs
  1818.    return
  1819.  
  1820.  
  1821. WhereIs: procedure expose Dir. File. Grep. Pgm.
  1822.    /**
  1823.    ***  This will search for the file passed on the drive set specified
  1824.    **/
  1825.  
  1826.    arg FileSpec Drives
  1827.  
  1828.    select
  1829.       when abbrev('LOCAL' ,Drives, 1) then
  1830.          do
  1831.          map = SysDriveMap('C:', 'LOCAL')
  1832.          i = 1
  1833.          drive = word(map, i)
  1834.          do while(drive \= '')
  1835.             call WhereisFile drive'\'FileSpec
  1836.             i = i + 1
  1837.             drive = word(map, i)
  1838.          end /* do */
  1839.          end /* when */
  1840.       when abbrev('ALL' ,Drives, 1) then
  1841.          do
  1842.          map = SysDriveMap('C:', 'USED')
  1843.          i = 1
  1844.          drive = word(map, i)
  1845.          do while(drive \= '')
  1846.             call WhereisFile drive'\'FileSpec
  1847.             i = i + 1
  1848.             drive = word(map, i)
  1849.          end /* do */
  1850.          end /* when */
  1851.       when abbrev('USED' ,Drives, 1) then
  1852.          do
  1853.          map = SysDriveMap('C:', 'USED')
  1854.          i = 1
  1855.          drive = word(map, i)
  1856.          do while(drive \= '')
  1857.             call WhereisFile drive'\'FileSpec
  1858.             i = i + 1
  1859.             drive = word(map, i)
  1860.          end /* do */
  1861.          end /* when */
  1862.       otherwise
  1863.          call WhereisFile FileSpec
  1864.    end
  1865.    return
  1866.  
  1867.  
  1868.  
  1869. WhereisFile: procedure
  1870.    /**
  1871.    ***  This will find a single file, starting at the current directory
  1872.    ***  unless a fully qualified filespec is passed.
  1873.    **/
  1874.  
  1875.    arg FileSpec
  1876.  
  1877.    call SysFileTree FileSpec, 'Found', 'FSO'
  1878.    do i = 1 to Found.0
  1879.       say Found.i
  1880.    end
  1881.    return;
  1882.  
  1883.  
  1884. Test: procedure expose Dir. File. Grep. Pgm.
  1885.    /**
  1886.    ***  This is a spot into which test code can be placed to check some
  1887.    ***  REXX code out easily.
  1888.    **/
  1889.  
  1890.  
  1891.  
  1892.    env = value("PROGREF", , "OS2ENVIRONMENT")
  1893.    say env
  1894.    return
  1895.  
  1896.    Modem = Open('COM2:', 'WRITE')
  1897.    call lineout Modem, "AT&C1V1X4Q0E1S7=60M1"
  1898.    call SysSleep 2
  1899.    call lineout Modem, "AT&C1V1X4Q0E1S7=60M1"
  1900.    call SysSleep 2
  1901.    Modem = Close(Modem)
  1902.    return
  1903.  
  1904.    do i = 10 to 1 by -1
  1905.       say i
  1906.    end
  1907.  
  1908.    say FormatComma(0)
  1909.    say FormatComma(1)
  1910.    say FormatComma(123)
  1911.    say FormatComma(123456)
  1912.    say FormatComma(1234567)
  1913.    say FormatComma(12345678)
  1914.    say FormatComma(123456789)
  1915.    say FormatComma(1234567890)
  1916.    return
  1917.  
  1918.  
  1919. /**
  1920. *** ┌──────────────────────────────────────────────────────────────────────┐
  1921. *** │                     General Purpose Subroutines                      │
  1922. *** └──────────────────────────────────────────────────────────────────────┘
  1923. **/
  1924.  
  1925. UpperCase: procedure
  1926.    /**
  1927.    ***  This will return the string passed after converting it to uppercase
  1928.    **/
  1929.  
  1930.    parse upper arg String
  1931.    return String
  1932.  
  1933.  
  1934. LowerCase: procedure
  1935.    /**
  1936.    ***  This will return the string passed after converting it to lowercase
  1937.    **/
  1938.  
  1939.    parse lower arg String
  1940.    return String
  1941.  
  1942.  
  1943. PathSplit: procedure expose DirList.
  1944.    /**
  1945.    ***  This will create a stem variable out of the semicolon-delimited
  1946.    ***  variable that is presumably retreived from a PATH or DPATH
  1947.    ***  environment.
  1948.    **/
  1949.  
  1950.    arg PathString .
  1951.  
  1952.    DirList = ''
  1953.    j = 1
  1954.    parse var PathString DirList.j ';' PathString
  1955.    do while DirList.j \= ''
  1956.       j = j + 1
  1957.       parse var PathString DirList.j ';' PathString
  1958.    end /* while */
  1959.    DirList.0 = j - 1
  1960.    return DirList.0
  1961.  
  1962.  
  1963. PathRemove: procedure expose DirList.
  1964.    /**
  1965.    ***  This will remove those items from the directory list that match
  1966.    ***  the prefix of the argument passed.
  1967.    **/
  1968.  
  1969.    arg DirPrefix .
  1970.  
  1971.  
  1972.    i = 1
  1973.    RemovedCount = 0
  1974.    do while i <= DirList.0
  1975.       if abbrev(DirList.i, DirPrefix) then
  1976.          do
  1977.  
  1978.          /* Move the rest of the items down */
  1979.  
  1980.          do j = i to DirList.0
  1981.             k = j + 1
  1982.             DirList.j = DirList.k
  1983.          end /* do j = */
  1984.  
  1985.          /* Reduce the count and clear out the last entry */
  1986.  
  1987.          DirList.0 = DirList.0 - 1
  1988.          DirList.k = ''
  1989.          RemovedCount = RemovedCount + 1
  1990.          end /* if */
  1991.  
  1992.       i = i + 1
  1993.    end /* while */
  1994.    return RemovedCount
  1995.  
  1996.  
  1997. PathBuild: procedure expose DirList.
  1998.    /**
  1999.    ***  This will build a semi-colon delimited string with the names of all
  2000.    ***  the directories in the DirList stem variable
  2001.    **/
  2002.  
  2003.    PathList = Dirlist.1
  2004.    do i = 2 to DirList.0
  2005.       PathList = PathList";"DirList.i
  2006.    end
  2007.    return PathList
  2008.  
  2009.  
  2010. DeleteOldFiles: procedure
  2011.    /**
  2012.    ***  This will keep 'x' versions of the filename that matches the
  2013.    ***  pattern passed and delete the rest.
  2014.    **/
  2015.  
  2016.    arg SearchFor, Keep
  2017.  
  2018.    /* Keep the number of message file backups to a reasonable number */
  2019.  
  2020.    call SysFileTree SearchFor, 'Sort', 'FT'
  2021.  
  2022.    /* If there are a bunch of them, delete the oldest ones */
  2023.  
  2024.    if Sort.0 > Keep then
  2025.       do
  2026.       call SortStem
  2027.       do j = 1 to (Sort.0 - Keep)
  2028.          parse var Sort.j . . . DeleteFile
  2029.          'erase' DeleteFile
  2030.       end
  2031.       end /* if */
  2032.    return (Sort.0 - Keep)
  2033.  
  2034.  
  2035. SortStem: procedure expose Sort.
  2036.    /**
  2037.    ***  This will sort the stem variable passed in.  It is assumed that the
  2038.    ***  stem variable is formatted in the "standard" way of Stem.0 containing
  2039.    ***  the number of items
  2040.    **/
  2041.  
  2042.    do i = 1 to Sort.0
  2043.  
  2044.       /* Find the lowest value in the list */
  2045.  
  2046.       low = i;
  2047.       do j = (i+1) to Sort.0
  2048.          if Sort.j < Sort.low then
  2049.             low = j
  2050.       end
  2051.  
  2052.       /* Swap the two */
  2053.  
  2054.       temp = Sort.i
  2055.       Sort.i = Sort.low
  2056.       Sort.low = temp
  2057.    end
  2058.    return
  2059.  
  2060.  
  2061. FormatComma: procedure
  2062.    /**
  2063.    ***  This will take a string (that is presumably numeric, but not verified
  2064.    ***  to be) and insert commas after groups of three digits
  2065.    **/
  2066.  
  2067.    arg Raw .
  2068.  
  2069.    Formatted = ''
  2070.    do while Raw \= 0
  2071.       Formatted = right(Raw, 3)','Formatted
  2072.       Raw = Raw % 1000
  2073.    end
  2074.    if Formatted = '' then
  2075.       Formatted = 0
  2076.    else
  2077.       do
  2078.       Formatted = Strip(Formatted,'Trailing',',')
  2079.       Formatted = Strip(Formatted,'Leading',' ')
  2080.       end
  2081.    return Formatted
  2082.  
  2083.  
  2084. Open: procedure
  2085.  
  2086.    arg file rw
  2087.  
  2088.    file_ = stream(file,c,'QUERY EXIST')
  2089.  
  2090.    /* If the file is opened for WRITE access, delete it first */
  2091.  
  2092.    if (file_ \= '') then
  2093.       do
  2094.       if (rw = 'WRITE') then
  2095.          '@erase' file
  2096.       file = file_
  2097.       end
  2098.  
  2099.    message = stream(file,c,'OPEN' rw)
  2100.    if (message \= 'READY:') then
  2101.       do
  2102.       say 'Error: Open failure on' file'.' message
  2103.       exit
  2104.       end
  2105.    return file
  2106.  
  2107.  
  2108. Close: procedure
  2109.  
  2110.    arg file
  2111.    message = stream(file,c,'CLOSE')
  2112.    if (message \= 'READY:') & (message \= '') then
  2113.       do
  2114.       say 'Error: Close failure on' file'.' message
  2115.       exit
  2116.       end
  2117.    return file
  2118.  
  2119.  
  2120. Exists: procedure
  2121.  
  2122.    arg file
  2123.  
  2124.    file = stream(file,c,'QUERY EXIST')
  2125.    if (file = '') then
  2126.       return 0
  2127.    else
  2128.       return 1
  2129.