home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 1995 December / SOFM_Dec1995.bin / pc / os2 / vpascal / examples / rexx / callrexx.pas
Encoding:
Pascal/Delphi Source File  |  1995-10-31  |  4.3 KB  |  122 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples  Version 1.0             █}
  4. {█      OS/2 REXX example                                █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1995 B&M&T Corporation             █}
  7. {█      ─────────────────────────────────────────────────█}
  8. {█      Written by Vitaly Miryanov                       █}
  9. {█                                                       █}
  10. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  11.  
  12. program CallRexx;
  13.  
  14. uses Os2Base, Os2Rexx, Use32;
  15.  
  16. {$IFDEF DYNAMIC_VERSION}
  17.   {$Dynamic System}
  18.   {$L VPRTL.LIB}
  19. {$ENDIF}
  20.  
  21. const
  22.   MaxRexxSrcBuffer      = 4096;
  23.  
  24. { Executes a REXX procedure with one argument }
  25.  
  26. function DoCallRexx(const RexxSrc: array of PChar; const AArg: String): Longint;
  27. var
  28.   P:          PChar;
  29.   I,J:        Integer;
  30.   Arg:        RxString;
  31.   RexxRetVal: RxString;
  32.   RexxRC:     SmallWord;
  33.   Instore:    array [0..1] of RxString;
  34.   SrcBuf:     array [0..MaxRexxSrcBuffer-1] of Char;
  35. begin
  36.   { By setting the strlength of the output RXSTRING to zero, we   }
  37.   { force the interpreter to allocate memory and return it to us. }
  38.   { We could provide a buffer for the interpreter to use instead. }
  39.   RexxRetVal.strlength := 0;
  40.   { Create input argument }
  41.   Arg.strlength := Length(AArg);
  42.   Arg.strptr := @AArg[1];
  43.   { Create REXX procedure source code in memory }
  44.   J := 0;
  45.   for I := Low(RexxSrc) to High(RexxSrc) do
  46.   begin
  47.     P := RexxSrc[I];
  48.     while P^ <> #0 do
  49.     begin
  50.       SrcBuf[J] := P^;
  51.       Inc(P);
  52.       Inc(J);
  53.     end;
  54.     SrcBuf[J]   := #13;         { Carriage Return }
  55.     SrcBuf[J+1] := #10;         { Line Feed       }
  56.     Inc(J, 2);
  57.   end;
  58.   Instore[0].strlength := J;
  59.   Instore[0].strptr := @SrcBuf;
  60.   Instore[1].strlength := 0;
  61.   Instore[1].strptr := nil;
  62.   { Here we call the interpreter }
  63.   DoCallRexx := RexxStart(1    ,        { Number of arguments        }
  64.                   @Arg         ,        { Argument array             }
  65.                   'VpcCallRexx',        { Name of the REXX procedure }
  66.                   @InStore     ,        { Location of the procedure  }
  67.                   'CMD'        ,        { Initial environment name   }
  68.                   rxCommand    ,        { Code for how invoked       }
  69.                   nil          ,        { No EXITs on this call      }
  70.                   RexxRC       ,        { Rexx program output        }
  71.                   RexxRetVal);          { Rexx program output        }
  72.   { Release storage allocated by REXX }
  73.   if Assigned(RexxRetVal.strptr) then DosFreeMem(RexxRetVal.strptr);
  74.   DosFreeMem(Instore[1].strptr);
  75. end;
  76.  
  77. { REXX source to execute }
  78.  
  79. const
  80.   PlayMusic: array[0..20] of PChar =
  81.     ( 'Parse Arg Data'  ,               { Get argument string  }
  82.       'Note.0  = 2000'  ,               { Invalid note entered }
  83.       'Note.1  = 262'   ,               { c }
  84.       'Note.2  = 294'   ,               { d }
  85.       'Note.3  = 330'   ,               { e }
  86.       'Note.4  = 349'   ,               { f }
  87.       'Note.5  = 392'   ,               { g }
  88.       'Note.6  = 440'   ,               { a }
  89.       'Note.7  = 494'   ,               { b }
  90.       'Note.8  = 524'   ,               { C }
  91.       'Note.9  = 588'   ,               { D }
  92.       'Note.10 = 660'   ,               { E }
  93.       'Note.11 = 698'   ,               { F }
  94.       'Note.12 = 784'   ,               { G }
  95.       'Note.13 = 880'   ,               { A }
  96.       'Note.14 = 988'   ,               { B }
  97.       'NoteOrder = "cdefgabCDEFGAB"',
  98.       'do i=1 to Length(Data)'      ,
  99.       'j = Pos(SubStr(Data,i,1), NoteOrder)',
  100.       'call Beep Note.j, 250'       ,   { Hold each note for one-quarter second }
  101.       'end'
  102.     );
  103.  
  104.   TypeFile: array [0..1] of PChar =
  105.     ( 'Parse Arg Data',
  106.       'TYPE Data'
  107.     );
  108.  
  109. var
  110.   RC: Longint;
  111.  
  112. { Main program body }
  113.  
  114. begin
  115.   { Play music }
  116.   RC := DoCallRexx(PlayMusic, 'cdefgabCDEFGAB');
  117.   if RC <> 0 then WriteLn('Failed to play gamma. REXX Error Code = ', RC);
  118.   { Type contents of the AUTOEXEC.BAT }
  119.   RC := DoCallRexx(TypeFile, 'C:\AUTOEXEC.BAT');
  120.   if RC <> 0 then WriteLn('Failed to type AUTOEXEC.BAT. REXX Error Code = ', RC);
  121. end.
  122.