home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software of the Month Club 1995 December
/
SOFM_Dec1995.bin
/
pc
/
os2
/
vpascal
/
examples
/
rexx
/
callrexx.pas
Wrap
Pascal/Delphi Source File
|
1995-10-31
|
4KB
|
122 lines
{█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
{█ █}
{█ Virtual Pascal Examples Version 1.0 █}
{█ OS/2 REXX example █}
{█ ─────────────────────────────────────────────────█}
{█ Copyright (C) 1995 B&M&T Corporation █}
{█ ─────────────────────────────────────────────────█}
{█ Written by Vitaly Miryanov █}
{█ █}
{▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
program CallRexx;
uses Os2Base, Os2Rexx, Use32;
{$IFDEF DYNAMIC_VERSION}
{$Dynamic System}
{$L VPRTL.LIB}
{$ENDIF}
const
MaxRexxSrcBuffer = 4096;
{ Executes a REXX procedure with one argument }
function DoCallRexx(const RexxSrc: array of PChar; const AArg: String): Longint;
var
P: PChar;
I,J: Integer;
Arg: RxString;
RexxRetVal: RxString;
RexxRC: SmallWord;
Instore: array [0..1] of RxString;
SrcBuf: array [0..MaxRexxSrcBuffer-1] of Char;
begin
{ By setting the strlength of the output RXSTRING to zero, we }
{ force the interpreter to allocate memory and return it to us. }
{ We could provide a buffer for the interpreter to use instead. }
RexxRetVal.strlength := 0;
{ Create input argument }
Arg.strlength := Length(AArg);
Arg.strptr := @AArg[1];
{ Create REXX procedure source code in memory }
J := 0;
for I := Low(RexxSrc) to High(RexxSrc) do
begin
P := RexxSrc[I];
while P^ <> #0 do
begin
SrcBuf[J] := P^;
Inc(P);
Inc(J);
end;
SrcBuf[J] := #13; { Carriage Return }
SrcBuf[J+1] := #10; { Line Feed }
Inc(J, 2);
end;
Instore[0].strlength := J;
Instore[0].strptr := @SrcBuf;
Instore[1].strlength := 0;
Instore[1].strptr := nil;
{ Here we call the interpreter }
DoCallRexx := RexxStart(1 , { Number of arguments }
@Arg , { Argument array }
'VpcCallRexx', { Name of the REXX procedure }
@InStore , { Location of the procedure }
'CMD' , { Initial environment name }
rxCommand , { Code for how invoked }
nil , { No EXITs on this call }
RexxRC , { Rexx program output }
RexxRetVal); { Rexx program output }
{ Release storage allocated by REXX }
if Assigned(RexxRetVal.strptr) then DosFreeMem(RexxRetVal.strptr);
DosFreeMem(Instore[1].strptr);
end;
{ REXX source to execute }
const
PlayMusic: array[0..20] of PChar =
( 'Parse Arg Data' , { Get argument string }
'Note.0 = 2000' , { Invalid note entered }
'Note.1 = 262' , { c }
'Note.2 = 294' , { d }
'Note.3 = 330' , { e }
'Note.4 = 349' , { f }
'Note.5 = 392' , { g }
'Note.6 = 440' , { a }
'Note.7 = 494' , { b }
'Note.8 = 524' , { C }
'Note.9 = 588' , { D }
'Note.10 = 660' , { E }
'Note.11 = 698' , { F }
'Note.12 = 784' , { G }
'Note.13 = 880' , { A }
'Note.14 = 988' , { B }
'NoteOrder = "cdefgabCDEFGAB"',
'do i=1 to Length(Data)' ,
'j = Pos(SubStr(Data,i,1), NoteOrder)',
'call Beep Note.j, 250' , { Hold each note for one-quarter second }
'end'
);
TypeFile: array [0..1] of PChar =
( 'Parse Arg Data',
'TYPE Data'
);
var
RC: Longint;
{ Main program body }
begin
{ Play music }
RC := DoCallRexx(PlayMusic, 'cdefgabCDEFGAB');
if RC <> 0 then WriteLn('Failed to play gamma. REXX Error Code = ', RC);
{ Type contents of the AUTOEXEC.BAT }
RC := DoCallRexx(TypeFile, 'C:\AUTOEXEC.BAT');
if RC <> 0 then WriteLn('Failed to type AUTOEXEC.BAT. REXX Error Code = ', RC);
end.