{*********************************************************}
{*                                                       *}
{*       REXX language API to Virtual Pascal, v1.00      *}
{*                                                       *}
{*      Copyright (c) 1998 by Alexander S. Tokareff      *}
{*                                                       *}
{*       Made especially for Konstantin Klyagin :-)      *}
{*                                                       *}
{* Special thanx to John Gladkih for very useful samples *}
{*                                                       *}
{*********************************************************}
{$Cdecl+}
Unit RexxAPI;
Interface
Uses Use32, OS2DEF, OS2BASE, OS2REXX, Strings;
Type
 RexxFunction = function( FuncName : PChar; ArgC : ULong; ArgV : PRxString;
                          QueueName : PChar; var Ret : RxString ) : ULong;

 RexxSubcommand = function( Command : PRxString; var ErrFlag : smallword;
                            var Ret : RxString ) : ULong;

 function RegisterSubcommand( ExeName : string; Func : pointer ) : boolean;
 function DeRegisterSubcommand( ExeName : string ) : boolean;

 function RegisterFunction( FunctionName : string; Func : pointer ) : boolean;
 function DeRegisterFunction( FunctionName : string ) : boolean;

 function GetRexxVar( VarName : string; var VarValue : string ) : boolean;
 function SetRexxVar( VarName, VarValue : string ) : boolean;

 function ExecuteRexx( ExeName, ProcName : string; ArgC : integer;
                       ArgV : array of string; var Return : string ) : boolean;

Implementation

 function RegisterSubcommand;
 var
  pc : array[0..255] of char;
 begin
  StrPCopy( pc, ExeName );
  StrUpper( pc );
  RegisterSubcommand := ( RexxRegisterSubcomExe( pc, pointer( Func ), nil ) = 0 );
 end;

 function DeRegisterSubcommand;
 var
  pc : array[0..255] of char;
 begin
  StrPCopy( pc, ExeName );
  StrUpper( pc );
  DeRegisterSubcommand := ( RexxDeRegisterSubcom( pc, nil ) = 0 );
 end;

 function RegisterFunction;
 var
  pc : array[0..255] of char;
 begin
  StrPCopy( pc, FunctionName );
  StrUpper( pc );
  RegisterFunction := ( RexxRegisterFunctionExe( pc, Func ) = 0 );
 end;

 function DeRegisterFunction;
 var
  pc : array[0..255] of char;
 begin
  StrPCopy( pc, FunctionName );
  StrUpper( pc );
  DeRegisterFunction := ( RexxDeRegisterFunction( pc ) = 0 );
 end;

 function GetRexxVar;
 var
  shv : ShVBlock;
 begin
  GetRexxVar := false;
  VarValue := '';
  shv.shvnext := nil;
  shv.shvname.strlength := length( VarName );
  shv.shvnamelen := shv.shvname.strlength;
  GetMem( shv.shvname.strptr, shv.shvnamelen + 1 );
  StrPCopy( shv.shvname.strptr, VarName );
  shv.shvcode := rxshv_Fetch;
  if ( RexxVariablePool( shv ) <> 0 ) then
  begin
   if ( shv.shvname.strptr <> nil ) then StrDispose( shv.shvname.strptr );
   if ( shv.shvvalue.strptr <> nil ) then StrDispose( shv.shvvalue.strptr );
   Exit;
  end;
  if ( shv.shvret <> rxshv_Ok ) then
  begin
   if ( shv.shvname.strptr <> nil ) then StrDispose( shv.shvname.strptr );
   if ( shv.shvvalue.strptr <> nil ) then StrDispose( shv.shvvalue.strptr );
   Exit;
  end;
  VarValue := StrPas( shv.shvvalue.strptr );
  if ( shv.shvname.strptr <> nil ) then StrDispose( shv.shvname.strptr );
  if ( shv.shvvalue.strptr <> nil ) then StrDispose( shv.shvvalue.strptr );
  GetRexxVar := true;
 end;

 function SetRexxVar;
 var
  shv : ShVBlock;
  rc : longint;
 begin
  shv.shvnext := nil;
  shv.shvname.strlength := length( VarName );
  shv.shvnamelen := shv.shvname.strlength;
  GetMem( shv.shvname.strptr, shv.shvname.strlength + 1 );
  StrPCopy( shv.shvname.strptr, VarName );
  shv.shvvalue.strlength := length( VarValue );
  shv.shvvaluelen := shv.shvvalue.strlength;
  GetMem( shv.shvvalue.strptr, shv.shvvalue.strlength + 1 );
  StrPCopy( shv.shvvalue.strptr, VarValue );
  shv.shvcode := rxshv_SySet;
  shv.shvret := 0;
  rc := RexxVariablePool( shv );
  SetRexxVar := ( ( rc and $fffffffe ) = 0 );
 end;

Function ExecuteRexx;
Var
  Args           : Array [0..9] Of RxString; { Maximum 10 arguments }
  Arg            : RxString;
  FName, EnvName : Array [0..255] Of Char;
  i, Ret         : SmallWord;
  RetVal         : RxString;
  rc             : Integer;

begin
  ExecuteRexx := false;
  if ( ProcName = '' ) then Exit;

  If ArgC > 0 Then
  For i := 0 To ArgC-1 Do
  Begin
    Args [i]. StrLength := Length (ArgV [i]);
    GetMem (Args [i]. StrPtr, Args [i]. StrLength + 1);
    StrPCopy (Args [i]. StrPtr, ArgV [i]);
  End;

  StrPCopy (FName, ProcName);
  StrPCopy (EnvName, ExeName);
  RetVal. StrLength := 0;
  rc := RexxStart (ArgC, PRxString (@Args), FName, nil, EnvName, rxSubroutine, nil, Ret, RetVal);
  If ArgC > 0 Then For i := 0 To ArgC-1 Do StrDispose (Args [i]. StrPtr);

  If Ret <> 0 Then
  Begin
    StrDispose (RetVal. StrPtr);
    Exit;
  End;

  If RetVal. StrLength <> 0 Then Return := StrPas (RetVal. StrPtr);
  DosFreeMem (RetVal. StrPtr);
  ExecuteRexx := True;
End;

End.

