CTBCOMMAND

Description

Initiates a language request or remote procedure call (RPC).

Syntax

COPY CTPUBLIC.
01 COMMAND PIC S9(9) COMP SYNC.
01 RETCODE PIC S9(9) COMP SYNC.
01 REQTYPE PIC S9(9) COMP SYNC.
01 BUFFER type.
01 BUFFER-LEN PIC S9(9) COMP SYNC.
01 OPTION PIC S9(9) COMP SYNC.
CALL 'CTBCOMMA' USING COMMAND RETCODE REQTYPE BUFFER BUFFER-LEN OPTION.

Parameters

COMMAND

(I) Handle for this client/server operation. This handle is defined in the associated CTBCMDALLOC call. The command handle corresponds to the TDPROC handle in the Open ServerConnect Gateway-Library.

RETCODE

(O) Variable where the result from an executed function returns. Its value is one of the codes listed under “Return value,” in this section.

REQTYPE

(I) Type of request to initiate. The following symbolic values are legal for REQTYPE:

When REQTYPE is

CTBCOMMAND initiates

BUFFER contains

CS-LANG-CMD (148)

A language request.

The text of the language request.

CS-RPC-CMD (149)

A remote procedure call.

The name of the remote procedure.

BUFFER

(I) Variable (buffer) that contains the language request or RPC name.

This argument is typically one of the following datatypes:

	01 BUFFER   PIC S9(9) COMP SYNC. 
	01 BUFFER   PIC X(n).
BUFFER-LEN

(I) Length, in bytes, of the buffer.

If the value in the buffer is a fixed-length or symbolic value, assign BUFFER-LEN a value of CS-UNUSED.

OPTION

Option associated with this request, if any.

Currently, only RPCs take options. For language requests, assign OPTION a value of CS-UNUSED.

The following symbolic values are legal for OPTION when REQTYPE is CS-RPC-CMD:

Value

Meaning

CS-RECOMPILE (188)

Recompile the stored procedure before executing it.

CS-NORECOMPILE (189)

Do not recompile the stored procedure before executing it.

CS-UNUSED (-99999)

No options are assigned.

Returns

CTBCOMMAND returns one of the following values listed in Table 3-6.

Table 3-6: CTBCOMMAND return values

Value

Meaning

CS-SUCCEED (-1)

The routine completed successfully.

CS-FAIL (-2)

The routine failed.

TDS-CONNECTION-TERMINATED (-4997)

The connection is not active.

TDS-INVALID-PARAMETER (-4)

A parameter contains an illegal value.

TDS-WRONG-STATE (-6)

Program is in the wrong communication state to issue this call.

Examples

Example 1

The following code fragment demonstrates the use of CTBCOMMAND. It is taken from the sample program SYCTSAA5 in Appendix A, “Sample Language Requests.”

	 *--------------------------------------------------------------
	 *  allocate a command handle
	 *--------------------------------------------------------------
            CALL 'CTBCMDAL' USING CSL-CON-HANDLE,
                                  CSL-RC,
                                  CSL-CMD-HANDLE.
            IF CSL-RC NOT EQUAL CS-SUCCEED
              THEN
                MOVE SPACES TO MSGSTR
                STRING 'CTBCMDAL failed' DELIMITED BY SIZE
                                                       INTO MSGSTR
                PERFORM PRINT-MSG
                PERFORM ALL-DONE
            END-IF.
  
       *-------------------------------------------------------------
       *    prepare the language request
       *-------------------------------------------------------------
            MOVE CF-LANG2-SIZE TO PF-STRLEN.
            CALL 'CTBCOMMA' USING CSL-CMD-HANDLE,
                                  CSL-RC,
                                  CS-LANG-CMD,
                                  CF-LANG2,
                                  PF-STRLEN,
                                  CS-UNUSED.
            IF CSL-RC NOT EQUAL CS-SUCCEED
              THEN
                MOVE SPACES TO MSGSTR
                STRING 'CTBCOMMA CS-LANG-CMD failed' DELIMITED BY SIZE
                                                       INTO MSGSTR
                PERFORM PRINT-MSG
                PERFORM ALL-DONE
            END-IF.
       *-------------------------------------------------------------
       *    send the language request
       *-------------------------------------------------------------
            CALL 'CTBSEND' USING CSL-CMD-HANDLE,
                                 CSL-RC.
            IF CSL-RC NOT EQUAL CS-SUCCEED
              THEN
                MOVE SPACES TO MSGSTR
                STRING 'CTBSEND failed' DELIMITED BY SIZE
                                                       INTO MSGSTR
                PERFORM PRINT-MSG
                PERFORM ALL-DONE
            END-IF.
        SEND-COMMAND-EXIT.
            EXIT.

Usage


Language requests

Language requests contain character strings that represent requests in a server’s own language. For example, language requests to Adaptive Server can include any legal Transact-SQL command.


Remote Procedure Calls (RPCs)

RPCs instruct a server to execute a stored procedure or transaction on either itself or a remote server.

See also

Related functions

Related topics