tldm-universe/Ardent/UV/APP.PROGS/REMOTE.B

93 lines
2.7 KiB
Plaintext
Raw Permalink Normal View History

2024-09-09 21:51:08 +00:00
******************************************************************************
*
* Remotely execute a command using the uVnet engine
*
* Module %M% Version %I% Date %H%
*
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
* This is unpublished proprietary source code of Ardent Software Inc.
* The copyright notice above does not evidence any actual or intended
* publication of such source code.
*
*******************************************************************************
*
* Maintenence log - insert most recent change descriptions at top
*
* Date.... GTAR# WHO Description.........................................
* 10/14/98 23801 SAP Change copyrights.
* 06/09/95 16668 TMC if there is not any connection, try to make one
* 05/15/95 15974 TMC fix error message when no connection
* 05/15/95 15974 TMC change REMOTE.B to use same Uv/Net connection
* 09/01/93 11392 TMC add user name to remote executes
* 08/23/93 11392 TMC New file
*******************************************************************************
SUBROUTINE REMOTE.B(HNAME, COMMAND, DIRECTORY, RESULT)
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
EQU UVRPC.INT TO 0
EQU UVRPC.DOUBLE TO 1
EQU UVRPC.CHAR TO 2
EQU UVRPC.STRING TO 3
EQU UVRPC.INT.PTR TO 4
EQU UVRPC.DOUBLE.PTR TO 5
EQU UVRPC.FUNCNAME TO 6
DIM CALL.ARGS(20, 2), RES.ARGS(20,2)
* get old connection number
CONNUM = SYSTEM(1201, HNAME)
IF CONNUM <= 0 THEN
* try to connect
PATHNAME = HNAME:"!":DIRECTORY:"/VOC"
OPENPATH PATHNAME TO FV.VOC ELSE
PRINT "The RPC is not connected"
PRINT "RPCERROR=":SYSTEM(1203):" CONNUM=":CONNUM
PRINT UVREADMSG(SYSTEM(1203), "The RPC is not connected")
RETURN
END
CLOSE FV.VOC
CONNUM = SYSTEM(1201, HNAME)
IF CONNUM <= 0 THEN
* if the connection is STILL not open return
PRINT "The RPC is not connected"
PRINT "RPCERROR=":SYSTEM(1203):" CONNUM=":CONNUM
PRINT UVREADMSG(SYSTEM(1203), "The RPC is not connected")
RETURN
END
END
CALL.ARGS(1,1) = COMMAND
CALL.ARGS(1,2) = UVRPC.STRING
CALL.ARGS(2,1) = ""
CALL.ARGS(2,2) = UVRPC.STRING
CALL.ARGS(3,1) = DIRECTORY
CALL.ARGS(3,2) = UVRPC.STRING
CALL.ARGS(4,1) = 51 ;* NETexecute
CALL.ARGS(4,2) = UVRPC.INT
* make execute call
IF RPC.CALL(CONNUM, " ", 4, MAT CALL.ARGS, RES.COUNT, MAT RES.ARGS)
ELSE
PRINT STATUS()
PRINT UVREADMSG(STATUS(), "RPC.CALL PROBLEM")
END
IF RES.COUNT > 4 AND RES.ARGS(4,2) = UVRPC.STRING
THEN
IF RES.ARGS(1,2) = UVRPC.INT AND RES.ARGS(1,1) <> 0
THEN
PRINT UVREADMSG(RES.ARGS(1,1), "Remote EXECUTE Problem")
END
ELSE
RESULT = RES.ARGS(4,1)
END
END
ELSE
PRINT UVREADMSG(80001, "RPC.CALL ARGUMENT PROBLEM")
END
RETURN