home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / samp$.zip / $.CMD
OS/2 REXX Batch file  |  1994-12-27  |  88KB  |  2,946 lines
  1. /**
  2. *** ╔════════════════════════════════════════════════════════════════════╗
  3. *** ║                                                                    ║
  4. *** ║  $.CMD - version 3.16                                              ║
  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/Fax.. (913) 829-2450 8N1 14.4Kbps                 ║
  41. *** ║              CIS...... [73457,365]                                 ║
  42. *** ║                                                                    ║
  43. *** ║ ────────────────────────────────────────────────────────────────── ║
  44. *** ║                                                                    ║
  45. *** ║            Copyright (c) 1992-1994  Hilbert Computing              ║
  46. *** ║                                                                    ║
  47. *** ╚════════════════════════════════════════════════════════════════════╝
  48. **/
  49.  
  50. call LoadFunctions
  51.  
  52. /* The configuration information is kept in an INI file.  Make sure this */
  53. /* file exists.                                                          */
  54.  
  55. IniFile = GetIniFile()
  56.  
  57. /* Parse the command */
  58.  
  59. parse arg cmd parms
  60. cmd = translate(cmd)  /* Convert to uppercase */
  61.  
  62. /* Save the current directory */
  63.  
  64. pwd = value("pwd",directory(),"OS2ENVIRONMENT")
  65. select
  66.    when abbrev('BACKUP'     ,cmd,  3) then call Backup          parms
  67.    when abbrev('CHANGED'    ,cmd,  3) then call Changed         parms
  68.    when abbrev('CHECK'      ,cmd,  3) then call Check           parms
  69.    when abbrev('CHK'        ,cmd,  3) then call Check           parms
  70.    when abbrev('COPYSAFE'   ,cmd,  4) then call CopySafe        parms
  71.    when abbrev('ENVIRONMENT',cmd,  3) then call Environment     parms
  72.    when abbrev('FORALL'     ,cmd,  6) then call ForAll          parms
  73.    when abbrev('LIB'        ,cmd,  3) then call Lib             parms
  74.    when abbrev('MAKE'       ,cmd,  3) then call Make            parms
  75.    when abbrev('MAXIMUS'    ,cmd,  3) then call Maximus         parms
  76.    when abbrev('MIGRATE'    ,cmd,  3) then call Migrate         parms
  77.    when abbrev('PROFILE'    ,cmd,  2) then call Profile         parms
  78.    when abbrev('PSTAT'      ,cmd,  2) then call PStat           parms
  79.    when abbrev('RECURSE'    ,cmd,  3) then call Recurse         parms
  80.    when abbrev('RESET'      ,cmd,  3) then call Reset           parms
  81.    when abbrev('REPEATS'    ,cmd,  3) then call Repeats         parms
  82.    when abbrev('SCANENVIRON',cmd,  4) then call Which           parms
  83.    when abbrev('SPACE'      ,cmd,  2) then call Space           parms
  84.    when abbrev('SYNCH'      ,cmd,  2) then call Synch           parms
  85.    when abbrev('TRACE'      ,cmd,  2) then call Trace           parms
  86.    when abbrev('WHICH'      ,cmd,  1) then call Which           parms
  87.    when abbrev('ZIP'        ,cmd,  1) then call Zip             parms
  88.    otherwise
  89.       say "Command '"cmd"' not recognized"
  90. end /* Select */
  91.  
  92. /* Return to the starting directory */
  93.  
  94. pwd = value("pwd",,"OS2ENVIRONMENT")
  95. code = directory(pwd)
  96. exit
  97.  
  98.  
  99. /**
  100. *** ┌──────────────────────────────────────────────────────────────────────┐
  101. *** │                          Synch Subroutines                           │
  102. *** └──────────────────────────────────────────────────────────────────────┘
  103. **/
  104.  
  105. Synch: procedure expose IniFile
  106.    parse arg cmd parms
  107.    parse upper var cmd cmd
  108.  
  109.    select
  110.       when abbrev('INI'   ,cmd,  3) then call SynchIni          parms
  111.       when abbrev('DEVL'  ,cmd,  4) then call SynchDevelopment  parms
  112.       when abbrev('C++'   ,cmd,  1) then call SynchClass        parms
  113.       otherwise
  114.          say "Subcommand (SYNCH): '"cmd"' not recognized"
  115.    end /* Select */
  116.    return
  117.  
  118.  
  119. SynchClass: procedure expose IniFile
  120.    /**
  121.    ***  This will synch the class library source with the development
  122.    ***  environment
  123.    **/
  124.  
  125.    BaseDir  = GetIni('Directory','Products','d:\products')
  126.    ClassDir = GetIni('Directory','Class Lib Source','d:\ibmcpp\hsource')
  127.  
  128.    code = directory(ClassDir)
  129.    CopyCount = 0
  130.    say
  131.    say 'Synching message files...'
  132.    CopyCount = CopyCount + CopySafe('*.msg' BaseDir'\data')
  133.    say
  134.    say 'Synching header files...'
  135.    CopyCount = CopyCount + CopySafe('*.hpp ..\hclass')
  136.    CopyCount = CopyCount + CopySafe('*.h   ..\hclass')
  137.  
  138.    call charout ,'Remake object library? '
  139.    pull answer
  140.    if answer = 'Y' then
  141.       do
  142.       call Lib 'make hclass'
  143.       say
  144.       say 'Synching object library...'
  145.       CopyCount = CopyCount + CopySafe('hclass.lib ..\hlib')
  146.       end
  147.    say "Total files synchronized:" CopyCount
  148.    return 0
  149.  
  150.  
  151. SynchDevelopment: procedure expose IniFile
  152.    /**
  153.    *** This will synchronize the development tools
  154.    **/
  155.  
  156.    parse arg SynchDir
  157.  
  158.    if SynchDir = '' then
  159.       do
  160.       SynchDir = "A:"
  161.       code = directory("A:\")
  162.       end
  163.  
  164.    BaseDir = GetIni('Directory','Products','')
  165.    '@replace /u' BaseDir'\*' SynchDir
  166.    '@replace /u' SynchDir'\*' BaseDir
  167.    '@replace /u' BaseDir'\CMD\*' SynchDir'\CMD'
  168.    '@replace /u' SynchDir'\CMD\*' BaseDir'\CMD'
  169.    return 0
  170.  
  171.  
  172. SynchIni: procedure expose IniFile
  173.    /**
  174.    *** This will synchronize the INI files for WWW, idioms and the Gatekeeper
  175.    **/
  176.  
  177.    parse arg SynchDir
  178.  
  179.    if SynchDir = '' then
  180.       SynchDir = "A:"
  181.  
  182.    BaseDir = GetIni('Directory','Idioms','d:\idioms')
  183.    '@replace /u' BaseDir'\*.ini' SynchDir
  184.    '@replace /u' SynchDir'\*.ini' BaseDir
  185.  
  186.    BaseDir = GetIni('Directory','GateKeeper','d:\GateKeeper')
  187.    '@replace /u' BaseDir'\*.ini' SynchDir
  188.    '@replace /u' SynchDir'\*.ini' BaseDir
  189.  
  190.    BaseDir = value("ETC",,"OS2ENVIRONMENT")
  191.    '@replace /u' BaseDir'\*.ini' SynchDir
  192.    '@replace /u' SynchDir'\*.ini' BaseDir
  193.    '@replace /u' BaseDir'\explore.???' SynchDir
  194.    '@replace /u' SynchDir'\explore.???' BaseDir
  195.    return
  196.  
  197. /**
  198. *** ┌──────────────────────────────────────────────────────────────────────┐
  199. *** │                            Lib Subroutines                           │
  200. *** └──────────────────────────────────────────────────────────────────────┘
  201. **/
  202.  
  203. Lib: procedure expose IniFile
  204.    parse arg cmd parms
  205.    parse upper var cmd cmd
  206.  
  207.    select
  208.       when abbrev('LIST'  ,cmd,  5) then call LibList      parms
  209.       when abbrev('MAKE'  ,cmd,  4) then call LibMake      parms
  210.       otherwise
  211.          say "Subcommand (LIB): '"cmd"' not recognized"
  212.    end /* Select */
  213.    return
  214.  
  215.  
  216. LibMake: procedure expose IniFile
  217.    /**
  218.    *** This will create a library from the object modules in that directory
  219.    **/
  220.  
  221.    parse arg library
  222.  
  223.    library = translate(strip(library))
  224.  
  225.    if left(library,4) = '.LIB' then
  226.       parse var library library '.LIB' .
  227.  
  228.    if library = '' then
  229.       do
  230.       call Error 2004,0,"You must specify a library name."
  231.       return 16
  232.       end
  233.  
  234.  
  235.    call SysFileTree '*.obj', 'Found', 'FO'
  236.    do i = 1 to Found.0
  237.       objfile = translate(found.i)
  238.       parse var objfile objfile '.OBJ' .
  239.       say 'Updating' objfile'...'
  240.       '@lib' library '/q -+'objfile';'
  241.    end
  242.    return 0
  243.  
  244.  
  245. LibList: procedure expose IniFile
  246.    /**
  247.    ***  This will augment the inherently crappy LIB utility to search
  248.    ***  for entry points within a library and to enable usage with
  249.    ***  utilities like GREP
  250.    **/
  251.  
  252.    parse arg library
  253.  
  254.    library = translate(strip(library))
  255.  
  256.    if left(library,4) <> '.LIB' then
  257.       library = library'.LIB'
  258.  
  259.    if exists(library) = 0 then
  260.       do
  261.       call Error 2002,0,library
  262.       return
  263.       end
  264.  
  265.  
  266.    tmp = value("TMP",,"OS2ENVIRONMENT")
  267.    if tmp = '' then
  268.       do
  269.       call Error 2008,0,'TMP','Defaulting to current directory'
  270.       tmp = '.'
  271.       end
  272.  
  273.    /* Clean up any files from past runs */
  274.  
  275.    '@del' tmp'\$LIB????.LIB 2>NUL'
  276.    '@del' tmp'\$LIB????.LST 2>NUL'
  277.  
  278.    templib = SysTempFileName(tmp'\$LIB????.LIB')
  279.    templst = SysTempFileName(tmp'\$LIB????.LST')
  280.  
  281.    say 'Generating listing for' library'. Please wait...'
  282.  
  283.    '@copy' library templib '1>NUL'
  284.    '@lib /nologo' templib','templst
  285.    '@type' templst
  286.  
  287.    code = SysFileDelete(templib)
  288.    code = SysFileDelete(templst)
  289.    return
  290.  
  291. /**
  292. *** ┌──────────────────────────────────────────────────────────────────────┐
  293. *** │                           Make Subroutines                           │
  294. *** └──────────────────────────────────────────────────────────────────────┘
  295. **/
  296.  
  297.  
  298. Make: procedure expose IniFile
  299.    /**
  300.    ***  This will call the NMAKE code with some preprocessing for managing
  301.    ***  projects
  302.    **/
  303.  
  304.    parse arg Options
  305.  
  306.    Opt.       = ''
  307.    Opt.Flag.Q = '-'     /* Default to display "Done" msg */
  308.    Opt.Flag.E = '+'     /* Edit the output               */
  309.    Opt.Flag.D = '+'     /* Debug                         */
  310.    Opt.Flag.O = '-'     /* Old Make                      */
  311.    Opt.Flag.L = '-'     /* Create DLL                    */
  312.  
  313.    EnvOpt = value("MMAKE.OPT",,"OS2ENVIRONMENT")
  314.    call ParseOptions EnvOpt Options
  315.  
  316.    if Opt.Flag.SYNTAX = '+' then
  317.       do
  318.       call MakeSyntax
  319.       return
  320.       end
  321.  
  322.    Project = Opt.Parm.1
  323.    Opt.Flag.S = translate(Opt.Flag.S)
  324.  
  325.    /* If nothing was passed, use an environment variable */
  326.  
  327.    if project = '' then
  328.       project = value("PROJECT",,"OS2ENVIRONMENT")
  329.  
  330.    if project = '' then
  331.       do
  332.       say "I don't know what to MAKE"
  333.       exit
  334.       end
  335.  
  336.    makefile = project'.mak'
  337.    temp     = project'.tmp'
  338.  
  339.    /* Get rid of the old temp file */
  340.  
  341.    if Exists(temp) then '@erase' temp
  342.  
  343.    /* Parse and process the options */
  344.  
  345.    if Opt.Parm.O = '+' then
  346.       make = "@make"
  347.    else
  348.       make = "@nmake /NOLOGO"
  349.  
  350.    macros = ""
  351.    if Opt.Flag.D = '+' then macros = '"DEBUG=Y"' macros
  352.    if Opt.Flag.L = '+' then macros = '"DLL=Y"' macros
  353.  
  354.    select
  355.       when pos("D",Opt.Flag.S) > 0 then macros = '"DBM=Y"' macros
  356.       when pos("T",Opt.Flag.S) > 0 then macros = '"TCP=Y"' macros
  357.       when pos("C",Opt.Flag.S) > 0 then macros = '"CM=Y"' macros
  358.       when pos("R",Opt.Flag.S) > 0 then macros = '"REXX=Y"' macros
  359.       otherwise
  360.          nop
  361.    end /* select */
  362.  
  363.    /* Invoke the proper MAKE utility with the proper options */
  364.  
  365.    call Time('Reset')
  366.    make macros makefile
  367.    say "The make took" Format(Time("Elapsed"),,2) "seconds."
  368.  
  369.    /* Display the completion dialog box and edit the output */
  370.  
  371.    if Opt.Flag.Q = '-' then
  372.       do
  373.       parse upper var project project
  374.       Notify = GetIni('Program','Notify','msg.exe')
  375.       '@'Notify 'Make for' project 'complete.'
  376.       end
  377.  
  378.    if Opt.Flag.E = '+' then
  379.       if Exists(temp) then
  380.          do
  381.          'pause'
  382.          '@kedit' temp
  383.          end
  384.    return
  385.  
  386.  
  387. MakeSyntax: procedure
  388.    /**
  389.    *** This will display the syntax for the MAKE subcommand
  390.    **/
  391.  
  392.    say "SYNTAX:  $ MAKE [[[[[-q] -e] -s{d|t|c|r}] -l] [project]"
  393.    say "   where:  q - quiet"
  394.    say "           e - edit"
  395.    say "           s - subsystem flags as follows:"
  396.    say "                  d  - DB2/2"
  397.    say "                  t  - TCP/IP"
  398.    say "                  c  - CM/2"
  399.    say "                  r  - REXX"
  400.    say "           l - create DLL"
  401.    return
  402.  
  403.  
  404. /**
  405. *** ┌──────────────────────────────────────────────────────────────────────┐
  406. *** │                          Backup Subroutines                          │
  407. *** └──────────────────────────────────────────────────────────────────────┘
  408. **/
  409.  
  410.  
  411. Backup: procedure expose IniFile
  412.    parse arg cmd parms
  413.    parse upper var cmd cmd
  414.  
  415.    select
  416.       when abbrev('CHRON'  ,cmd,  5) then call BackupChron   parms
  417.       when abbrev('CONFIG' ,cmd,  4) then call BackupConfig  parms
  418.       otherwise
  419.          say "Subcommand (BACKUP): '"cmd"' not recognized"
  420.    end /* Select */
  421.    return
  422.  
  423.  
  424. BackupConfig: procedure expose IniFile
  425.    /**
  426.    ***  This will backup multiple generations of the CONFIG.SYS file.  It
  427.    ***  will only back it up if it has changed (i.e. the archive bit is on)
  428.    **/
  429.  
  430.  
  431.    Boot = GetIni('Directory','Boot','c:\')
  432.    Backup = GetIni('Directory','Backup','d:\backup')
  433.    call SysFileTree Boot'CONFIG.SYS', 'Found', 'F', '+****', '-****'
  434.    if Found.0 then
  435.       do
  436.       FileExt = right(date("days"),3,"0")  /* Julian date padded w/ 0's */
  437.       'copy' Boot'CONFIG.SYS' Backup'\CONFIG.'FileExt
  438.       '@attrib -A' Boot'CONFIG.SYS'
  439.       end
  440.  
  441.    /* Keep the number of config backups to a reasonable number */
  442.  
  443.    DeleteCount = DeleteOldFiles(Backup'\CONFIG.*', 10)
  444.    return;
  445.  
  446.  
  447. BackupChron: procedure expose IniFile
  448.    /**
  449.    ***  This will backup the CHRON.DAT file.  If this is a daily backup,
  450.    ***  the file is created with an extension equal to the first three
  451.    ***  letters of the day of the week.  If this is a weekly backup, the
  452.    ***  file is created with an extension of ".BKW".  Otherwise, the
  453.    ***  file is ".SAV"
  454.    **/
  455.  
  456.    arg parms
  457.  
  458.    select
  459.       when abbrev('DAILY' ,parms, 1) then
  460.          Destination = 'chron.'left(date('W'),3)
  461.       when abbrev('WEEKLY',parms, 1) then
  462.          Destination = 'chron.bkw'
  463.       otherwise
  464.          Destination = 'chron.sav'
  465.    end /* select */
  466.  
  467.    ChronDir  = GetIni('Directory','Chron','')
  468.    BackupDir = GetIni('Directory','Backup','')
  469.  
  470.    'copy' ChronDir'\chron.dat' BackupDir'\'Destination
  471.    return;
  472.  
  473. /**
  474. *** ┌──────────────────────────────────────────────────────────────────────┐
  475. *** │ CopySafe Subroutines                                                 │
  476. *** └──────────────────────────────────────────────────────────────────────┘
  477. **/
  478.  
  479. CopySafe: procedure expose IniFile
  480.    /**
  481.    ***  This will check the time/date stamps on the files before copying
  482.    ***  them.
  483.    **/
  484.  
  485.    parse arg Options
  486.  
  487.    /* Set defaults and parse the command line parameters */
  488.  
  489.    Opt.Flag.P = '-'     /* Don't prompt before copying */
  490.    Opt.Flag.C = '-'     /* Don't compare before copying */
  491.    Opt.Flag.V = '-'     /* Default to non-verbose output */
  492.    Opt.Parm.2 = '.'     /* Dest defaults to current directory */
  493.  
  494.    call ParseOptions Options
  495.  
  496.    if Opt.Flag.SYNTAX = '+' then
  497.       call Syntax
  498.  
  499.    if Opt.Flag.C = '+' then
  500.       Opt.Flag.P = '+'
  501.  
  502.    /* The destination must be a directory */
  503.  
  504.    DestDir = QualifiedDirectory(Opt.Parm.2)
  505.    if DestDir = '' then
  506.       do
  507.       call Error 2003,0,Opt.Parm.2
  508.       return 0
  509.       end
  510.  
  511.    if Opt.Flag.C = '+' then
  512.       contrast = GetIni('Program','Contrast','contrast.exe')
  513.  
  514.    /* Generate the list of file to potentially copy */
  515.  
  516.    CopyCount = 0
  517.    call SysFileTree Opt.Parm.1,'File','f'
  518.    do i = 1 to File.0
  519.       code = CopyFile(File.i, DestDir)
  520.    end
  521.    say "       " CopyCount "file(s) copied."
  522.    return CopyCount
  523.  
  524.  
  525. CopyFile: procedure expose Opt.  CopyCount contrast
  526.    /**
  527.    ***  Copy the file to the destination if the dest is older than the
  528.    ***  source.  Otherwise, compare or prompt as appropriate.
  529.    **/
  530.  
  531.    parse arg fdate ftime . . SourceFile, DestDir
  532.  
  533.    DestDir = strip(DestDir,'Trailing','\')
  534.    DestFile = DestDir'\'filespec('Name',SourceFile)
  535.    SourceFile = strip(SourceFile,'Both')
  536.  
  537.    /* See if the file exists */
  538.  
  539.    call SysFileTree DestFile,'File','F'
  540.    select
  541.       when File.0 = 0 then /* No file */
  542.          CopyState = 'Yes'
  543.       when File.0 = 1 then /* Found */
  544.          do
  545.          parse var File.1 dfdate dftime .
  546.  
  547.          TimeStamp = CompareFileTimes(dfdate dftime,fdate ftime)
  548.  
  549.          select
  550.             when TimeStamp = '<' then
  551.                CopyState = 'Conditional'
  552.             when TimeStamp = '=' then
  553.                CopyState = 'No'
  554.             otherwise
  555.                CopyState = 'Conditional'
  556.          end /* select */
  557.          end
  558.       otherwise
  559.          return 4
  560.    end /* select */
  561.  
  562.    if CopyState = 'Conditional' then
  563.       do
  564.  
  565.       /* Do any necessary displays and prompting */
  566.  
  567.       if Opt.Flag.C = '+' then
  568.          '@'contrast SourceFile DestFile
  569.  
  570.       if Opt.Flag.P = '+' then
  571.          do
  572.          say 'Copy: ('left(fdate ftime, 16)')' SourceFile
  573.          call charout ,'To:   ('left(dfdate dftime, 16)')' DestFile'? '
  574.          CopyState = GetPromptForCopy()
  575.          end /* Prompt */
  576.       else
  577.          CopyState = 'Yes'
  578.       end /* conditional */
  579.  
  580.    if CopyState = 'Yes' then
  581.       do
  582.       if Opt.Flag.V = '+' then
  583.          say 'Copying "'SourceFile'" to "'DestFile'"...'
  584.       else
  585.          say SourceFile
  586.       '@COPY' SourceFile DestFile '> nul'
  587.       CopyCount = CopyCount + 1
  588.       end
  589.    else
  590.       if Opt.Flag.V = '+' then
  591.          say 'Skipping "'SourceFile'"...'
  592.    return 0
  593.  
  594. GetPromptForCopy: procedure
  595.    /**
  596.    ***  This will get the response from the prompt for copy
  597.    **/
  598.  
  599.    Key = SysGetKey('NOECHO')
  600.    Key = translate(Key)
  601.    if Key = 'Y' then
  602.       do
  603.       /* Verify */
  604.  
  605.       call charout ,"Sure?"
  606.       Key = SysGetKey('NOECHO')
  607.       Key = translate(Key)
  608.       if Key = 'Y' then
  609.          CopyState = 'Yes'
  610.       else
  611.          CopyState = 'No'
  612.       end
  613.    else
  614.       CopyState = 'No'
  615.    say
  616.    return CopyState
  617.  
  618.  
  619. /**
  620. *** ┌──────────────────────────────────────────────────────────────────────┐
  621. *** │ ForAll Subroutines                                                   │
  622. *** └──────────────────────────────────────────────────────────────────────┘
  623. **/
  624.  
  625.  
  626. ForAll: procedure expose IniFile
  627.    /**
  628.    ***  This will execute the command for each file in the list
  629.    **/
  630.  
  631.    parse arg FileList Cmd
  632.  
  633.    /* Set defaults and parse the command line parameters */
  634.  
  635.    call ParseOptions Options
  636.  
  637.    call SysFileTree FileList, 'Found', 'FO'
  638.    do i = 1 to Found.0
  639.       if pos('%',Cmd) = 0 then
  640.          ExecCmd = Cmd Found.i
  641.       else
  642.          ExecCmd = MapSymbol(Cmd, '%', Found.i)
  643.       '@'ExecCmd
  644.    end
  645.    return
  646.  
  647.  
  648. /**
  649. *** ┌──────────────────────────────────────────────────────────────────────┐
  650. *** │ Repeats Subroutines                                                  │
  651. *** └──────────────────────────────────────────────────────────────────────┘
  652. **/
  653.  
  654.  
  655. Repeats: procedure expose IniFile
  656.    /**
  657.    ***  This will list the files that are duplicated on a series of disks
  658.    **/
  659.  
  660.    arg DriveList
  661.  
  662.    if DriveList = '' then
  663.       DriveList = SysDriveMap('C:', 'LOCAL')
  664.  
  665.    List.  = ''
  666.    List.0 = 0
  667.  
  668.    Compare.  = ''
  669.    Compare.0 = 0
  670.  
  671.    Dups.  = ''
  672.    Dups.0 = 0
  673.  
  674.    do i = 1 to words(DriveList)
  675.       Drive = left(word(DriveList, i),1)
  676.  
  677.       say "Obtaining files list for drive" Drive"..."
  678.       call SysFileTree Drive':\*','More','SF'
  679.       say "Found" More.0 "files."
  680.  
  681.       /* Move this files to the end of the list */
  682.  
  683.       do j = 1 to More.0
  684.          parse var More.j . . . . FullName
  685.          Name = FileSpec("name",FullName)
  686.          w = List.0 + j
  687.          List.w    = More.j
  688.          Compare.w = translate(Name)
  689.       end
  690.       List.0 = List.0 + More.0
  691.    end
  692.  
  693.    /* Search for duplicates */
  694.  
  695.    say "Searching for duplicates. Total files:" List.0". This may take a long time."
  696.    say "A '.' means the list has been scanned for a file.  A '+' means a match."
  697.  
  698.    do i = 1 to List.0
  699.       call charout ,"."
  700.       do j = (i+1) to List.0
  701.          if List.j <> '' then
  702.             do
  703.             if Compare.i == Compare.j then
  704.                do
  705.                w = Dups.0 + 1
  706.                Dups.0 = w
  707.                Dups.w = Compare.i"~"List.i"~"List.j
  708.                call charout ,"+"
  709.                List.j = ''
  710.                end
  711.             end
  712.       end
  713.    end
  714.  
  715.    say
  716.    Repeats  = GetIni('File','Repeats','d:\temp\repeats.out')
  717.    Repeats = Open(Repeats,'WRITE')
  718.    do i = 1 to Dups.0
  719.       parse var Dups.i UpCase "~" Date1 Time1 Size1 . Full1 "~" Date2 Time2 Size2 . Full2
  720.       Name = filespec("name",Full1)
  721.       call lineout Repeats,Name
  722.       call lineout Repeats,right(Date1,12) right(Time1,9) right(Size1,11) Full1
  723.       call lineout Repeats,right(Date2,12) right(Time2,9) right(Size2,11) Full2
  724.    end
  725.    code = Close(Repeats)
  726.    Editor  = GetIni('Program','Editor','e.exe')
  727.    '@'editor Repeats
  728.    return
  729.  
  730. /**
  731. *** ┌──────────────────────────────────────────────────────────────────────┐
  732. *** │ Reset Subroutines                                                    │
  733. *** └──────────────────────────────────────────────────────────────────────┘
  734. **/
  735.  
  736. Reset: procedure expose IniFile
  737.    /**
  738.    ***  The PROFILE command will configure an OS/2 command prompt session
  739.    **/
  740.  
  741.    parse arg cmd parms
  742.    cmd = translate(cmd)
  743.  
  744.    select
  745.       when abbrev('ENVIRONMENT',cmd, 3)  then call ResetEnvironment  parms
  746.       when abbrev('SET'        ,cmd, 3)  then call ResetEnvironment  parms
  747.       when abbrev('PROFILE'    ,cmd, 3)  then call ResetProfile      parms
  748.       otherwise
  749.          say "Subcommand (RESET): '"cmd"' not recognized"
  750.    end /* Select */
  751.    return
  752.  
  753.  
  754. ResetProfile: procedure expose IniFile
  755.    /**
  756.    ***  This will remove the current parameters for the project information
  757.    ***  used by the PROFILE command.  The next time the PROFILE subcommand
  758.    ***  is run, it will prompt for the new values.
  759.    **/
  760.  
  761.  
  762.    Opt.       = ''
  763.    Opt.Flag.P = '+'   /* Default to prompting for which to delete */
  764.    parse arg Options
  765.    call ParseOptions Options
  766.  
  767.    project = Opt.Parm.1
  768.    if project = '' then
  769.       project = value("PROJECT",,"OS2ENVIRONMENT")
  770.  
  771.    if project = '' then
  772.       do
  773.       call Error 2004,0
  774.       return
  775.       end
  776.  
  777.    project = LowerCase(project)
  778.    Application = 'Project:' project
  779.  
  780.    if Opt.Flag.P = '-' then
  781.       code = SysIni(Inifile, Application, 'DELETE:')
  782.    else
  783.       do
  784.       code = SysIni(Inifile,Application, 'ALL:','key')
  785.       do i = 1 to key.0
  786.          IniValue = SysIni(IniFile,Application, key.i)
  787.          if IniValue = 'ERROR:' then IniValue = ''
  788.          say "Enter value for"
  789.          say "            Key: '"key.i"'"
  790.          say "        Default: '"IniValue"'"
  791.          call charout ,"> "
  792.          parse pull IniValue
  793.          if IniValue <> '' then
  794.             code = SysIni(IniFile,Application,key.i,IniValue)
  795.       end /* do i... */
  796.       end
  797.    say 'Entry reset for Project:' project'.'
  798.    call charout ,"Re-profile? "
  799.    pull answer
  800.    if answer = "Y" then
  801.       call Profile project
  802.    return
  803.  
  804.  
  805.  
  806. ResetEnvironment: procedure expose IniFile
  807.    /**
  808.    ***  This will reset the enviroment variables back to the values in the
  809.    ***  CONFIG.SYS
  810.    **/
  811.  
  812.    Grep = GetIni('Program','Grep','grep.exe')
  813.    Boot = GetIni('Directory','Boot','c:\')
  814.  
  815.    '@'Grep '-i "^set .*\="' Boot'config.sys | rxqueue'
  816.  
  817.    say 'Resetting' queued() 'environment variables...'
  818.  
  819.    do i = 1 to queued()
  820.       parse pull SetStatement
  821.       '@'SetStatement
  822.    end
  823.    say 'Done.'
  824.    return
  825.  
  826. /**
  827. *** ┌──────────────────────────────────────────────────────────────────────┐
  828. *** │ Profile Subroutines                                                  │
  829. *** └──────────────────────────────────────────────────────────────────────┘
  830. **/
  831.  
  832. Profile: procedure expose IniFile
  833.    /**
  834.    ***  The PROFILE command will configure an OS/2 command prompt session
  835.    **/
  836.  
  837.    parse arg cmd project .
  838.  
  839.    /**
  840.    *** Determine if this is using the profile type from the command line
  841.    *** (two positional words) or if it is using the information in the
  842.    *** profile to determine what the type is.
  843.    **/
  844.  
  845.    if project = '' then /* use the profile */
  846.       do
  847.       project = cmd  /* Shift the parameters down 1 */
  848.       cmd     = GetProfile(project,'Project Type','IBMCPP')
  849.       end
  850.  
  851.    cmd = translate(cmd)
  852.  
  853.    /* Change the number of lines on the screen */
  854.  
  855.    mode = GetIni('Global','Mode','co80,25')
  856.    '@mode' mode
  857.    call SysCls
  858.    say 'Setting environment variables...'
  859.    project = LowerCase(project)
  860.  
  861.    if project = '' then
  862.       do
  863.       call Error 2004,0
  864.       return
  865.       end
  866.  
  867.    select
  868.       when abbrev('AWK'     ,cmd, 1)      then call ProfileAWK        project
  869.       when abbrev('IBMC'    ,cmd, 3)      then call ProfileIBM        project
  870.       when abbrev('IBMCPP'  ,cmd, 5)      then call ProfileIBM        project
  871.       when abbrev('CPP'     ,cmd, 5)      then call ProfileIBM        project
  872.       when abbrev('CSET'    ,cmd, 5)      then call ProfileIBM        project
  873.       when abbrev('IPF'     ,cmd, 3)      then call ProfileIPF        project
  874.       when abbrev('INF'     ,cmd, 3)      then call ProfileIPF        project
  875.       when abbrev('BUILDINF',cmd, 5)      then call ProfileIPF        project
  876.       when abbrev('BUILDIPF',cmd, 7)      then call ProfileIPF        project
  877.       when abbrev('MSFTC'   ,cmd, 2)      then call ProfileMS         project
  878.       when abbrev('MSC'     ,cmd, 2)      then call ProfileMS         project
  879.       when abbrev('REXX'    ,cmd, 2)      then call ProfileRexx       project
  880.       when abbrev('CMD'     ,cmd, 2)      then call ProfileRexx       project
  881.       when abbrev('GENERIC' ,cmd, 1)      then call ProfileGeneric    project
  882.       when abbrev('.'       ,cmd, 1)      then call ProfileGeneric    project
  883.       when abbrev('X'       ,cmd, 1)      then call ProfileGeneric    project
  884.       otherwise
  885.          say "Subcommand (PROFILE): '"cmd"' not recognized"
  886.    end /* Select */
  887.    return
  888.  
  889.  
  890. ProfileIBM: procedure expose IniFile
  891.    /**
  892.    ***  This will configure an OS/2 session for using the IBM C Set
  893.    ***  compiler
  894.    **/
  895.  
  896.    parse arg project
  897.  
  898.    NoAdditional = 'No Additional Paths'
  899.  
  900.    /* Get profile information */
  901.  
  902.    Toolkit = GetIni('Directory','2.x Toolkit','')
  903.    CBase   = GetIni('Directory','IBM C Base','')
  904.  
  905.    ext     = GetProfile(project,'Default Ext','cpp')
  906.    spath   = GetProfile(project,'Source Path',directory())
  907.    apath   = GetProfile(project,'Archive Path',spath'\Archive')
  908.    addlinc = GetProfile(project,'Additional include paths',NoAdditional)
  909.    addllib = GetProfile(project,'Additional LIB paths',NoAdditional)
  910.    mpath   = GetProfile(project,'Make Path','d:\products\data')
  911.    defmake = GetProfile(project,'Default make options','-e -d')
  912.  
  913.    /* Create the archive directory if one doesn't exist */
  914.  
  915.    if Exists(spath) = 0 then
  916.       code = SysMkDir(spath)
  917.  
  918.    if Exists(apath) = 0 then
  919.       code = SysMkDir(apath)
  920.  
  921.    say "Refreshing the NMAKE386.INC file from" mpath"..."
  922.    '@copy' mpath'\nmake386.inc' spath
  923.  
  924.    if addlinc = NoAdditional then
  925.       addlinc = ''
  926.    else
  927.       addlinc = strip(addlinc,'Trailing',';')';'
  928.  
  929.    if addllib = NoAdditional then
  930.       addllib = ''
  931.    else
  932.       addllib = strip(addllib,'Trailing',';')';'
  933.  
  934.    Include = addlinc||Toolkit"\cplus\os2h;"Toolkit"\c\os2h;"CBase"\include;"CBase"\ibmclass;"CBase"\HClass"
  935.    Lib     = addllib||Toolkit"\os2lib;"CBase"\lib;"CBase"\HLib"
  936.  
  937.    Env = value("PROJECT"        ,project                         ,"OS2ENVIRONMENT")
  938.    Env = value("Last Kedit File",project"."ext                   ,"OS2ENVIRONMENT")
  939.    Env = value("INCLUDE"        ,Include                         ,"OS2ENVIRONMENT")
  940.    Env = value("INCLUDETOOLS"   ,Toolkit"\c\os2h"                ,"OS2ENVIRONMENT")
  941.    Env = value("INCLUDEC"       ,CBase"\include;"CBase"\ibmclass","OS2ENVIRONMENT")
  942.    Env = value("LIB"            ,Lib                             ,"OS2ENVIRONMENT")
  943.    Env = value("IPFC"           ,Toolkit"\ipfc"                  ,"OS2ENVIRONMENT")
  944.    Env = value("MMAKE.OPT"      ,defmake                         ,"OS2ENVIRONMENT")
  945.    Env = value("SOURCEPATH"     ,spath                           ,"OS2ENVIRONMENT")
  946.    Env = value("ARCHIVEPATH"    ,apath                           ,"OS2ENVIRONMENT")
  947.    Env = value("MAKEPATH"       ,mpath                           ,"OS2ENVIRONMENT")
  948.  
  949.    /* Re-build the path with the executables for this compiler and toolkit */
  950.    /* in front.                                                            */
  951.  
  952.    EnvVal  = value("PATH", , "OS2ENVIRONMENT")
  953.    EnvPath = value("PATH", CBase"\bin;"Toolkit"\os2bin;"EnvVal,  "OS2ENVIRONMENT")
  954.  
  955.    /* Do the same to the HELP environment variable */
  956.  
  957.    EnvVal  = value("HELP", , "OS2ENVIRONMENT")
  958.    EnvHelp = value("HELP", Toolkit"\os2help;"EnvVal,  "OS2ENVIRONMENT")
  959.  
  960.    /* Do the same to the BOOKSHELF environment variable */
  961.  
  962.    EnvVal  = value("BOOKSHELF", , "OS2ENVIRONMENT")
  963.    EnvBook = value("BOOKSHELF", CBase"\book;"Toolkit"\book;"EnvVal,  "OS2ENVIRONMENT")
  964.  
  965.    pwd = value("pwd",spath,"OS2ENVIRONMENT")  /* Change default directory */
  966.    return
  967.  
  968.  
  969. ProfileMS: procedure expose IniFile
  970.    /**
  971.    ***  This will configure an OS/2 session for using MSC and the OS/2 v1.3
  972.    ***  Toolkit
  973.    **/
  974.  
  975.    parse arg project
  976.  
  977.    /* Get profile information */
  978.  
  979.    Toolkit = GetIni('Directory','1.3 Toolkit','')
  980.    CBase   = GetIni('Directory','IBM C Base','')
  981.  
  982.    ext     = GetProfile(project,'Default Ext','c')
  983.    spath   = GetProfile(project,'Source Path',directory())
  984.    apath   = GetProfile(project,'Archive Path',spath'\Archive')
  985.    mpath   = GetProfile(project,'Make Path','d:\products\data')
  986.    defmake = GetProfile(project,'Default make options','-e -d')
  987.  
  988.    Env = value("PROJECT",      project,                            "OS2ENVIRONMENT")
  989.    Env = value("Last Kedit File",       project"."ext                      ,"OS2ENVIRONMENT")
  990.    Env = value("INCLUDE",      Toolkit"\c\include;"CBase"\include","OS2ENVIRONMENT")
  991.    Env = value("INCLUDETOOLS", Toolkit"\c\include",                "OS2ENVIRONMENT")
  992.    Env = value("INCLUDEC",     CBase"\include",                    "OS2ENVIRONMENT")
  993.    Env = value("LIB",          Toolkit"\lib;"CBase"\lib" ,         "OS2ENVIRONMENT")
  994.    Env = value("IPFC",         Toolkit"\ipfc" ,                    "OS2ENVIRONMENT")
  995.    Env = value("MMAKE.OPT"    ,defmake                            ,"OS2ENVIRONMENT")
  996.    Env = value("SOURCEPATH"   ,spath                              ,"OS2ENVIRONMENT")
  997.    Env = value("ARCHIVEPATH"  ,apath                              ,"OS2ENVIRONMENT")
  998.    Env = value("MAKEPATH"     ,mpath                              ,"OS2ENVIRONMENT")
  999.  
  1000.    EnvPath = value("PATH", , "OS2ENVIRONMENT")
  1001.    EnvPath = value("PATH", CBase"\bin;"Toolkit"\bin;"EnvPath, "OS2ENVIRONMENT")
  1002.  
  1003.    /* Do the same to the HELP environment variable */
  1004.  
  1005.    EnvHelp = value("HELP", , "OS2ENVIRONMENT")
  1006.    EnvHelp = value("HELP", Toolkit"\os2help;"EnvHelp, "OS2ENVIRONMENT")
  1007.  
  1008.    pwd = value("pwd",spath,"OS2ENVIRONMENT")  /* Change default directory */
  1009.    return
  1010.  
  1011.  
  1012. ProfileRexx: procedure expose IniFile
  1013.    /**
  1014.    ***  This will configure an OS/2 session for working with REXX
  1015.    **/
  1016.  
  1017.    parse arg project
  1018.  
  1019.    RexxDir = GetIni('Directory','REXX','')
  1020.  
  1021.    ext     = GetProfile(project,'Default Ext','rex')
  1022.    spath   = GetProfile(project,'Source Path',directory())
  1023.    apath   = GetProfile(project,'Archive Path',spath'\Archive')
  1024.    mpath   = GetProfile(project,'Make Path','d:\products\data')
  1025.    defmake = GetProfile(project,'Default make options','-e- -q')
  1026.  
  1027.    say "Refreshing the NMAKE386.INC file from" mpath"..."
  1028.    '@copy' mpath'\nmake386.inc' spath
  1029.  
  1030.    Env = value("INCLUDE"      ,RexxDir"\Include" ,"OS2ENVIRONMENT")
  1031.    Env = value("PROJECT"      ,project           ,"OS2ENVIRONMENT")
  1032.    Env = value("Last Kedit File"       ,project"."ext     ,"OS2ENVIRONMENT")
  1033.    Env = value("MMAKE.OPT"    ,defmake           ,"OS2ENVIRONMENT")
  1034.    Env = value("SOURCEPATH"   ,spath             ,"OS2ENVIRONMENT")
  1035.    Env = value("ARCHIVEPATH"  ,apath             ,"OS2ENVIRONMENT")
  1036.    Env = value("MAKEPATH"     ,mpath             ,"OS2ENVIRONMENT")
  1037.  
  1038.    pwd = value("pwd",spath,"OS2ENVIRONMENT")  /* Change default directory */
  1039.    return
  1040.  
  1041.  
  1042.  
  1043. ProfileAWK: procedure expose IniFile
  1044.    /**
  1045.    ***  This will configure an OS/2 session for AWK development
  1046.    **/
  1047.  
  1048.    parse arg project
  1049.  
  1050.    Env = value("PROJECT", project, "OS2ENVIRONMENT")
  1051.    Env = value("Last Kedit File", project".awk" , "OS2ENVIRONMENT")
  1052.    return
  1053.  
  1054.  
  1055. ProfileIPF: procedure expose IniFile
  1056.    /**
  1057.    ***  This will configure an OS/2 session for IPF (View Books) development
  1058.    **/
  1059.  
  1060.    parse arg project
  1061.  
  1062.    Include = GetIni('Directory','IPF Include','')
  1063.  
  1064.    ext     = GetProfile(project,'Default Ext','ipf')
  1065.    spath   = GetProfile(project,'Source Path',directory())
  1066.    apath   = GetProfile(project,'Archive Path',spath'\Archive')
  1067.    mpath   = GetProfile(project,'Make Path','d:\products\data')
  1068.    defmake = GetProfile(project,'Default make options','-e- -q')
  1069.  
  1070.    say "Refreshing the NMAKE386.INC file from" mpath"..."
  1071.    '@copy' mpath'\nmake386.inc' spath
  1072.  
  1073.    Env = value("INCLUDE"    ,Include       ,"OS2ENVIRONMENT")
  1074.    Env = value("PROJECT"    ,project       ,"OS2ENVIRONMENT")
  1075.    Env = value("Last Kedit File"     ,project"."ext ,"OS2ENVIRONMENT")
  1076.    Env = value("MMAKE.OPT"  ,defmake       ,"OS2ENVIRONMENT")
  1077.    Env = value("SOURCEPATH" ,spath         ,"OS2ENVIRONMENT")
  1078.    Env = value("ARCHIVEPATH",apath         ,"OS2ENVIRONMENT")
  1079.    Env = value("MAKEPATH"   ,mpath         ,"OS2ENVIRONMENT")
  1080.  
  1081.    pwd = value("pwd",spath,"OS2ENVIRONMENT")  /* Change default directory */
  1082.    return
  1083.  
  1084.  
  1085. ProfileGeneric: procedure expose IniFile
  1086.    /**
  1087.    ***  This will configure an OS/2 session for a generic work environment
  1088.    ***  It will set the mode, PROJECT and and profile variables.
  1089.    **/
  1090.  
  1091.    parse arg project
  1092.  
  1093.    ext     = GetProfile(project,'Default Ext','ipf')
  1094.    spath   = GetProfile(project,'Source Path',directory())
  1095.    apath   = GetProfile(project,'Archive Path',spath'\Archive')
  1096.    mpath   = GetProfile(project,'Make Path','d:\products\data')
  1097.    defmake = GetProfile(project,'Default make options','-e- -q')
  1098.  
  1099.    say "Refreshing the NMAKE386.INC file from" mpath"..."
  1100.    '@copy' mpath'\nmake386.inc' spath
  1101.  
  1102.    Env = value("PROJECT"    ,project       ,"OS2ENVIRONMENT")
  1103.    Env = value("Last Kedit File"     ,project"."ext ,"OS2ENVIRONMENT")
  1104.    Env = value("MMAKE.OPT"  ,defmake       ,"OS2ENVIRONMENT")
  1105.    Env = value("SOURCEPATH" ,spath         ,"OS2ENVIRONMENT")
  1106.    Env = value("ARCHIVEPATH",apath         ,"OS2ENVIRONMENT")
  1107.    Env = value("MAKEPATH"   ,mpath         ,"OS2ENVIRONMENT")
  1108.  
  1109.    pwd = value("pwd",spath,"OS2ENVIRONMENT")  /* Change default directory */
  1110.    return
  1111.  
  1112. /**
  1113. *** ┌──────────────────────────────────────────────────────────────────────┐
  1114. *** │                          Trace Subroutines                           │
  1115. *** └──────────────────────────────────────────────────────────────────────┘
  1116. **/
  1117.  
  1118. Trace: procedure expose IniFile
  1119.    /**
  1120.    ***  This will trace the feature that is specified
  1121.    **/
  1122.  
  1123.    parse arg cmd parms
  1124.    cmd = translate(cmd)
  1125.  
  1126.    /* Change the number of lines on the screen */
  1127.  
  1128.    select
  1129.       when abbrev('APPC'   ,cmd, 1)      then call TraceAPPC parms
  1130.       otherwise
  1131.          say "Subcommand (TRACE): '"cmd"' not recognized"
  1132.    end /* Select */
  1133.    return
  1134.  
  1135.  
  1136. TraceAPPC: procedure expose IniFile
  1137.    /**
  1138.    ***  This will trace CM/2 APPC traffic
  1139.    **/
  1140.  
  1141.    '@cmtrace start /api appc /data ibmtrnet /reset > NUL'
  1142.    say 'Trace started.  Perform the APPC-based transaction that you want to trace.'
  1143.    say 'When the APPC transaction to be traced is complete, press any key.'
  1144.    call Pause
  1145.  
  1146.    '@cmtrace stop > NUL'
  1147.    say "APPC trace stopped."
  1148.  
  1149.    /* Get the name of the trace file */
  1150.  
  1151.    Editor  = GetIni('Program','Editor','e.exe')
  1152.    Trace   = GetIni('File','Trace','d:\temp\trace.out')
  1153.  
  1154.  
  1155.    say "Erasing old trace file..."
  1156.    '@erase' Trace "> NUL 2>NUL"
  1157.  
  1158.    say "Copying from internal trace buffers..."
  1159.    '@cmtrace copy' Trace "> NUL"
  1160.  
  1161.    say "Formatting trace data..."
  1162.    '@fmttrace /DASHF' Trace "> NUL"
  1163.  
  1164.    /* Construct the name of the detail file and edit it */
  1165.  
  1166.    Detail = FileSpec("drive", Trace) || FileSpec("Path",Trace) || RootName(Trace)".Det"
  1167.    '@'editor Detail
  1168.    return
  1169.  
  1170.  
  1171.  
  1172. /**
  1173. *** ┌──────────────────────────────────────────────────────────────────────┐
  1174. *** │                            Zip Subroutines                           │
  1175. *** └──────────────────────────────────────────────────────────────────────┘
  1176. **/
  1177.  
  1178. Zip: procedure expose IniFile
  1179.    /**
  1180.    ***  This will call a compression program to create a package in
  1181.    ***  the correct directory.  It looks for a zip list file of with an
  1182.    ***  extension of ".ZPL"
  1183.    **/
  1184.  
  1185.    parse arg ZipFile .
  1186.  
  1187.    /* If there wasn't a zip file passed, use the project environment  */
  1188.    /* for the name.                                                   */
  1189.  
  1190.    if ZipFile = '' then
  1191.       do
  1192.       ZipFile = value("PROJECT", , "OS2ENVIRONMENT")
  1193.       if ZipFile = '' then
  1194.          do
  1195.          say "Project environment variable not set."
  1196.          return
  1197.          end
  1198.       end
  1199.  
  1200.    TempDir = GetIni('Directory','Temp','')
  1201.    Zip     = GetIni('Program','Zip','')
  1202.  
  1203.    /* Make a copy of the existing ZIP file if there is one */
  1204.  
  1205.    ZipDest = 'archive\'ZipFile'.ZIP'
  1206.  
  1207.    if Exists(ZipDest) then
  1208.       do
  1209.       '@copy' ZipDest TempDir
  1210.       '@del'  ZipDest
  1211.       end
  1212.  
  1213.    '@'Zip '-o@' ZipDest '< archive\'ZipFile'.zpl'
  1214.    return
  1215.  
  1216. /**
  1217. *** ┌──────────────────────────────────────────────────────────────────────┐
  1218. *** │                         Recurse Subroutines                          │
  1219. *** └──────────────────────────────────────────────────────────────────────┘
  1220. **/
  1221.  
  1222. Recurse: procedure expose IniFile
  1223.    /**
  1224.    ***  This will execute the command on each directory starting with
  1225.    ***  the first
  1226.    **/
  1227.  
  1228.    parse arg command
  1229.  
  1230.    call RecurseDirectory ".", command
  1231.    return
  1232.  
  1233.  
  1234. RecurseDirectory: procedure expose IniFile
  1235.    /**
  1236.    ***  This will execute the command against this direct and all children
  1237.    **/
  1238.  
  1239.    parse arg dir, command
  1240.  
  1241.    old = directory(dir)
  1242.    say left("---" directory() copies('-',79), 79)
  1243.    '@'command
  1244.    call SysFileTree '.', 'Current', 'DO'
  1245.    do i = 1 to Current.0
  1246.       call RecurseDirectory Current.i, command
  1247.    end
  1248.    return 0
  1249.  
  1250. /**
  1251. *** ┌──────────────────────────────────────────────────────────────────────┐
  1252. *** │                          Space Subroutines                           │
  1253. *** └──────────────────────────────────────────────────────────────────────┘
  1254. **/
  1255.  
  1256. Space: procedure expose IniFile
  1257.    /**
  1258.    ***  This will recurse through all the specified drives and generate
  1259.    ***  a disk utilization report on the space used by directory.
  1260.    **/
  1261.  
  1262.    arg DisplayLevel DriveList
  1263.  
  1264.    Report.  = ''
  1265.    Report.0 = 0
  1266.  
  1267.    /* Give defaults for missing parameters */
  1268.  
  1269.    if DisplayLevel = ''  then DisplayLevel = 32768
  1270.    if DisplayLevel = '*' then DisplayLevel = 32768
  1271.    if DisplayLevel = '.' then DisplayLevel = 32768
  1272.  
  1273.    if DriveList = '' then DriveList = SysDriveMap('C:', 'LOCAL')
  1274.  
  1275.  
  1276.    do i = 1 to words(DriveList)
  1277.       Drive = word(DriveList, i)
  1278.       BytesDrive = SpaceDirectory(Drive'\*.*', 0, DisplayLevel)
  1279.    end
  1280.  
  1281.    /* Get the INI values */
  1282.  
  1283.    TempFile = GetIni('File','Temp Space','c:\temp.1')
  1284.    Editor   = GetIni('Program','Editor','e.exe')
  1285.  
  1286.    /* Erase the old and open a new file */
  1287.  
  1288.    '@erase' TempFile '> nul'
  1289.    ReportFile = Open(TempFile 'WRITE')
  1290.  
  1291.    /* Write the headers */
  1292.  
  1293.    call lineout ReportFile, center("File", 10) center("w/ Child", 12) center("Directory", 54)
  1294.    call lineout ReportFile, copies('-', 10)    copies("-", 12)        copies("-", 54)
  1295.  
  1296.    /* Write the space utilization report */
  1297.  
  1298.    do i = Report.0 to 1 by -1
  1299.       call lineout ReportFile, Report.i
  1300.    end
  1301.    ReportFile = Close(ReportFile)
  1302.  
  1303.    /* Start the editor on the report file */
  1304.  
  1305.    '@'Editor TempFile
  1306.    return
  1307.  
  1308.  
  1309. SpaceDirectory: procedure expose Report.
  1310.    /**
  1311.    ***  This will generate a space utilization report for a given drive
  1312.    **/
  1313.  
  1314.    arg Directory, Level, DisplayLevel
  1315.  
  1316.    /* Sum the size of all files in this directory */
  1317.  
  1318.    call SysFileTree Directory, 'Current', 'F'
  1319.  
  1320.    BytesDir = 0
  1321.    do i = 1 to Current.0
  1322.       parse var Current.i . . BytesFile . FileName
  1323.       BytesDir = BytesDir + BytesFile
  1324.    end
  1325.  
  1326.    /* Determine the size of all the files in all the subtrees under this */
  1327.    /* directory.                                                         */
  1328.  
  1329.    call SysFileTree Directory, 'Current', 'D'
  1330.  
  1331.    BytesChildren = 0
  1332.    do i = 1 to Current.0
  1333.       parse var Current.i . . BytesFile . SubDirName
  1334.       SubDirName = strip(SubDirName, 'Both')
  1335.       BytesChildren = BytesChildren + SpaceDirectory(SubDirName'\*.*', (Level+1), DisplayLevel)
  1336.    end
  1337.  
  1338.    /* Generate the statistics for this directory and its descendants */
  1339.  
  1340.    BytesSum = BytesDir + BytesChildren
  1341.  
  1342.    if DisplayLevel >= Level then
  1343.       do
  1344.  
  1345.       /* Format the line for column output and add to the report */
  1346.  
  1347.       BytesDirFmt = FormatComma(BytesDir)
  1348.       BytesSumFmt = FormatComma(BytesSum)
  1349.       Report.0 = Report.0 + 1
  1350.       q = Report.0
  1351.       Report.q = right(BytesDirFmt, 10) right(BytesSumFmt, 12) copies(" ", Level*3) Directory
  1352.       end
  1353.    return BytesSum
  1354.  
  1355. /**
  1356. *** ┌──────────────────────────────────────────────────────────────────────┐
  1357. *** │                          Pstat Subroutines                           │
  1358. *** └──────────────────────────────────────────────────────────────────────┘
  1359. **/
  1360.  
  1361. PStat: procedure expose IniFile
  1362.    /**
  1363.    ***  This will place you in the editor on a list of files that was
  1364.    ***  generated from the PSTAT command
  1365.    **/
  1366.  
  1367.    arg parms
  1368.  
  1369.    if parms = 'ALL' then
  1370.       pstatopt = ''
  1371.    else
  1372.       pstatopt = '/c'
  1373.  
  1374.    say "Working.  Please wait..."
  1375.  
  1376.    Editor   = GetIni('Program','Editor','e.exe')
  1377.    TempFile = GetIni('File','Temp 2','c:\temp.1')
  1378.  
  1379.    '@pstat' pstatopt '>' TempFile
  1380.    '@'Editor TempFile
  1381.    return
  1382.  
  1383.  
  1384. /**
  1385. *** ┌──────────────────────────────────────────────────────────────────────┐
  1386. *** │                         Migrate Subroutines                          │
  1387. *** └──────────────────────────────────────────────────────────────────────┘
  1388. **/
  1389.  
  1390. Migrate: procedure expose IniFile
  1391.    /**
  1392.    ***  This will move the file from the working directory to the production
  1393.    ***  directory based on the file name if passed.  If the filename is not
  1394.    ***  passed, it will migrate by the current directory and the project
  1395.    ***  environment variable
  1396.    **/
  1397.  
  1398.    arg FileSpec
  1399.    if FileSpec = '' then
  1400.       call MigrateByDir
  1401.    else
  1402.       call MigrateByExt FileSpec
  1403.    return
  1404.  
  1405.  
  1406.  
  1407. MigrateByDir: procedure expose IniFile
  1408.    /**
  1409.    ***  This will migrate the file from the development directory to the
  1410.    ***  production directory based on the current path and the project
  1411.    ***  variable.
  1412.    **/
  1413.  
  1414.    Project = value("PROJECT", , "OS2ENVIRONMENT")
  1415.    if Project = '' then
  1416.       do
  1417.       say "Project environment variable not set."
  1418.       return
  1419.       end
  1420.  
  1421.    Current = UpperCase(directory())
  1422.  
  1423.    call MigrateByExt Project'.EXE'
  1424.    return
  1425.  
  1426.  
  1427.  
  1428. MigrateByExt: procedure expose IniFile
  1429.    /**
  1430.    ***  This will migrate the file from the development directory to the
  1431.    ***  production directory based on the file extension.
  1432.    **/
  1433.  
  1434.    arg FileSpec
  1435.  
  1436.    if verify(FileSpec, '\*?:', 'Match') > 0 then
  1437.       do
  1438.       say "The file must be specified with no wildcard or path information."
  1439.       return
  1440.       end
  1441.  
  1442.    ProdDLL    = GetIni('Directory','Products DLL','')
  1443.    ProdCmd    = GetIni('Directory','Products Command','')
  1444.    Products   = GetIni('Directory','Products','')
  1445.  
  1446.    parse var FileSpec FileName '.' FileExt
  1447.    select
  1448.       when FileExt = 'DLL' then Target = ProdDll
  1449.       when FileExt = 'CMD' then Target = ProdCmd
  1450.       when FileExt = 'EXE' then Target = Products
  1451.       otherwise
  1452.          do
  1453.          say "Unrecognized extension:" FileExt".  No action taken."
  1454.          return
  1455.          end
  1456.    end /* select */
  1457.    'copy' FileSpec Target
  1458.    return
  1459.  
  1460. /**
  1461. *** ┌──────────────────────────────────────────────────────────────────────┐
  1462. *** │                         Maximus Subroutines                          │
  1463. *** └──────────────────────────────────────────────────────────────────────┘
  1464. **/
  1465.  
  1466. Maximus: procedure expose IniFile
  1467.  
  1468.    parse arg cmd parms
  1469.    cmd = translate(cmd)
  1470.  
  1471.    select
  1472.       when abbrev('CLEANLOG'  ,cmd,  6) then call MaximusCleanLog   parms
  1473.       when abbrev('CLEANFILES',cmd,  6) then call MaximusCleanFiles parms
  1474.       when abbrev('LOGONS'    ,cmd,  3) then call MaximusLogons     parms
  1475.       when abbrev('TODAY'     ,cmd,  3) then call MaximusToday      parms
  1476.       when abbrev('DOWNLOADS' ,cmd,  2) then call MaximusDownloads  parms
  1477.       when abbrev('DL'        ,cmd,  2) then call MaximusDownloads  parms
  1478.       otherwise
  1479.          say "Subcommand (MAXIMUS): '"cmd"' not recognized"
  1480.    end /* Select */
  1481.    return
  1482.  
  1483.  
  1484. MaximusCleanLog: procedure expose IniFile
  1485.    /**
  1486.    ***  This will trim the log for the Maximus BBS by keeping only those
  1487.    ***  lines that being with a '+' or '='.  These are the logon, logoff
  1488.    ***  and download messages.
  1489.    **/
  1490.  
  1491.    '@echo off'
  1492.  
  1493.    /* Get the INI information */
  1494.  
  1495.    MaxDir   = GetIni('Directory','Maximus','')
  1496.    Grep     = GetIni('Program','Grep','GREP.EXE')
  1497.    MaxLog   = GetIni('File','Maximus Log','')
  1498.    TempFile = GetIni('File','Temp 1','')
  1499.  
  1500.    MaxDir = directory(MaxDir)
  1501.    Grep '"^[\+\=]"' MaxLog '>' TempFile
  1502.    '@copy' TempFile MaxLog
  1503.  
  1504.    /* Clean up the temporary files */
  1505.  
  1506.    '@erase' TempFile
  1507.    return
  1508.  
  1509.  
  1510. MaximusCleanFiles: procedure expose IniFile
  1511.    /**
  1512.    ***  This will look for the files that are created by the Maximus BBS
  1513.    ***  when a path override is done by the sysop and a file is uploaded.
  1514.    ***  When those files are found, they are deleted.
  1515.    **/
  1516.  
  1517.    /* Get the INI information */
  1518.  
  1519.    MaxDir   = GetIni('Directory','Maximus','')
  1520.    BBSFile  = GetIni('File','Maximus BBS File','')
  1521.  
  1522.    '@erase' TempFile
  1523.    map = SysDriveMap('C:', 'USED')
  1524.    i = 1
  1525.    drive = word(map, i)
  1526.    do while(drive \= '')
  1527.       call SysFileTree drive'\'BBSFile, 'Found', 'FSO'
  1528.       do j = 1 to Found.0
  1529.          'erase' found.j
  1530.       end
  1531.       i = i + 1
  1532.       drive = word(map, i)
  1533.    end /* do */
  1534.    return
  1535.  
  1536.  
  1537. MaximusLogons: procedure expose IniFile
  1538.    /**
  1539.    ***
  1540.    **/
  1541.  
  1542.    '@echo off'
  1543.    MaxDir   = GetIni('Directory','Maximus','')
  1544.    Grep     = GetIni('Program','Grep','GREP.EXE')
  1545.    MaxLog   = GetIni('File','Maximus Log','')
  1546.  
  1547.    MaxDir = directory(MaxDir)
  1548.    Grep '"^\+.*calling ("' MaxLog
  1549.    return
  1550.  
  1551.  
  1552. MaximusDownloads: procedure expose IniFile
  1553.    /**
  1554.    ***
  1555.    **/
  1556.  
  1557.    MaxDir   = GetIni('Directory','Maximus','')
  1558.    Grep     = GetIni('Program','Grep','GREP.EXE')
  1559.    MaxLog   = GetIni('File','Maximus Log','')
  1560.    Awk      = GetIni('Program','Awk','gawk.exe')
  1561.    AwkDir   = GetIni('Directory','Awk','')
  1562.    TempFile = GetIni('File','Temp Maximus Download','c:\temp.1')
  1563.    Editor   = GetIni('Program','Editor','e.exe')
  1564.  
  1565.    '@echo off'
  1566.    MaxDir = directory(MaxDir)
  1567.    Awk '-f' AwkDir'\MaxDLByFile.awk' MaxLog '>'  TempFile
  1568.    Awk '-f' AwkDir'\MaxDL.awk'       MaxLog '>>' TempFile
  1569.    Editor TempFile
  1570.    return
  1571.  
  1572.  
  1573. MaximusToday: procedure expose IniFile
  1574.    /**
  1575.    ***
  1576.    **/
  1577.  
  1578.    MaxDir   = GetIni('Directory','Maximus','')
  1579.    MaxLog   = GetIni('File','Maximus Log','')
  1580.    Awk      = GetIni('Program','Awk','gawk.exe')
  1581.    AwkDir   = GetIni('Directory','Awk','')
  1582.  
  1583.    MaxDir = directory(MaxDir)
  1584.  
  1585.    parse value date('N') with dd mmm .
  1586.    dd = right(dd, 2, '0')
  1587.    "@"Grep '"'dd mmm'"' MaxLog '|' Awk '-f' AwkDir'\MaxToday.AWK'
  1588.    return
  1589.  
  1590. /**
  1591. *** ┌──────────────────────────────────────────────────────────────────────┐
  1592. *** │                     Environment Subroutines                          │
  1593. *** └──────────────────────────────────────────────────────────────────────┘
  1594. **/
  1595.  
  1596. Environment: procedure expose IniFile
  1597.    /**
  1598.    ***  This will display the contents of the environment variable in a list.
  1599.    ***  It was designed to list those environment variables that are a
  1600.    ***  list of directories, separated by semicolons, such as a PATH or
  1601.    ***  DPATH variable.  Although it is not an environment variable, this
  1602.    ***  code will do the same for the LIBPATH by looking in the CONFIG.SYS
  1603.    **/
  1604.  
  1605.    arg EnvVariable .
  1606.  
  1607.    if EnvVariable = '' then
  1608.       EnvVariable = 'PATH'
  1609.  
  1610.    /* Take care of the special case for LIBPATH */
  1611.  
  1612.    if EnvVariable = 'LIBPATH' then
  1613.       EnvValue = GetLibpath()
  1614.    else
  1615.       EnvValue = value(EnvVariable,,"OS2ENVIRONMENT")
  1616.  
  1617.    /* Create the list of directories and display them in a nicely formatted */
  1618.    /* list.                                                                 */
  1619.  
  1620.    Count = PathSplit(EnvValue)       /* Set DirList. */
  1621.    say "The following" Count "directories were found in the" EnvVariable
  1622.    say copies("─",78)
  1623.    do i = 1 to DirList.0
  1624.       say "   " DirList.i
  1625.    end
  1626.    return
  1627.  
  1628.  
  1629. Which: procedure expose IniFile
  1630.  
  1631.    parse arg Options
  1632.  
  1633.    Opt.       = ''
  1634.    Opt.Flag.E = 'PATH'
  1635.    call ParseOptions Options
  1636.    File = Opt.Parm.1
  1637.  
  1638.    fspec = ScanEnvironment(Opt.Flag.E,File)
  1639.    if fspec = '' then
  1640.       call Error 2002,0,File
  1641.    else
  1642.       say fspec
  1643.    return
  1644.  
  1645. /**
  1646. *** ┌──────────────────────────────────────────────────────────────────────┐
  1647. *** │ Check Subroutines                                                    │
  1648. *** └──────────────────────────────────────────────────────────────────────┘
  1649. **/
  1650.  
  1651.  
  1652. Check: procedure expose IniFile
  1653.  
  1654.    parse arg cmd parms
  1655.    cmd = translate(cmd)
  1656.  
  1657.    select
  1658.       when abbrev('DRIVES'   ,cmd,  2) then call CheckDrives  parms
  1659.       when abbrev('GOPHER'   ,cmd,  1) then call CheckGopher  parms
  1660.       when abbrev('MAIL'     ,cmd,  2) then call CheckMail    parms
  1661.       when abbrev('MOUNTS'   ,cmd,  2) then call CheckMount   parms
  1662.       when abbrev('OS2BBS'   ,cmd,  3) then call CheckOS2BBS  parms
  1663.       when abbrev('BBS'      ,cmd,  3) then call CheckOS2BBS  parms
  1664.       when abbrev('NETSTAT'  ,cmd,  3) then call CheckNetStat parms
  1665.       otherwise
  1666.          say "Subcommand (CHECK): '"cmd"' not recognized"
  1667.    end /* Select */
  1668.    return
  1669.  
  1670.  
  1671.  
  1672. CheckGopher: procedure expose IniFile
  1673.    /**
  1674.    ***  This will validate that all of the files listed in the Gopher
  1675.    ***  menus really exist.
  1676.    **/
  1677.  
  1678.    arg menufile .
  1679.    if right(menufile,4) \= '.MNU' then
  1680.       menufile = menufile'.MNU'
  1681.  
  1682.    if menufile = '' then
  1683.       do
  1684.       call Error 2004,0,"MenuFile"
  1685.       return 16
  1686.       end
  1687.  
  1688.    /* Get the source path and change to it */
  1689.  
  1690.    spath   = GetProfile('gopher','Source Path',directory())
  1691.    code = directory(spath)
  1692.  
  1693.    /* Open the Gopher filter and read the assiciative array information */
  1694.  
  1695.    Dir.       = ''
  1696.    Dir.GOPHER = spath
  1697.    filter = open('GoFilter.70','Read')
  1698.    do while(lines(filter) > 0)
  1699.       line = linein(filter)
  1700.       parse var line "Dir." extension "=" . "'" path "'" comment
  1701.       if comment \= '' then
  1702.          interpret line
  1703.    end /* while */
  1704.    code = close(filter)
  1705.  
  1706.    /* Open the menu file */
  1707.  
  1708.    menu = open(menufile,'read')
  1709.    call linein menu
  1710.    call linein menu
  1711.    do while(lines(menu) > 0)
  1712.       line = linein(menu)
  1713.       parse var line . ';' selector .
  1714.       if left(selector,1) = '[' then
  1715.          do
  1716.          parse var selector '[' code ']' request
  1717.          request = strip(request, 'Both')
  1718.          code = translate(code)
  1719.  
  1720.          parse var code subdir '!' format
  1721.  
  1722.          if format = 'TEXT' then format = ''
  1723.          if subdir = ''     then subdir = 'GOPHER'
  1724.          end
  1725.       else
  1726.          do
  1727.          format = ''
  1728.          subdir = 'GOPHER'
  1729.          request = selector
  1730.          end
  1731.  
  1732.       if Dir.subdir = '' then
  1733.          subdir = 'GOPHER'
  1734.  
  1735.       select
  1736.          when selector = '' then /* Initial request */
  1737.             nop
  1738.          when code = 'STRING' then  /* String */
  1739.             nop
  1740.          when code = 'CONTROL' then  /* control */
  1741.             nop
  1742.          otherwise  /* Menus, et. al */
  1743.             if Exists(Dir.subdir'\'request) = 0 then
  1744.                do
  1745.                call Error 2002,0,Dir.subdir'\'request
  1746.                errorcode = 16
  1747.                end
  1748.       end /* select */
  1749.    end /* while */
  1750.    code = close(menu)
  1751.    return errorcode
  1752.  
  1753.  
  1754. CheckNetStat: procedure expose IniFile
  1755.    /**
  1756.    ***  This will check the TCP/IP routing information and make sure that
  1757.    ***  the default route is set up correctly.
  1758.    **/
  1759.  
  1760.    /* Clear the queue */
  1761.  
  1762.    do i = 1 to queued()
  1763.       pull .
  1764.    end
  1765.  
  1766.    '@netstat -r | rxqueue'
  1767.    pull . /* Header line */
  1768.    pull . /* Header line */
  1769.    pull . /* Header line */
  1770.  
  1771.    OK = 1
  1772.    defaultFound = 0   /* Make sure there is a default route */
  1773.    do i = 1 to queued()
  1774.       parse pull destination router .
  1775.       select
  1776.          when destination = 'default' then
  1777.             do
  1778.             defaultFound = 1
  1779.             if router <> '144.223.12.33' then
  1780.                OK = 0
  1781.             end
  1782.          when destination = '144.223.12.0' then
  1783.             do
  1784.             if router <> '144.223.12.3' then
  1785.                OK = 0
  1786.             end
  1787.          when destination = '144.223.12.60' then
  1788.             do
  1789.             if router <> '144.223.12.61' then
  1790.                OK = 0
  1791.             end
  1792.          when destination = '144.223.12.61' then
  1793.             do
  1794.             if router <> '144.223.12.60' then
  1795.                OK = 0
  1796.             end
  1797.          otherwise
  1798.             OK = 0
  1799.       end /* select */
  1800.    end /* do */
  1801.  
  1802.    if defaultFound = 0 then
  1803.       OK = 0
  1804.  
  1805.    if OK = 0 then
  1806.       do
  1807.       '@route -fh'
  1808.       '@arp -f'
  1809.       '@route add default 144.223.12.33 1'
  1810.       Notify = GetIni('Program','Notify','msg.exe')
  1811.       '@'Notify 'Default route definition was reset.'
  1812.       end
  1813.    return
  1814.  
  1815.  
  1816. CheckMount: procedure expose IniFile
  1817.    /**
  1818.    ***  This will check to see if the NFS drives are mounted.  If not,
  1819.    ***  a mount is attempted.
  1820.    **/
  1821.  
  1822.    MountList = 'L: N: R:'
  1823.    DriveList = SysDriveMap('C:', 'REMOTE')
  1824.  
  1825.    if wordpos('L:', DriveList) = 0 then
  1826.       '@net use L: \\KSOPKR01\PUBLIC'
  1827.    if wordpos('N:', DriveList) = 0 then
  1828.       call ! 'mount n: ts54sys5:/home/cid'
  1829.    if wordpos('R:', DriveList) = 0 then
  1830.       call ! 'mount r: ts54sys1:/home/share'
  1831.  
  1832.    DriveList = SysDriveMap('C:', 'REMOTE')
  1833.    do i = 1 to words(MountList)
  1834.       Drive = word(MountList,i)
  1835.       if wordpos(Drive, DriveList) = 0 then
  1836.          do
  1837.          Notify = GetIni('Program','Notify','msg.exe')
  1838.          '@'Notify 'One or more of the remote drives did not mount properly.'
  1839.          return
  1840.          end
  1841.    end
  1842.    return
  1843.  
  1844.  
  1845. CheckMail: procedure expose IniFile
  1846.    /**
  1847.    ***  This will see if there has been any new SprintMail loaded down.  It
  1848.    ***  checks by looking for the archive bit on the files in the IN box.
  1849.    ***  This is intended to be run by CHRON.
  1850.    **/
  1851.  
  1852.    MailDir = GetIni('Directory','SprintMail','')
  1853.    call SysFileTree MailDir'\IN.BOX\*.ASC', 'Found', 'F', '+****', '-****'
  1854.    if Found.0 > 0 then
  1855.       do
  1856.       Notify = GetIni('Program','Notify','msg.exe')
  1857.       '@'Notify 'You have new SprintMail'
  1858.       end
  1859.    return
  1860.  
  1861.  
  1862. CheckOS2BBS: procedure expose IniFile
  1863.    /**
  1864.    ***  This will see if there has been any new OS2BBS information loaded
  1865.    ***  down from IBMLink
  1866.    ***
  1867.    ***  This is intended to be run by CHRON.
  1868.    **/
  1869.  
  1870.    BBSDir = GetIni('Directory','OS/2 BBS','')
  1871.    call SysFileTree BBSDir'\Data\*', 'Found', 'F', '+****', '-****'
  1872.    if Found.0 > 0 then
  1873.       do
  1874.       Notify = GetIni('Program','Notify','msg.exe')
  1875.       '@'Notify 'You have new information from OS2BBS on IBMLink'
  1876.       end
  1877.    return
  1878.  
  1879.  
  1880. CheckDrives: procedure expose IniFile
  1881.    /**
  1882.    ***  This will run a CHKDSK on both the local  drives and pipe the output
  1883.    ***  into a file.  Once both have been run, the editor is started with the
  1884.    ***  output file to display the results.   This is intended to be run by
  1885.    ***  CHRON.
  1886.    **/
  1887.  
  1888.    TempFile = GetIni('File','Temp Check Disk','c:\temp.1')
  1889.    '@erase' TempFile
  1890.    map = SysDriveMap('C:', 'LOCAL')
  1891.    i = 1
  1892.    drive = word(map, i)
  1893.    do while(drive \= '')
  1894.       say "Checking drive" drive"..."
  1895.       "@echo Checking drive" drive"...   >>" TempFile
  1896.       "@chkdsk" drive                   ">>" TempFile
  1897.       "@echo" copies("─",78)            ">>" TempFile
  1898.       i = i + 1
  1899.       drive = word(map, i)
  1900.    end
  1901.  
  1902.    Editor = GetIni('Program','Editor','e.exe')
  1903.    '@'Editor TempFile
  1904.    return
  1905.  
  1906. /**
  1907. *** ┌──────────────────────────────────────────────────────────────────────┐
  1908. *** │ Support Routines                                                     │
  1909. *** └──────────────────────────────────────────────────────────────────────┘
  1910. **/
  1911.  
  1912. GetProfile: procedure expose IniFile
  1913.    /**
  1914.    ***  This will get project-specific profile data from the INI file
  1915.    **/
  1916.  
  1917.    parse arg Project,Key,Default
  1918.    project = lowercase(project)
  1919.    return GetIni('Project:' Project, Key, Default)
  1920.  
  1921.  
  1922. GetIniFile: procedure
  1923.    /**
  1924.    ***  This will find the INI file that contains profile information.
  1925.    **/
  1926.  
  1927.    /* Look for an environment variable first */
  1928.  
  1929.    IniFile = value('Hilbert.Ini',,"OS2ENVIRONMENT")
  1930.    if IniFile = '' then
  1931.       IniFile = SysSearchPath("DPATH","Hilbert.Ini")
  1932.    if IniFile = '' then
  1933.       do
  1934.       This = ThisDirectory()
  1935.       if Exists(This"\Hilbert.Ini") then
  1936.          IniFile = This"\Hilbert.Ini"
  1937.       end
  1938.    if IniFile = '' then
  1939.       call Error 2002,1,"Hilbert.Ini"
  1940.    return IniFile
  1941.  
  1942. /**
  1943. *** ┌──────────────────────────────────────────────────────────────────────┐
  1944. *** │ Changed Subroutines                                                  │
  1945. *** └──────────────────────────────────────────────────────────────────────┘
  1946. **/
  1947.  
  1948. Changed: procedure expose IniFile
  1949.    /**
  1950.    ***  This will recurse through all the specified drives and generate
  1951.    ***  a byte count on the files with the archive bit on
  1952.    **/
  1953.  
  1954.    arg DisplayLevel DriveList
  1955.  
  1956.    Report.  = ''
  1957.    Report.0 = 0
  1958.  
  1959.    /* Give defaults for missing parameters */
  1960.  
  1961.    if DisplayLevel = ''  then DisplayLevel = 32768
  1962.    if DisplayLevel = '*' then DisplayLevel = 32768
  1963.    if DisplayLevel = '.' then DisplayLevel = 32768
  1964.  
  1965.    if DriveList = '' then DriveList = SysDriveMap('C:', 'LOCAL')
  1966.  
  1967.  
  1968.    do i = 1 to words(DriveList)
  1969.       Drive = word(DriveList, i)
  1970.       BytesDrive = ChangedDirectory(Drive'\*.*', 0, DisplayLevel)
  1971.    end
  1972.  
  1973.    /* Erase the old and open a new file */
  1974.  
  1975.    TempFile = GetIni('File','Temp Changed','c:\temp.1')
  1976.    '@erase' TempFile '> nul'
  1977.    ReportFile = Open(TempFile 'WRITE')
  1978.  
  1979.    /* Write the headers */
  1980.  
  1981.    call lineout ReportFile, center("File", 10) center("w/ Child", 12) center("Directory", 54)
  1982.    call lineout ReportFile, copies('-', 10)    copies("-", 12)        copies("-", 54)
  1983.  
  1984.    /* Write the space utilization report */
  1985.  
  1986.    do i = Report.0 to 1 by -1
  1987.       call lineout ReportFile, Report.i
  1988.    end
  1989.    ReportFile = Close(ReportFile)
  1990.  
  1991.    /* Start the editor on the report file */
  1992.  
  1993.    Editor = GetIni('Program','Editor','e.exe')
  1994.    '@'Editor TempFile
  1995.    return
  1996.  
  1997.  
  1998. ChangedDirectory: procedure expose IniFile Report.
  1999.    /**
  2000.    ***  This will generate a changed files report for a given drive
  2001.    **/
  2002.  
  2003.    arg Directory, Level, DisplayLevel
  2004.  
  2005.    /* Sum the size of all files in this directory */
  2006.  
  2007.    call SysFileTree Directory, 'Current', 'F', '+****'
  2008.  
  2009.    BytesDir = 0
  2010.    Detail.  = ''
  2011.    Detail.0 = 0
  2012.  
  2013.    do i = 1 to Current.0
  2014.       parse var Current.i . . BytesFile . FileName
  2015.       FileName = strip(FileName, 'Both')
  2016.       BytesDir = BytesDir + BytesFile
  2017.       if DisplayLevel = 0 then
  2018.          do
  2019.          Detail.0 = Detail.0 + 1
  2020.          q = Detail.0
  2021.          Detail.q = copies(" ", 25+Level*3) FileName
  2022.          end
  2023.    end
  2024.  
  2025.    /* Determine the size of all the files in all the subtrees under this */
  2026.    /* directory.                                                         */
  2027.  
  2028.    call SysFileTree Directory, 'Current', 'D'
  2029.  
  2030.    BytesChildren = 0
  2031.    do i = 1 to Current.0
  2032.       parse var Current.i . . BytesFile . SubDirName
  2033.       SubDirName = strip(SubDirName, 'Both')
  2034.       BytesChildren = BytesChildren + ChangedDirectory(SubDirName'\*.*', (Level+1), DisplayLevel)
  2035.    end
  2036.  
  2037.    /* Generate the statistics for this directory and its descendants */
  2038.  
  2039.    BytesSum = BytesDir + BytesChildren
  2040.  
  2041.    if (DisplayLevel = 0) | (DisplayLevel >= Level) then
  2042.       do
  2043.  
  2044.       if DisplayLevel = 0 then
  2045.          do i = 1 to Detail.0
  2046.             Report.0 = Report.0 + 1
  2047.             q = Report.0
  2048.             Report.q = Detail.i
  2049.          end
  2050.  
  2051.       /* Format the line for column output and add to the report */
  2052.  
  2053.       BytesDirFmt = FormatComma(BytesDir)
  2054.       BytesSumFmt = FormatComma(BytesSum)
  2055.       Report.0 = Report.0 + 1
  2056.       q = Report.0
  2057.       Report.q = right(BytesDirFmt, 10) right(BytesSumFmt, 12) copies(" ", Level*3) Directory
  2058.       end
  2059.    return BytesSum
  2060.  
  2061.  
  2062. DeleteOldFiles: procedure
  2063.    /**
  2064.    ***  This will keep 'x' versions of the filename that matches the
  2065.    ***  pattern passed and delete the rest.
  2066.    **/
  2067.  
  2068.    arg SearchFor, Keep
  2069.  
  2070.    /* Keep the number of message file backups to a reasonable number */
  2071.  
  2072.    call SysFileTree SearchFor, 'Sort', 'FT'
  2073.  
  2074.    /* If there are a bunch of them, delete the oldest ones */
  2075.  
  2076.    if Sort.0 > Keep then
  2077.       do
  2078.       call SortStem
  2079.       do j = 1 to (Sort.0 - Keep)
  2080.          parse var Sort.j . . . DeleteFile
  2081.          'erase' DeleteFile
  2082.       end
  2083.       end /* if */
  2084.    return (Sort.0 - Keep)
  2085.  
  2086.  
  2087. SortStem: procedure expose Sort.
  2088.    /**
  2089.    ***  This will sort the stem variable passed in.  It is assumed that the
  2090.    ***  stem variable is formatted in the "standard" way of Stem.0 containing
  2091.    ***  the number of items
  2092.    **/
  2093.  
  2094.    do i = 1 to Sort.0
  2095.  
  2096.       /* Find the lowest value in the list */
  2097.  
  2098.       low = i;
  2099.       do j = (i+1) to Sort.0
  2100.          if Sort.j < Sort.low then
  2101.             low = j
  2102.       end
  2103.  
  2104.       /* Swap the two */
  2105.  
  2106.       temp = Sort.i
  2107.       Sort.i = Sort.low
  2108.       Sort.low = temp
  2109.    end
  2110.    return
  2111.  
  2112.  
  2113. /**
  2114. *** ┌──────────────────────────────────────────────────────────────────────┐
  2115. *** │ "To-Be" Included routines                                            │
  2116. *** └──────────────────────────────────────────────────────────────────────┘
  2117. **/
  2118.  
  2119.  
  2120. PathSplit: procedure expose DirList.
  2121.    /**
  2122.    ***  This will create a stem variable out of the semicolon-delimited
  2123.    ***  variable that is presumably retreived from a PATH or DPATH
  2124.    ***  environment.
  2125.    **/
  2126.  
  2127.    arg PathString .
  2128.  
  2129.    DirList = ''
  2130.    j = 1
  2131.    parse var PathString DirList.j ';' PathString
  2132.    do while DirList.j \= ''
  2133.       j = j + 1
  2134.       parse var PathString DirList.j ';' PathString
  2135.    end /* while */
  2136.    DirList.0 = j - 1
  2137.    return DirList.0
  2138.  
  2139.  
  2140. GetLibpath: procedure
  2141.    /**
  2142.    ***  This will return the LIBPATH string
  2143.    **/
  2144.  
  2145.    Boot = SystemDrive()
  2146.    call SysFileSearch 'LIBPATH=', Boot':\CONFIG.SYS', 'Libpath','N'
  2147.    select
  2148.       when Libpath.0 = 0 then
  2149.          Idx = 0
  2150.       when Libpath.0 = 1 then
  2151.          parse var Libpath.1 Idx Dlls
  2152.       otherwise
  2153.          do
  2154.          Dlls = ''
  2155.          do j = 1 to Libpath.0
  2156.             parse upper var Libpath.j Idx Path .
  2157.             if left(Path,8) = 'LIBPATH=' then
  2158.                Idx = j
  2159.          end
  2160.          end
  2161.    end /* select */
  2162.  
  2163.    if Idx = 0 then
  2164.       Dlls = 0
  2165.    else
  2166.       do
  2167.  
  2168.       /* Get the "Idx'th" line */
  2169.  
  2170.       Config = Open(Boot':\CONFIG.SYS','Read')
  2171.       do i = 1 to Idx-1
  2172.          code = LineIn(Config)
  2173.       end
  2174.       Dlls = LineIn(Config)
  2175.       Config = Close(Config)
  2176.       end
  2177.    return substr(Dlls, 9)  /* Remove the "LIBPATH=" */
  2178.  
  2179. /**
  2180. *** ┌──────────────────────────────────────────────────────────────────────┐
  2181. *** │ Included routines                                                    │
  2182. *** └──────────────────────────────────────────────────────────────────────┘
  2183. **/
  2184.  
  2185.  
  2186. /* #include LoadFunctions.rex */
  2187.  
  2188. LoadFunctions: procedure
  2189.    /**
  2190.    ***   This will load the DLL for the Rexx system functions supplied
  2191.    ***   with OS/2 v2.0
  2192.    **/
  2193.    call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  2194.    call SysLoadFuncs
  2195.    return
  2196.  
  2197.  
  2198. /* #include <error.rex> */
  2199.  
  2200. /**
  2201. *** ╔═══════════════════════════════════════════════════════════════════════╗
  2202. *** ║ Error Handler                                                         ║
  2203. *** ╚═══════════════════════════════════════════════════════════════════════╝
  2204. **/
  2205.  
  2206.  
  2207. Error: procedure
  2208.    /**
  2209.    ***  This is a centralized processor for error messages and error handling
  2210.    **/
  2211.  
  2212.    parse arg ErrNo,Fatal,String1,String2,String3
  2213.  
  2214.    if Fatal = 0 then
  2215.       MsgId = 'HRX'right(ErrNo,4,"0")'W:'
  2216.    else
  2217.       MsgId = 'HRX'right(ErrNo,4,"0")'E:'
  2218.  
  2219.  
  2220.    /* Select the error string based on the error number */
  2221.  
  2222.    select
  2223.       when ErrNo = 0    then return
  2224.       when ErrNo = 1001 then Msg = "Return code %1 from RxFuncAdd for SQLEXEC"
  2225.       when ErrNo = 1002 then Msg = "Return code [%1] from SQLEXEC.  You are probably out-of-storage."
  2226.       when ErrNo = 1003 then Msg = "SQL code [%1]: %2"
  2227.       when ErrNo = 2002 then Msg = "File '%1' not found."
  2228.       when ErrNo = 2003 then Msg = "Directory '%1' doesn't exist."
  2229.       when ErrNo = 2004 then Msg = "Missing parameter. %1"
  2230.       when ErrNo = 2005 then Msg = "Close failure on %1. %2"
  2231.       when ErrNo = 2006 then Msg = "Open failure on %1. %2"
  2232.       when ErrNo = 2007 then Msg = "Invalid parameter %1. %2"
  2233.       when ErrNo = 2008 then Msg = "Environment variable %1 is not set. %2"
  2234.       when ErrNo = 3000 then Msg = "Urecognized message '%1' passed from message queue."
  2235.       when ErrNo = 3001 then Msg = "Error from server: %1."
  2236.       when ErrNo = 3002 then Msg = "Invalid keyword: %1. %2"
  2237.       when ErrNo = 3003 then Msg = "File %1 is not of the proper format."
  2238.       when ErrNo = 3100 then Msg = "No matching object found %1"
  2239.       when ErrNo = 4000 then Msg = "Host screen doesn't match expected value of '%1'"
  2240.       when ErrNo = 4001 then Msg = "Unexpected return code '%1' from HLLAPI verb '%2'"
  2241.       when ErrNo = 4800 then Msg = "NetBIOS '%1' received a return code %2"
  2242.       when ErrNo = 5005 then Msg = "Return code 5 from RxQueue. Not a valid queue name: '%1'"
  2243.       when ErrNo = 5009 then Msg = "Return code 9 from RxQueue. Queue does not exist: '%1'"
  2244.       when ErrNo = 5010 then Msg = "Return code 10 from RxQueue. Queue is busy: '%1'"
  2245.       when ErrNo = 5012 then Msg = "Return code 12 from RxQueue. Memory failure on queue: '%1'"
  2246.       when ErrNo = 6000 then Msg = "Return code 1000 from RxQueue. Initialization error on queue: '%1'"
  2247.  
  2248.       when ErrNo = 9999 then Msg = "%1"
  2249.       otherwise              Msg = "[%1,%2,%3]"
  2250.    end /* select */
  2251.  
  2252.    /* Render the string with the substituted parameters */
  2253.  
  2254.    Msg = ErrorRender('%1',String1,Msg)
  2255.    Msg = ErrorRender('%2',String2,Msg)
  2256.    Msg = ErrorRender('%3',String3,Msg)
  2257.  
  2258.    Callback = value("REXX.CALLBACK",,"OS2ENVIRONMENT")
  2259.    if Callback = '1' then
  2260.       call ErrorHandler Msg
  2261.    else
  2262.       say MsgId Msg
  2263.  
  2264.    /* Should we terminate? */
  2265.  
  2266.    if Fatal then exit ErrNo
  2267.    return 0
  2268.  
  2269.  
  2270. ErrorRegister: procedure
  2271.    /**
  2272.    *** This will register a callback to the calling routine for error handling
  2273.    *** after the error message has been rendered.
  2274.    ***
  2275.    *** If this code is called, the caller MUST have a routine called
  2276.    *** 'ErrorHandler' that is used to display the error message in an
  2277.    *** appropriate way.
  2278.    ***
  2279.    **/
  2280.  
  2281.    parse arg callback
  2282.    if callback = '' then
  2283.       callback = '1'
  2284.  
  2285.    code = value("REXX.CALLBACK",callback,"OS2ENVIRONMENT")
  2286.    return 0
  2287.  
  2288.  
  2289. ErrorRender: procedure
  2290.  
  2291.    parse arg Symbol,SymValue,Line
  2292.  
  2293.    if pos(Symbol, Line) > 0 then
  2294.       do
  2295.       parse var Line prefix (Symbol) suffix
  2296.       Line = prefix || SymValue || suffix
  2297.       end
  2298.    return Line
  2299.  
  2300. /* #include <system.rex> */
  2301.  
  2302. /**
  2303. *** ┌───────────────────────────────────────────────────────────────────────┐
  2304. *** │ Misc system functions                                                 │
  2305. *** └───────────────────────────────────────────────────────────────────────┘
  2306. **/
  2307.  
  2308. ThisDirectory: procedure
  2309.    /**
  2310.    ***  This will return the directory from which this exec was run
  2311.    **/
  2312.  
  2313.    parse source . . ThisFile
  2314.    LastSlash = lastpos('\', ThisFile)
  2315.    ThisDir = left(ThisFile, (LastSlash-1))
  2316.    return ThisDir
  2317.  
  2318.  
  2319. SystemDirectory: procedure
  2320.    /**
  2321.    ***  This will try to determine where the OS/2 system is located by
  2322.    ***  looking for a key DLL
  2323.    **/
  2324.  
  2325.    dir = "C:\OS2"
  2326.  
  2327.    code = RxQueue('Create','SysDir')
  2328.    que  = RxQueue('Set'   ,'SysDir')
  2329.    '@pstat /L | rxqueue SysDir'
  2330.  
  2331.    do while queued() > 0
  2332.       pull line
  2333.       if pos('DOSCALL1.DLL', line) > 0 then
  2334.          do
  2335.          line = word(line, words(line))
  2336.          parse var line dir '\DLL\DOSCALL1.DLL'
  2337.          do queued();pull .;end
  2338.          end
  2339.    end
  2340.  
  2341.    code = RxQueue('Delete','SysDir')
  2342.    que  = RxQueue('Set'   ,que)
  2343.    return strip(dir)
  2344.  
  2345.  
  2346. SystemDrive: procedure
  2347.    /**
  2348.    ***  This will return the single drive letter for the system
  2349.    **/
  2350.    path = translate(value("PATH",,"OS2ENVIRONMENT"))
  2351.    psn = pos(":\OS2",path)
  2352.    if psn < 1 then
  2353.       BootDrive = 'C'
  2354.    else
  2355.       BootDrive = substr(path,(psn-1),1)
  2356.    return BootDrive
  2357.  
  2358.  
  2359. WaitOnProcess: procedure
  2360.    /**
  2361.    ***  This will wait until the process count for the process name
  2362.    ***  passed is less than or equal to the count passed.  There is
  2363.    ***  also an optional polling wait time.
  2364.    **/
  2365.  
  2366.    arg process,count,wait
  2367.  
  2368.    if count = '' then
  2369.       count = 0
  2370.  
  2371.    if wait = '' then
  2372.       wait = 15  /* Default to polling every 15 seconds */
  2373.  
  2374.    QName = RxQueue('Create')
  2375.    Prev = RxQueue('Set',QName)
  2376.    do until found <= count
  2377.       call SysSleep wait
  2378.       '@pstat /c | RXQUEUE' QName
  2379.       found = 0
  2380.       do queued()
  2381.          pull pstat
  2382.          if pos(process,pstat) > 0 then
  2383.             found = found + 1
  2384.       end
  2385.    end
  2386.    code = RxQueue('Set',Prev)
  2387.    code = RxQueue('Delete',QName)
  2388.    return 0
  2389.  
  2390.  
  2391. ScanEnvironment: procedure expose IniFile
  2392.    /**
  2393.    ***  This will list the contents of the environment variable in a list.
  2394.    ***  It was designed to list those environment variables that are a
  2395.    ***  list of directories, separated by semicolons, such as a PATH or
  2396.    ***  DPATH variable.  Although it is not an environment variable, this
  2397.    ***  code will do the same for the LIBPATH by looking in the CONFIG.SYS
  2398.    **/
  2399.  
  2400.    parse arg EnvVariable, File
  2401.    EnvVariable = translate(EnvVariable)
  2402.  
  2403.    if EnvVariable = '' then
  2404.       do
  2405.       call Error 2004,0,"You must specify the environment variable."
  2406.       return
  2407.       end
  2408.  
  2409.    if File = '' then
  2410.       do
  2411.       call Error 2004,0,"You must specify the filename to search for."
  2412.       return
  2413.       end
  2414.  
  2415.    /* Take care of the special case for LIBPATH */
  2416.  
  2417.    if EnvVariable = 'LIBPATH' then
  2418.       do
  2419.       EnvValue = GetLibpath()
  2420.       code = value("LIBPATH",EnvValue,"OS2ENVIRONMENT")
  2421.       end
  2422.  
  2423.    select
  2424.       when EnvVariable = 'PATH'      then extensions = 'COM EXE BAT CMD'
  2425.       when EnvVariable = 'DPATH'     then extensions = 'DAT MSG'
  2426.       when EnvVariable = 'LIBPATH'   then extensions = 'DLL FON'
  2427.       when EnvVariable = 'HELP'      then extensions = 'HLP INF'
  2428.       when EnvVariable = 'BOOK'      then extensions = 'INF'
  2429.       when EnvVariable = 'BOOKSHELF' then extensions = 'INF'
  2430.       when EnvVariable = 'READIBM'   then extensions = 'BOO'
  2431.       when EnvVariable = 'BOOKMGR'   then extensions = 'BOO'
  2432.       otherwise                           extensions = ''
  2433.    end
  2434.  
  2435.    fspec = SysSearchPath(EnvVariable, file)
  2436.    do i = 1 to words(extensions) while(fspec = '')
  2437.       ext = word(extensions, i)
  2438.       fspec = SysSearchPath(EnvVariable, file'.'ext)
  2439.    end
  2440.    return fspec
  2441.  
  2442.  
  2443. /* #include <filesystem.rex> */
  2444.  
  2445.  
  2446. CompareFileTimes: procedure
  2447.    /**
  2448.    ***  This returns a boolean that indicates if the datetime stamps from
  2449.    ***  first file is older than the datetime stamp from the second file.
  2450.    ***  the file formats are the syntax from the SysFileTree
  2451.    **/
  2452.  
  2453.    parse arg Stamp.1, Stamp.2
  2454.  
  2455.    do i = 1 to 2
  2456.       parse var Stamp.i mon '/' day '/' year hour ':' temp
  2457.       parse var temp min 3 meridian
  2458.       hour = right(hour,2,'0')
  2459.       mon = right(mon,2,'0')
  2460.       CompareStamp.i = year||mon||day||meridian||hour||min
  2461.    end
  2462.    select
  2463.       when CompareStamp.1 < CompareStamp.2 then
  2464.          return '<'
  2465.       when CompareStamp.1 > CompareStamp.2 then
  2466.          return '>'
  2467.       otherwise
  2468.          return '='
  2469.    end /* select */
  2470.    return '='
  2471.  
  2472.  
  2473. QualifiedDirectory: procedure
  2474.    /**
  2475.    ***  This determines if the file passed is a directory
  2476.    **/
  2477.  
  2478.    parse arg DirSpec
  2479.  
  2480.    Current = directory()           /* Save current directory */
  2481.    NewDir  = directory(DirSpec)    /* Get the fully qualified name */
  2482.    Current = directory(Current)    /* Restore directory */
  2483.    return NewDir
  2484.  
  2485. RootName: procedure
  2486.    /**
  2487.    ***  This will return the root name (e.g. the file name without the
  2488.    ***  extension) for the filename passed
  2489.    **/
  2490.  
  2491.    parse arg File
  2492.  
  2493.    parse value FileSpec("name",File) with ReturnName "." .
  2494.    return ReturnName
  2495.  
  2496.  
  2497. /* #include <io.rex> */
  2498.  
  2499.  
  2500. Close: procedure
  2501.    /**
  2502.    ***  Close a file I/O stream
  2503.    **/
  2504.    parse arg file
  2505.    if file = '' then
  2506.       do
  2507.       call Error 2005,1,file,"No file name was passed to the CLOSE routine."
  2508.       return
  2509.       end
  2510.    message = stream(file,c,'CLOSE')
  2511.    if (message <> 'READY:') & (message <> '') then
  2512.       call Error 2005,1,file,message
  2513.    return file
  2514.  
  2515.  
  2516. Exists: procedure
  2517.    /**
  2518.    *** Return a Boolean indicating whether the file exists or not
  2519.    **/
  2520.    arg file
  2521.  
  2522.    file = stream(file,c,'QUERY EXIST')
  2523.    if (file = '') then
  2524.       return 0
  2525.    else
  2526.       return 1
  2527.  
  2528.  
  2529. Open: procedure
  2530.    /**
  2531.    *** Open a file for READ, WRITE, APPEND or RANDOM (read/write)
  2532.    **/
  2533.    parse arg file, rw
  2534.  
  2535.    if file = '' then
  2536.       do
  2537.       call Error 2006,0,file,'No file name passed on OPEN call.'
  2538.       return ''
  2539.       end
  2540.  
  2541.    rw = translate(rw)
  2542.  
  2543.    select
  2544.       when rw = 'WRITE' then
  2545.          do
  2546.          file_ = stream(file,c,'QUERY EXIST')
  2547.          if file_ <> '' then
  2548.             '@erase "'file'" 2> NUL'
  2549.          end
  2550.       when rw = 'APPEND' then
  2551.          rw = 'WRITE'
  2552.       when rw = 'READ' then
  2553.          rw = 'READ'
  2554.       when rw = 'RANDOM' then
  2555.          rw = ''
  2556.       otherwise
  2557.          rw = 'READ'
  2558.    end /* select */
  2559.  
  2560.    message = stream(file,c,'OPEN' rw)
  2561.    if (message \= 'READY:') then
  2562.       do
  2563.       call Error 2006,0,file,message
  2564.       return ''
  2565.       end
  2566.    return file
  2567.  
  2568. /* #include <string.rex> */
  2569.  
  2570. MapSymbol: procedure
  2571.    /**
  2572.    ***  This will translate the input string to the output string.
  2573.    **/
  2574.  
  2575.    parse arg string, in, out
  2576.  
  2577.    outstring = ''
  2578.    psn = pos(in, string)
  2579.    do while(psn > 0)
  2580.       if psn > 1 then
  2581.          outstring = outstring || substr(string, 1, psn-1)
  2582.       outstring = outstring || out
  2583.       string = substr(string, psn+length(in))
  2584.       psn = pos(in, string)
  2585.    end
  2586.    outstring = outstring || string
  2587.    return outstring
  2588.  
  2589.  
  2590. UpperCase: procedure
  2591.    /**
  2592.    ***  This will convert the string to uppercase
  2593.    **/
  2594.  
  2595.    parse upper arg string
  2596.    return string
  2597.  
  2598.  
  2599. GetNoEcho: procedure
  2600.    /**
  2601.    ***  This will grab keystrokes and enter them back as '*' characters
  2602.    **/
  2603.  
  2604.    Password = ''
  2605.    Key = SysGetKey('NoEcho')
  2606.    do while c2x(Key) <> '0D'
  2607.       select
  2608.          when c2x(Key) = '08' then
  2609.             Password = left(Password, (length(password)-1))
  2610.          otherwise
  2611.             Password = Password || Key
  2612.       end /* select */
  2613.       Key = SysGetKey('NoEcho')
  2614.    end
  2615.    return Password
  2616.  
  2617.  
  2618. LowerCase: procedure
  2619.    /**
  2620.    ***  This will return the string passed after converting it to lowercase
  2621.    **/
  2622.  
  2623.    parse arg String
  2624.    String = translate(String, "abcdefghijklmnopqrstuvwxyz", "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  2625.    return String
  2626.  
  2627.  
  2628. FormatComma: procedure
  2629.    /**
  2630.    ***  This will take a string (that is presumably numeric, but not verified
  2631.    ***  to be) and insert commas after groups of three digits
  2632.    **/
  2633.  
  2634.    arg Raw .
  2635.  
  2636.    Formatted = ''
  2637.    do while Raw \= 0
  2638.       Formatted = right(Raw, 3)','Formatted
  2639.       Raw = Raw % 1000
  2640.    end
  2641.    if Formatted = '' then
  2642.       Formatted = 0
  2643.    else
  2644.       do
  2645.       Formatted = Strip(Formatted,'Trailing',',')
  2646.       Formatted = Strip(Formatted,'Leading',' ')
  2647.       end
  2648.    return Formatted
  2649.  
  2650. /* #include <parseopt.rex> */
  2651.  
  2652. ParseOptions: procedure expose Opt.
  2653.    /**
  2654.    ***  This will parse the string passed into option flags and positional
  2655.    ***  parameters.  Flags are delimited by slash (/) or dash (-).  Positional
  2656.    ***  parms are all the rest with leading and trailing blanks removed
  2657.    **/
  2658.  
  2659.    Opt.Parm.0 = 0
  2660.    parse arg optstring
  2661.  
  2662.  
  2663.    do while (optstring \= '')
  2664.       optstring = strip(optstring)
  2665.       parse value ParseOptTokenType(optstring) with TokenType optstring
  2666.       if TokenType = 'F' then
  2667.          do
  2668.          parse var optstring fl 2 optstring
  2669.          fl = ParseOptSwitch(fl)
  2670.  
  2671.          parse value ParseOptValue(optstring) with col optstring
  2672.          if col = 0 then
  2673.             FlagValue = ""
  2674.          else
  2675.             parse var optstring FlagValue +(col) optstring
  2676.          Opt.Flag.fl = FlagValue
  2677.          end
  2678.       else
  2679.          do
  2680.          parse value ParseOptValue(optstring) with col optstring
  2681.          if col = 0 then
  2682.             ParmValue = ""
  2683.          else
  2684.             parse var optstring ParmValue +(col) optstring
  2685.          j = Opt.Parm.0 + 1
  2686.          Opt.Parm.j = ParmValue
  2687.          Opt.Parm.0 = j
  2688.          end
  2689.    end /* while */
  2690.    return 0
  2691.  
  2692.  
  2693. ParseOptValue: procedure
  2694.    /**
  2695.    ***  This will parse a value, properly handling quoted strings.  It
  2696.    ***  returns the split column followed by the option string (possibly
  2697.    ***  with extraneous quotes removed
  2698.    **/
  2699.  
  2700.    parse arg optstring
  2701.  
  2702.    FirstChar = left(optstring, 1)
  2703.    if FirstChar = " " then
  2704.       return 1 "+"optstring
  2705.  
  2706.    if (FirstChar = '"') | (FirstChar = "'") | (FirstChar = '`') then
  2707.       do
  2708.       parse var optstring quote 2 optstring
  2709.  
  2710.       ending = pos(quote, optstring)
  2711.       select
  2712.          when ending = 0 then
  2713.             return length(optstring) optstring
  2714.          when ending = 1 then
  2715.             return 0 substr(optstring,2)
  2716.          otherwise
  2717.             ending = ending - 1
  2718.       end /* select */
  2719.       parse var optstring ParmValue +(ending) quote +1 Remain
  2720.       return length(ParmValue) ParmValue || Remain
  2721.       end
  2722.    else
  2723.       do
  2724.       parse var optstring ParmValue Remain
  2725.       return length(ParmValue) ParmValue || Remain
  2726.       end
  2727.    return 0
  2728.  
  2729.  
  2730. ParseOptTokenType: procedure
  2731.    /**
  2732.    *** This will determine the token type and return the remainder of the
  2733.    *** string to be parsed.
  2734.    **/
  2735.  
  2736.    parse arg optstring
  2737.  
  2738.    FirstChar = left(optstring,1)
  2739.    select
  2740.       when FirstChar = '-' then
  2741.          do
  2742.          TokenType = 'F'
  2743.          Remain = substr(optstring,2)
  2744.          end
  2745.       when FirstChar = '/' then
  2746.          do
  2747.          TokenType = 'F'
  2748.          Remain = substr(optstring,2)
  2749.          end
  2750.       otherwise
  2751.          do
  2752.          TokenType = 'P'
  2753.          Remain = optstring
  2754.          end
  2755.    end /* select */
  2756.    return TokenType Remain
  2757.  
  2758.  
  2759. ParseOptSwitch: procedure
  2760.    /**
  2761.    *** This translates the flag into an symbolic
  2762.    **/
  2763.  
  2764.    arg FlagName
  2765.    if ((FlagName < 'A') | (FlagName > 'Z')) then
  2766.       do
  2767.       select
  2768.          when FlagName = '?' then FlagName = 'SYNTAX'
  2769.          when FlagName = '!' then FlagName = 'BANG'
  2770.          when FlagName = '*' then FlagName = 'STAR'
  2771.          when FlagName = '#' then FlagName = 'POUND'
  2772.          when FlagName = '$' then FlagName = 'DOLLAR'
  2773.          when FlagName = '%' then FlagName = 'PERCENT'
  2774.          when FlagName = '^' then FlagName = 'HAT'
  2775.          when FlagName = '&' then FlagName = 'AMP'
  2776.          when FlagName = '(' then FlagName = 'LPAR'
  2777.          when FlagName = ')' then FlagName = 'RPAR'
  2778.          when FlagName = '-' then FlagName = 'DASH'
  2779.          when FlagName = '=' then FlagName = 'EQUAL'
  2780.          otherwise /* Force a syntax message */
  2781.             FlagName = 'SYNTAX'
  2782.       end /* select */
  2783.       end /* if */
  2784.    return FlagName
  2785.  
  2786.  
  2787. /* #include <misc.rex> */
  2788.  
  2789. MakeFileName: procedure
  2790.    /**
  2791.    ***  This will make a file name from the string passed.  In the case of
  2792.    ***  HPFS, the name is left pretty much alone.  In the case of FAT, the
  2793.    ***  1st 8 chars are returned, which has a good chance of not being
  2794.    ***  unique.
  2795.    **/
  2796.  
  2797.    parse arg FileSystem,string
  2798.  
  2799.    string = strip(string)
  2800.    if FileSystem = 'HPFS' then
  2801.       Name = translate(string, '!!...!---+', '"\/:*?|<>-&')
  2802.    else
  2803.       Name = left(translate(string, '___________', '"\/:*?|<>-&'), 8)
  2804.    return Name
  2805.  
  2806.  
  2807. GetHilbertIni: procedure
  2808.    /**
  2809.    ***  This will find the INI file that contains profile information.
  2810.    **/
  2811.  
  2812.    /* Look for an environment variable first */
  2813.  
  2814.    IniFile = value('Hilbert.Ini',,"OS2ENVIRONMENT")
  2815.    if IniFile = '' then
  2816.       IniFile = SysSearchPath("DPATH","Hilbert.Ini")
  2817.    if IniFile = '' then
  2818.       do
  2819.       This = ThisDirectory()
  2820.       if Exists(This"\Hilbert.Ini") then
  2821.          IniFile = This"\Hilbert.Ini"
  2822.       end
  2823.    if IniFile = '' then
  2824.       call Error 2002,1,"Hilbert.Ini"
  2825.    return IniFile
  2826.  
  2827. GetTechServIni: procedure
  2828.    /**
  2829.    ***  This will find the INI file that contains profile information.
  2830.    **/
  2831.  
  2832.    /* Look for an environment variable first */
  2833.  
  2834.    IniFile = value('TechServ.Ini',,"OS2ENVIRONMENT")
  2835.    if IniFile = '' then
  2836.       IniFile = SysSearchPath("DPATH","TechServ.Ini")
  2837.    if IniFile = '' then
  2838.       do
  2839.       This = ThisDirectory()
  2840.       if Exists(This"\TechServ.Ini") then
  2841.          IniFile = This"\TechServ.Ini"
  2842.       end
  2843.    if IniFile = '' then
  2844.       call Error 2002,1,"TechServ.Ini"
  2845.   return IniFile
  2846.  
  2847.  
  2848. GetUniqueKey: procedure
  2849.    /**
  2850.    ***  This will return a unique numeric key to the caller.  This should be
  2851.    ***  a systemwide critical section, but there's no way to do that in
  2852.    ***  standard REXX, so we will hope for the best.
  2853.    **/
  2854.  
  2855.    parse arg IniFile
  2856.  
  2857.    IniValue = SysIni(IniFile,'Global','Unique Key')
  2858.    if datatype(IniValue,'Numeric') <> 1 then IniValue = 0
  2859.    IniValue = IniValue + 1
  2860.    code = SysIni(IniFile,'Global','Unique Key',IniValue)
  2861.    return IniValue
  2862.  
  2863. Pause: procedure
  2864.    /**
  2865.    ***  This will wait for a keystroke
  2866.    **/
  2867.  
  2868.    parse arg prompt
  2869.  
  2870.    if prompt <> '' then
  2871.       call charout ,prompt
  2872.  
  2873.    Key = SysGetKey('NOECHO')
  2874.    return Key
  2875.  
  2876.  
  2877. GetIni: procedure expose IniFile
  2878.    /**
  2879.    ***  This will pull a value from the INI file or the default value if
  2880.    ***  there is no entry in the INI file.
  2881.    **/
  2882.  
  2883.    parse arg Application, Key, Default
  2884.  
  2885.    IniValue = SysIni(IniFile,Application,Key)
  2886.    if IniValue = 'ERROR:' then
  2887.       do
  2888.       say "Enter value for"
  2889.       say "    Application: '"Application"'"
  2890.       say "            Key: '"key"'"
  2891.       say "        Default: '"Default"'"
  2892.       call charout ,"> "
  2893.       parse pull IniValue
  2894.       if IniValue = '' then
  2895.          do
  2896.          IniValue = Default
  2897.          if IniValue <> '' then
  2898.             code = SysIni(IniFile,Application,IniValue)
  2899.          end
  2900.       code = SysIni(IniFile,Application,Key,IniValue)
  2901.       end
  2902.    return IniValue
  2903.  
  2904.  
  2905.  
  2906. /**
  2907. *** ═══════════════════════════════════════════════════════════════════════
  2908. *** Change History:
  2909. ***      3.0   - Changed to use INI services.  Removed some rarely-used
  2910. ***              routines.  Changed code to use the preprocessor and common
  2911. ***              included code.
  2912. ***      3.1   - Prompt for INI information on 'ERROR:'.
  2913. ***      3.2   - Added RECURSE
  2914. ***              Changed the INCLUDE env var for IBMC profile
  2915. ***      3.3   - Added COPYSAFE to the code
  2916. ***      3.4   - Added BACKUP CONFIG and BACKUP CHRON
  2917. ***      3.4.1 - Fixed bug where INIFILE wasn't exposed properly for BACKUP
  2918. ***              subcommand.
  2919. ***      3.4.2 - Fixed a bug on the copy command when the second dest parm
  2920. ***              was omitted.
  2921. ***      3.5   - Added TRACE command
  2922. ***              Added SCANENVIRONMENT command
  2923. ***      3.5.1 - Made WHICH an alias for SCANENVIRONMENT
  2924. ***              Added automatic extension searching on WHICH based on the
  2925. ***              environment variable.
  2926. ***      3.6   - Changed ZIP function to use project profiles
  2927. ***            - Added more to PROFILE to work with make and eliminate
  2928. ***              NMAKEPTH.INC.
  2929. ***      3.7   - Tweaked MAKE and PROFILE functions
  2930. ***      3.8   - More work on PROFILE commands
  2931. ***      3.9   - Added support for additional LIB paths and INCLUDE paths
  2932. ***              to the profile.
  2933. ***      3.10  - Misc bug fixes
  2934. ***      3.11  - Added the LIB function
  2935. ***      3.12  - Added the code to verify the Gopher menus
  2936. ***      3.13  - Changed PROFILE IBMCPP to include Hilbert classes
  2937. ***      3.14  - Changed notification process to NOT issue a start, but
  2938. ***              to invoke the program directly
  2939. ***      3.15  - Added LIB MAKE
  2940. ***            - Added SYNCH code
  2941. ***      3.16  - Added SYNCH C++
  2942. ***            - Fixed a bug where copysafe was exiting instead of returning
  2943. ***            - PROFILE creates base directory if it didn't exist
  2944. *** ═══════════════════════════════════════════════════════════════════════
  2945. **/
  2946.