Problem:
Resolution:
Please see the attached example project that was written using Net Express 5.1. Here is the description of the project:
READARRAY
This example shows how a Java String array can be passed between a COBOL program and a java program and how each can manipulate its contents using native methods.
COBOL program ReadArray will instantiate Java class arraydemo.
It will then call method getStringArray which will create a new java string array and return it back to COBOL as an instance of the jarray class.
COBOL will extract the strings and display them using methods of jarray.
COBOL will then create new java string objects from PIC X fields and store them in the same array.
COBOL will then call the java method showStringArray passing the array in as a parameter. Java will then display the new contents of the array and return to COBOL.
In order to compile the .java program in this project you will need to ensure that the COBOL/Java environment is setup as documented in the Net Express documentation under Programming--> Java-->Java and COBOL-->Using Java and COBOL.
$set ooctrl( p-f)
Program-id. ReadArray.
class-control.
arraydemo is class "$Java$arraydemo"
javasup is class "javasup"
JavaString is class "$Java$java.lang.String"
.
thread-local-storage section.
copy javatypes.
01 aJavaObj object reference.
01 StringElement object reference.
01 wsTable object reference.
01 CDims pic x(4) comp-5.
01 Dims.
05 Dims-entry pic x(4) comp-5 occurs 256.
01 Bounds.
05 Bounds-entry pic x(4) comp-5 occurs 256.
01 ind0 pic x(4) comp-5.
01 ws-type pic x(4) comp-5.
01 ws-len pic x(4) comp-5.
01 ws-string pic x(100).
01 ws-success pic 9(9) comp-5.
88 instance-of value 1.
01 any-key pic x.
01 ws-count pic 9 value 0.
procedure division.
*> Create a new instance of the java class
invoke arraydemo "new" returning aJavaObj
*> Call Java method that creates a new string array and returns
*> it to COBOL.
invoke aJavaObj "getStringArray" returning wsTable
invoke wsTable "getType" returning ws-type
*> find out the number of elements in the array
invoke wsTable "getDimensions" returning CDims
display "The array has " CDims " dimension(s)"
*> get the number of elements in each dimension
display "dimensions are " with no advancing
invoke wsTable "getBounds" using Bounds
perform varying ind0 from 1 by 1 until ind0 > CDims
display Bounds-entry(ind0) with no advancing
if ind0 < CDims
display " by " with no advancing
end-if
end-perform
display " "
*> display each element in the array
perform varying ind0 from 0 by 1
until ind0 = Bounds-entry(1)
move ind0 to Dims-entry(1)
move 0 to Dims-entry(2)
invoke wsTable "getElement"
using by value CDims
by reference Dims
by reference stringElement
end-invoke
*> We have an Object. We can check if it is a String.
invoke javasup "isinstanceof"
using stringElement
JavaString *> this refers to java string class
returning ws-success
end-invoke
if not instance-of
display "ERROR NOT A STRING"
display "Need to Die Gracefully"
stop run
end-if
*> stringElement is a java string object so we can get its prop-
*> erties and call its methods.
invoke stringElement "length" returning ws-len
*> convert from string object to COBOL pic x.
invoke stringElement "toString" returning ws-string
display "Length of String = " ws-len
display " String = " ws-string(1:ws-len)
end-perform
*> Modify contents of array with new strings
perform varying ind0 from 0 by 1
until ind0 = Bounds-entry(1)
move ind0 to Dims-entry(1)
move 0 to Dims-entry(2)
add 1 to ws-count
move spaces to ws-string
string "My new string "
ws-count
x"00" delimited by size into ws-string
end-string
*> Create a new java string object using COBOL pic x field
invoke javaString "new"
using ws-string
returning stringElement
end-invoke
invoke wsTable "putElement"
using by value CDims
by reference Dims
by reference stringElement
end-invoke
end-perform
*> Call java method to display the new strings inm passed array
invoke aJavaObj "showStringArray" using wsTable
invoke wsTable "finalize" returning wsTable
display "End of test"
accept any-key
stop run.
And the Java class:
import com.microfocus.cobol.*;
import java.util.*;
public class arraydemo extends RuntimeSystem
{
String myStringArray[];
public arraydemo()
{
myStringArray = new String[5];
int i;
for (i = 0; i < 5; i )
{
myStringArray = "This is string " i;
}
}
public String[] getStringArray()
{
return myStringArray;
}
public void showStringArray(String[] newArray)
{
int i;
for (i = 0; i < 5; i )
{
System.out.println("String =: " newArray);
}
}
}