home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 11 Util / 11-Util.zip / tlh120.zip / INSTALL / INSTALL.CMD < prev    next >
OS/2 REXX Batch file  |  1995-07-29  |  18KB  |  637 lines
  1. /*
  2.  *      INSTALL.CMD TLHIDE V1.2 - C.Langanke 1995 - Installation
  3.  *
  4.  *      Syntax: INSTALL.CMD [/LANGUAGE:deutsch|english] [/TARGETDIR:...]
  5.  *                          [/LISTFILE:...] [/LOCATION:"<...>"] [/BATCH]
  6.  *                          [/?]
  7.  *
  8.  *      Creates a WPS folder and program objects for the TLHIDE package. 
  9.  *      Optionally copies files of TLHIDE package to a target directory before.
  10.  *
  11.  *      /LANGUAGE:...      -  deutsch/english [Default:deutsch]
  12.  *      /TARGETDIR:...     -  name of target directory where files are to be
  13.  *                            copied to before installation of WPS objects
  14.  *                            All files must be unzipped before invoking INSTALL !!!
  15.  *                            If /TARGETDIR is not specified, no copy is performed!
  16.  *      /LISTFILE:...      -  defaultname of listfile
  17.  *      /LOCATION:"<...>"  -  WPS-ID: Location for the TLHIDE folder 
  18.  *                            [Default: "<WP_DESKTOP>"]
  19.  *      /BATCH             -  don't use menus and prompts: just install with defaults
  20.  *      /?                 -  display this help text
  21.  */
  22. /* The first comment is used as online help text */
  23.  
  24.  SIGNAL ON HALT
  25.  
  26.  TitleLine = STRIP(SUBSTR(SourceLine(2), 3));
  27.  PARSE VAR TitleLine CmdName'.CMD 'Info
  28.  Title     = CmdName Info
  29.  NewLine   = D2C(13)||D2C(10);
  30.  TRUE      = (1 = 1);
  31.  FALSE     = (0 = 1);
  32.  Redirection = '1>NUL 2>&1';
  33.  '@ECHO OFF'
  34.   
  35.  /* some OS/2 Error codes */
  36.  ERROR.NO_ERROR          =  0;
  37.  ERROR.ACCESS_DENIED     =  5;
  38.  ERROR.INVALID_PARAMETER = 87;
  39.  
  40.  /* some default values */
  41.  Default.PromptLen = 60;
  42.  ExitMessage       = 'Abbruch durch Benutzer.';
  43.  
  44.  /* defaults */
  45.  Default.Location  = "<WP_DESKTOP>";
  46.  Default.ListFile  = 'TLHIDE.LST';
  47.  Default.Language  = 'deutsch';
  48.  
  49.  /* flags */
  50.  Flag.Batch        = FALSE;
  51.  Flag.Language     = FALSE;
  52.  Flag.InvalidParm  = FALSE;
  53.  Value.InvalidParm = '';
  54.  
  55.  /* defaults for selection by parms */
  56.  Selected.TargetDir = '';
  57.  Selected.Location  = Default.Location;
  58.  Selected.ListFile  = Default.ListFile;
  59.  Selected.Language  = '';
  60.  
  61.  /* determine directories */
  62.  InstallDir       = GetCallDir();
  63.  LastSlash        = LASTPOS( '\', InstallDir);
  64.  ProgDir          = LEFT(InstallDir, LastSlash - 1);
  65.  
  66.  /* NLS definitions */
  67.  DefaultMessageFile  = ProgDir'\TLHIDE.MSG';
  68.  NlsMsgFile.1        = InstallDir'\TLHGER.MSG';
  69.  NlsMsgFile.2        = InstallDir'\TLHUS.MSG';
  70.  DefaultInfFile      = ProgDir'\TLHIDE.INF';
  71.  NlsInfFile.1        = InstallDir'\TLHGER.INF';
  72.  NlsInfFile.2        = InstallDir'\TLHUS.INF';
  73.  NlsOverview.1       = '"TLHIDE Überblick"';
  74.  NlsOverview.2       = '"TLHIDE Overview"';
  75.  
  76. /*
  77.  *      load RexxUtil
  78.  */
  79.  
  80.  CALL RxFuncAdd    'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs';
  81.  CALL SysLoadFuncs;
  82.   
  83. /*
  84.  *      show help
  85.  */
  86.  
  87.  ARG Parms
  88.  IF (POS('?', Parms) > 0) THEN
  89.  DO
  90.     rc = ShowHelp();
  91.     EXIT(ERROR.NO_ERROR)
  92.  END;
  93.  
  94. /*
  95.  *      read commandline parms
  96.  */
  97.  
  98.  PARSE ARG Parms
  99.  
  100.  DO i = 1 TO WORDS(Parms);
  101.     ThisParm = WORD(Parms, i);
  102.     PARSE VAR ThisParm ThisTag':'ThisValue
  103.     ThisTag = TRANSLATE(ThisTag);
  104.  
  105.     SELECT
  106.        WHEN (POS(ThisTag, '/LANGUAGE') = 1) THEN
  107.        DO
  108.           Selected.Language = TRANSLATE(ThisValue);
  109.           Flag.Language     = TRUE;
  110.        END;
  111.  
  112.        WHEN (POS(ThisTag, '/LISTFILE') = 1) THEN
  113.        DO
  114.           Selected.Listfile = ThisValue;
  115.        END;
  116.  
  117.        WHEN (POS(ThisTag, '/TARGETDIR') = 1) THEN
  118.        DO
  119.           Selected.TargetDir = ThisValue;
  120.        END;
  121.  
  122.        WHEN (POS(ThisTag, '/LOCATION') = 1) THEN
  123.        DO
  124.           ThisValue = STRIP(ThisValue);
  125.           IF (LEFT(ThisValue, 1) = '"') THEN
  126.              PARSE VAR ThisValue '"'ThisValue'"'
  127.           Selected.Location = ThisValue;
  128.        END;
  129.  
  130.        WHEN (POS(ThisTag, '/BATCH') = 1) THEN
  131.        DO
  132.           Flag.Batch = TRUE;
  133.        END;
  134.  
  135.        OTHERWISE
  136.        DO
  137.           Flag.InvalidParm = TRUE;
  138.           Value.InvalidParm = ThisParm;
  139.        END;
  140.  
  141.     END; /* SELECT */
  142.  END; /* DO */
  143.  
  144.  
  145. /*
  146.  *      modify parms if batch is requested
  147.  */
  148.  
  149.  IF (Flag.Batch) THEN
  150.  DO
  151.     /* use default lanuage if not selected */
  152.     IF (Selected.Language = '') THEN
  153.     DO
  154.        Selected.Language = Default.Language;
  155.        Flag.Language     = TRUE;
  156.     END;
  157.  END;
  158.  
  159. /*
  160.  *      select language
  161.  */
  162.  
  163.  /* select language */
  164.  SELECT
  165.     WHEN (LEFT(Selected.Language, 1) = 'D') THEN Choice = 1;
  166.     WHEN (LEFT(Selected.Language, 1) = 'E') THEN Choice = 2;
  167.     OTHERWISE                                    Choice = 'UNSELECTED';
  168.  END;
  169.  
  170. SelectLanguage:
  171.  IF (Choice = 'UNSELECTED') THEN
  172.  DO
  173.     DROP(Menu.);
  174.     Menu.ValidMenuKeys = '12';
  175.     Menu.Line.0 = 6;
  176.     Menu.Line.1 = '';
  177.     Menu.Line.2 = Title
  178.     Menu.Line.3 = '';
  179.     Menu.Line.4 = '';
  180.     Menu.Line.5 = '   1.  deutsch';
  181.     Menu.Line.6 = '   2.  english';
  182.     Choice = Menu();
  183.  END;
  184.  
  185.  /* select NLS files */
  186.  MessageFile = NlsMsgFile.Choice;
  187.  InfFile     = NlsInfFile.Choice;
  188.  Overview    = NlsOverview.Choice;
  189.  
  190.  /* load MessageIds and YesNo Keys*/
  191.  MessageFileInfo        = LoadMsgString(0, MessageFile)
  192.  PARSE VAR MessageFileInfo InstMsgStart InstObjectsStart InstObjectsEnd YesKey NoKey ValidKeys2 InstLanguage
  193.  
  194.  /* load MessageIds */
  195.  NlsMsg.AbortProgram     = LoadMsgString(InstMsgStart +  0, MessageFile);
  196.  NlsMsg.AlreadyActive    = LoadMsgString(InstMsgStart +  1, MessageFile);
  197.  NlsMsg.HaltMsg          = LoadMsgString(InstMsgStart +  2, MessageFile);
  198.  NlsMsg.Readme           = LoadMsgString(InstMsgStart +  3, MessageFile);
  199.  NlsMsg.Install          = LoadMsgString(InstMsgStart +  4, MessageFile);
  200.  NlsMsg.NLSSelect        = LoadMsgString(InstMsgStart +  5, MessageFile);
  201.  NlsMsg.LstSelect        = LoadMsgString(InstMsgStart +  6, MessageFile);
  202.  NlsMsg.Exit             = LoadMsgString(InstMsgStart +  7, MessageFile);
  203.  NlsMsg.Ok               = LoadMsgString(InstMsgStart +  8, MessageFile);
  204.  NlsMsg.Error            = LoadMsgString(InstMsgStart +  9, MessageFile);
  205.  NlsMsg.LstSelectPrompt  = LoadMsgString(InstMsgStart + 10, MessageFile);
  206.  NlsMsg.SelectDefault    = LoadMsgString(InstMsgStart + 11, MessageFile);
  207.  NlsMsg.InstallPrompt    = LoadMsgString(InstMsgStart + 12, MessageFile)
  208.  NlsMsg.TargetDirInstall = LoadMsgString(InstMsgStart + 13, MessageFile);
  209.  NlsMsg.TargetDirExists  = LoadMsgString(InstMsgStart + 14, MessageFile);
  210.  NlsMsg.InvalidParm      = LoadMsgString(InstMsgStart + 15, MessageFile);
  211.  NlsMsg.NotExist         = LoadMsgString(InstMsgStart + 16, MessageFile);
  212.  NlsMsg.XcopyFailed      = LoadMsgString(InstMsgStart + 17, MessageFile);
  213.  NlsMsg.DeactivatePrompt = LoadMsgString(InstMsgStart + 18, MessageFile);
  214.  NlsMsg.Deactivated      = LoadMsgString(InstMsgStart + 19, MessageFile);
  215.  NlsMsg.Create           = LoadMsgString(InstMsgStart + 20, MessageFile);
  216.  NlsMsg.Delete           = LoadMsgString(InstMsgStart + 21, MessageFile);
  217.  NlsMsg.MsgFileCopy      = LoadMsgString(InstMsgStart + 22, MessageFile);
  218.  NlsMsg.MsgFileLocked    = LoadMsgString(InstMsgStart + 23, MessageFile);
  219.  NlsMsg.InfFileCopy      = LoadMsgString(InstMsgStart + 24, MessageFile);
  220.  NlsMsg.InfFileLocked    = LoadMsgString(InstMsgStart + 25, MessageFile);
  221.  NlsMsg.Deinstall        = LoadMsgString(InstMsgStart + 26, MessageFile);
  222.  NlsMsg.NotInstalled     = LoadMsgString(InstMsgStart + 27, MessageFile);
  223.  
  224.  ExitMessage = NlsMsg.HaltMsg;
  225.  
  226. /*
  227.  *      validate parms
  228.  */
  229.  
  230.  IF (Flag.InvalidParm) THEN
  231.  DO
  232.     IF (Flag.Language) THEN
  233.     DO
  234.        SAY;
  235.        SAY Title
  236.        SAY;
  237.     END;
  238.     SAY CmdName':' NlsMsg.Error':' NlsMsg.InvalidParm '»'Value.InvalidParm'«.';
  239.     EXIT(ERROR.INVALID_PARAMAMETER);
  240.  END;
  241.  
  242.  IF (\ObjectExist(Selected.Location)) THEN
  243.  DO
  244.     IF (Flag.Language) THEN
  245.     DO
  246.        SAY;
  247.        SAY Title
  248.        SAY;
  249.     END;
  250.     SAY CmdName':' NlsMsg.Error':' NlsMsg.NotExist':' Selected.Location
  251.     EXIT(ERROR.INVALID_PARAMETER);
  252.  END;
  253.  
  254. /*
  255.  *      if target directory is specified, do a xcopy and call
  256.  *       this batch again within the target directory structure
  257.  */
  258.  
  259.  IF (Selected.TargetDir \= '' ) THEN
  260.  DO
  261.     IF (\Flag.Batch) THEN
  262.        IF (\ProceedWith(NlsMsg.InstallPrompt Selected.TargetDir)) THEN
  263.           SIGNAL HALT;
  264.     SAY NlsMsg.TargetDirInstall Selected.TargetDir
  265.     IF (FileExist(Selected.TargetDir)) THEN
  266.     DO
  267.        IF (Flag.Batch) THEN
  268.        DO
  269.           SAY;
  270.           SAY Title
  271.           SAY;
  272.        END;
  273.        SAY; 
  274.        SAY NlsMsg.TargetDirExists
  275.        SAY NlsMsg.AbortProgram
  276.        EXIT(ERROR.ACCESS_DENIED);
  277.     END;
  278.     'XCOPY' ProgDir'\*.*' Selected.TargetDir'\ /S /E /T /H' Redirection
  279.     IF (rc \= ERROR.NO_ERROR) THEN
  280.     DO
  281.        IF (Flag.Batch) THEN
  282.        DO
  283.           SAY;
  284.           SAY Title
  285.           SAY;
  286.        END;
  287.        SAY; 
  288.        SAY NlsMsg.XcopyFailed
  289.        SAY NlsMsg.AbortProgram
  290.        EXIT(ERROR.ACCESS_DENIED);
  291.     END;
  292.     rc = DIRECTORY(Selected.TargetDir);
  293.     
  294.     CallParms = '/LANGUAGE:'InstLanguage '/LISTFILE:'Selected.Listfile '/LOCATION:"'Selected.Location'"'
  295.     IF (Flag.Batch) THEN CallParms = CallParms '/BATCH';
  296.     'CALL' Selected.TargetDir'\INSTALL\INSTALL.CMD' CallParms 
  297.     EXIT(ERROR.NO_ERROR);
  298.  END;
  299.  
  300. /*
  301.  *      select installation, readme, or listfile selection
  302.  */
  303.  
  304.  DROP(Menu.);
  305.  Menu.ValidMenuKeys = ValidKeys2;
  306.  Menu.Line.0  = 10;
  307.  Menu.Line.1  = '';
  308.  Menu.Line.2  = Title;
  309.  Menu.Line.3  = '';
  310.  Menu.Line.4  = '';
  311.  Menu.Line.5  = '   ' NlsMsg.Readme
  312.  Menu.Line.6  = '   ' NlsMsg.Install
  313.  Menu.Line.7  = '   ' NlsMsg.NLSSelect
  314.  Menu.Line.9  = '';
  315.  Menu.Line.10 = '   ' NlsMsg.Exit
  316.  
  317.  DO WHILE (TRUE)
  318.     /* setup dynamically changing lines here */
  319.     Menu.Line.8  = '   ' NlsMsg.LstSelect '['Selected.ListFile']'
  320.  
  321.     /* just install within batch mode */
  322.     IF (Flag.Batch) THEN
  323.     DO
  324.        DO i = 1 TO 3
  325.           Say Menu.Line.i;
  326.        END;
  327.        LEAVE;
  328.     END;
  329.  
  330.     Choice = Menu();
  331.     SELECT
  332.        WHEN (Choice = SUBSTR(ValidKeys2, 1, 1)) THEN 
  333.        DO
  334.           'START VIEW' InfFile Overview
  335.           rc = SysSleep(3);
  336.        END;
  337.  
  338.        WHEN (Choice = SUBSTR(ValidKeys2, 2, 1)) THEN LEAVE;
  339.  
  340.        WHEN (Choice = SUBSTR(ValidKeys2, 3, 1)) THEN 
  341.        DO
  342.           Choice = 'UNSELECTED';
  343.           SIGNAL SelectLanguage;
  344.        END;
  345.  
  346.        WHEN (Choice = SUBSTR(ValidKeys2, 4, 1)) THEN 
  347.        DO
  348.           NewListFile = PullVariable(Selected.ListFile, NlsMsg.LstSelectPrompt);
  349.           IF (NewListFile \= Default.ListFile) THEN
  350.           DO
  351.              IF (NewListFile = Selected.ListFile) THEN
  352.              DO
  353.                 IF (ProceedWith( NlsMsg.SelectDefault '['Default.Listfile']')) THEN
  354.                    NewListfile = Default.ListFile;
  355.              END;
  356.           END;
  357.           Selected.ListFile = NewListFile;
  358.        END;
  359.  
  360.        WHEN (Choice = SUBSTR(ValidKeys2, 5, 1)) THEN SIGNAL HALT;
  361.        OTHERWISE NOP;
  362.     END /* SELECT */
  363.  END; /* WHILE (TRUE) */
  364.  
  365. /*
  366.  *      deactivate TLHIDE, if it is active
  367.  */
  368.  
  369.  'CALL ' ProgDir'\TLHIDE /S' Redirection
  370.  IF (rc = 1) THEN
  371.  DO
  372.     SAY;
  373.     SAY NlsMsg.AlreadyActive;
  374.     IF (\Flag.Batch) THEN
  375.        IF (\ProceedWith(NlsMsg.DeactivatePrompt)) THEN
  376.           EXIT(ERROR.GEN_FAILURE);
  377.     'CALL ' ProgDir'\TLHIDE /U' Redirection
  378.     SAY NlsMsg.Deactivated;
  379.     SAY;
  380.  END;
  381.  
  382. /*
  383.  *      copy Msg file
  384.  */
  385.  
  386.  CALL CHAROUT, LEFT(NlsMsg.MsgFileCopy '...', Default.PromptLen)
  387.  'COPY' MessageFile DefaultMessageFile Redirection
  388.  IF (rc = ERROR.NO_ERROR) THEN
  389.     SAY NlsMsg.Ok
  390.  ELSE
  391.  DO
  392.     SAY;
  393.     SAY NlsMsg.Error '!'
  394.     SAY NlsMsg.MsgFileLocked
  395.     SAY NlsMsg.AbortProgram;
  396.     SAY;
  397.     EXIT(ERROR.GEN_FAILURE);
  398.  END;
  399.  
  400. /*
  401.  *      copy INF file
  402.  */
  403.  
  404.  CALL CHAROUT, LEFT(NlsMsg.InfFileCopy '...', Default.PromptLen)
  405.  'COPY' InfFile DefaultInfFile Redirection
  406.  IF (rc = ERROR.NO_ERROR) THEN
  407.     SAY NlsMsg.Ok
  408.  ELSE
  409.  DO
  410.     SAY;
  411.     SAY NlsMsg.Error '!'
  412.     SAY NlsMsg.InfFileLocked
  413.     SAY NlsMsg.AbortProgram;
  414.     SAY;
  415.     EXIT(ERROR.GEN_FAILURE);
  416.  END;
  417.  
  418. /*
  419.  *      Now create all objects defined
  420.  */
  421.  
  422.  DO i = InstObjectsStart TO InstObjectsEnd
  423.  
  424.     /* load object details */
  425.     ObjectDetails = LoadMsgString(i, MessageFile);
  426.     PARSE VAR ObjectDetails,
  427.            '"'ObjectClass'"',
  428.            '"'ObjectLocation'"',
  429.            '"'ObjectId'"',
  430.            '"'ObjectTitle'"',
  431.            '"'ObjectOption'"',
  432.            '"'ObjectExeName'"',
  433.            '"'ObjectParameters'"',
  434.            '"'ObjectSetup'"'
  435.  
  436.     /* use selected location */
  437.     IF (ObjectLocation = Default.Location) THEN
  438.        ObjectLocation = Selected.Location;
  439.  
  440.     /* make insertions to setup string */
  441.     IF ((ObjectExeName \= '') | (ObjectParameters \= '')) THEN
  442.     DO
  443.        /* add path to Exename, if neccessary */
  444.        IF ((ObjectExename \= '*') & (FileExist(ProgDir'\'ObjectExename))) THEN
  445.           ObjectExeName = ProgDir'\'ObjectExeName;
  446.  
  447.        /* append rest of setup */
  448.        ObjectSetup =,
  449.                    'EXENAME='ObjectExeName';'||,
  450.                    'PARAMETERS='ObjectParameters';'||,
  451.                    'STARTUPDIR='ProgDir';'||,
  452.                    ObjectSetup;
  453.     END;
  454.  
  455.     /* SetupString: replace '@1' with program directory */
  456.     ObjectSetup = TranslateString(ObjectSetup, ProgDir, '@1');
  457.  
  458.     /* SetupString: replace '@2' with Listfile */
  459.     ObjectSetup = TranslateString(ObjectSetup, Selected.ListFile, '@2');
  460.  
  461.     /* create object */
  462.     rc = CreateObject(ObjectTitle, ObjectClass, ObjectLocation,,
  463.                       'OBJECTID='ObjectId';'||,
  464.                       ObjectSetup, ObjectOption);
  465.  END;
  466.  
  467.  /* show the folder (open twice is ok, ccview=no is set !) */
  468.  rc = SysSetObjectData('<TLHIDE_FOLDER>', 'OPEN=DEFAULT;');
  469.  rc = SysSetObjectData('<TLHIDE_FOLDER>', 'OPEN=DEFAULT;');
  470.  
  471.  EXIT(ERROR.NO_ERROR);
  472.  
  473. /* ------------------------------------------------------------------------- */
  474.  
  475. HALT:
  476.   SAY ExitMessage;
  477.   EXIT(ERROR.GEN_FAILURE);
  478.  
  479. /* ------------------------------------------------------------------------- */
  480. ShowHelp: PROCEDURE EXPOSE ExitMessage Title
  481.  
  482.  SAY;
  483.  SAY Title
  484.  SAY;
  485.  
  486.  PARSE SOURCE . . ThisFile
  487.  
  488.  /* skip header */
  489.  DO i = 1 TO 3
  490.     rc = LINEIN(ThisFile);
  491.  END;
  492.  
  493.  /* show help */
  494.  DO WHILE (ThisLine \= ' */')
  495.     ThisLine = LINEIN(Thisfile);
  496.     SAY SUBSTR(ThisLine, 7);
  497.  END;
  498.  
  499.  /* close file */
  500.  rc = LINEOUT(Thisfile);
  501.  
  502.  RETURN('');
  503.  
  504. /* ------------------------------------------------------------------------- */
  505. CreateObject: PROCEDURE EXPOSE NlsMsg. Default. ExitMessage
  506.  PARSE ARG Title, Class, Location, Setup, Option
  507.  
  508.  CALL CHAROUT, LEFT(NlsMsg.Create Title '...', Default.PromptLen)
  509.  
  510.  rc = SysCreateObject(Class, Title, Location, Setup, Option);
  511.  
  512.  IF (rc) THEN
  513.     SAY NlsMsg.Ok
  514.  ELSE
  515.     SAY NlsMsg.Error '!'
  516.  
  517.  RETURN(rc);
  518.  
  519. /* ------------------------------------------------------------------------- */
  520. PullVariable: PROCEDURE EXPOSE ExitMessage
  521.  PARSE ARG Default, Message
  522.  
  523.  SAY;
  524.  CALL CHAROUT, Message '['Default'] : ';
  525.  PARSE PULL PullVar;
  526.  IF (LENGTH(PullVar) > 0) THEN
  527.     RETURN(PullVar);
  528.  ELSE
  529.     RETURN(Default);
  530.  
  531. /* ------------------------------------------------------------------------- */
  532. LoadMsgString: PROCEDURE EXPOSE ExitMessage
  533.  ARG MsgId, MessageFile
  534.  
  535.  Message = SysGetMessage(MsgId, MessageFile);
  536.  RETURN(LEFT(Message, LENGTH(Message) - 2));
  537.  
  538. /* ------------------------------------------------------------------------- */
  539. FileExist: PROCEDURE EXPOSE ExitMessage
  540.  ARG FileName
  541.  
  542.  RETURN(STREAM(Filename, 'C', 'QUERY EXISTS') > '');
  543.    
  544. /* ------------------------------------------------------------------------- */
  545. GetCalldir: PROCEDURE EXPOSE ExitMessage
  546. PARSE SOURCE . . CallName
  547.  CallDir = FILESPEC('Drive', CallName)||FILESPEC('Path', CallName);
  548.  RETURN(LEFT(CallDir, LENGTH(CallDir) - 1));
  549.  
  550. /* ------------------------------------------------------------------------- */
  551. GetDrivePath: PROCEDURE EXPOSE ExitMessage
  552.  ARG FileName
  553.  
  554.  FullPath = FILESPEC('D', FileName)||FILESPEC('P', FileName);
  555.  IF (FullPath \= '') THEN
  556.     RETURN(LEFT(FullPath, LENGTH(FullPath) - 1));
  557.  ELSE
  558.     RETURN('');
  559.  
  560. /* ------------------------------------------------------------------------- */
  561. PullVariable: PROCEDURE EXPOSE ExitMessage
  562.  PARSE ARG Default, Message
  563.  
  564.  SAY;
  565.  CALL CHAROUT, Message '['Default'] : ';
  566.  PARSE PULL PullVar;
  567.  IF (LENGTH(PullVar) > 0) THEN
  568.     RETURN(PullVar);
  569.  ELSE
  570.     RETURN(Default);
  571.  
  572. /* ------------------------------------------------------------------------- */
  573. TranslateString: PROCEDURE EXPOSE ExitMessage
  574.  PARSE ARG String, ReplaceString, SearchString
  575.  
  576.  TagPos   = POS(SearchString, String);
  577.  TagLen   = LENGTH(SearchString);
  578.  
  579.  IF (TagPos > 0) THEN
  580.  DO
  581.     NewString  = '';
  582.     LastTagPos = 1 - TagLen;
  583.     DO WHILE (TagPos > 0)
  584.        NewString  = NewString''SUBSTR(String, LastTagPos + TagLen, TagPos - LastTagPos - TagLen, )''ReplaceString;
  585.        LastTagPos = TagPos;
  586.        TagPos     = POS(SearchString, String, TagPos + TagLen);
  587.     END;
  588.     NewString     = NewString''SUBSTR(String, LastTagPos + TagLen);
  589.     RETURN(NewString);
  590.  END;
  591.  ELSE
  592.     RETURN(String);
  593.  
  594. /* ========================================================================= */
  595. ObjectExist: PROCEDURE EXPOSE ExitMessage
  596.  ARG ObjectId
  597.  
  598.  RETURN(SysSetObjectData(ObjectId, ';'));
  599.    
  600. /* ========================================================================= */
  601. ProceedWith: PROCEDURE EXPOSE YesKey NoKey ExitMessage
  602.  PARSE ARG Prompt
  603.  
  604.  ch            = ' ';
  605.  ValidResponse = YesKey||NoKey;
  606.  
  607.  SAY;
  608.  CALL CHAROUT ,Prompt '('YesKey'/'NoKey') '
  609.  DO WHILE (POS(ch, ValidResponse) = 0)
  610.     PULL ch
  611.     ch = TRANSLATE(ch);
  612.     IF (POS(ch, ValidResponse) = 0) THEN BEEP(800, 200);
  613.  END;
  614.  SAY;
  615.  SAY;
  616.  RETURN(ch = YesKey);
  617.    
  618. /* ========================================================================= */
  619. Menu: PROCEDURE EXPOSE Menu. TRUE FALSE ExitMessage
  620.  
  621.  Choice = '';
  622.  ChoiceOk = FALSE;
  623.  DO WHILE (\ChoiceOk)
  624.     rc = SysCls();
  625.     DO i = 1 TO Menu.Line.0
  626.        SAY Menu.Line.i
  627.     END;
  628.  
  629.     Choice   = TRANSLATE(PullVariable(LEFT(Menu.ValidMenuKeys, 1) , '   ?  '));
  630.     ChoiceOk = (POS(Choice, Menu.ValidMenuKeys) > 0);
  631.     IF (\ChoiceOk) THEN
  632.        CALL CHAROUT, '';
  633.  END;
  634.  SAY;
  635.  
  636.  RETURN(Choice);
  637.