inspect reverse (was Re: XML and Legacy)

[Chuck Stevens]

inspect value-work tallying LEN for trailing spaces

^^^^^^^^
This was removed in the COBOL 85 standard. I'm not sure why - though
"function reverse" works well too.

I agree with Bill that this wasn't in the '85 standard, or the '02
standard. In general, the COBOL standards folks don't treat adding
yet another way of accomplishing something that COBOL already does as
being of critical priority.

In the specific case of INSPECT, I don't see any functional
differences between the hypothetical
INSPECT value-work
TALLYING trailing-spaces FOR TRAILING SPACES
and the actual
INSPECT FUNCTION REVERSE (value-work)
TALLYING trailing-spaces FOR LEADING SPACES
and, unless the implementor provides some sort of "backwards compare"
in the hardware, I don't see the potential for much of a performance
difference either.

To stretch a metaphor, having power driver's seat controls on the
driver's door, the steering wheel, the console and the remote alarm
pendant might be a really neat ergonomic idea, but it's not likely to
be given the attention that, say, a more efficient engine or a
side-curtain airbag would in terms of priority.

I know a number of people have proposed INSPECT <x> ... TRAILING ...,
and it remains on the candidates list for consideration for inclusion
in future revisions to the standard, but so far as I know nobody has
been able to come up with a case in which INSPECT FUNCTION REVERSE
(<x>) ... LEADING ..., or some simple sequence involving it, fails to
provide equivalent functionality. And without such a case, what's the
point? If anybody's confused about the FUNCTION REVERSE method,
comments have been around for a very long time in COBOL, and even
"inline" comments are now available.



the dCOBOL's basic power increased rather than NEW FEATURES being
added rather than alternative ways of doing the same thing.
, and only microscopically-different resource consumption,

inspect value-work tallying LEN for all characters before trailing spaces
compute LEN = length of value-work - LEN

One COBOL supports Function Stored-Char-Length (seems like I've seen
that from PECD, so I'd bet it's Fujitsu that supports that). That keeps
you from doing the extra math too...
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~ / \ / ~ Live from Montgomery, AL! ~
~ / \/ o ~ ~
~ / /\ - | ~ AIM: LXi0007 ~
~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
~ I do not read e-mail at the above address ~
~ Please post if you wish to be contacted privately ~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[William M. Klein]

<snip>

Post by Chuck Stevens
I know a number of people have proposed INSPECT <x> ... TRAILING ...,
and it remains on the candidates list for consideration for inclusion
in future revisions to the standard, but so far as I know nobody has
been able to come up with a case in which INSPECT FUNCTION REVERSE
(<x>) ... LEADING ..., or some simple sequence involving it, fails to
provide equivalent functionality. And without such a case, what's the
point? If anybody's confused about the FUNCTION REVERSE method,
comments have been around for a very long time in COBOL, and even
"inline" comments are now available.

Chuck,
Although I agree with you for INSPECT ... TALLYING, I am *not* certain
that in a "strictly conforming" '85 or '02 compiler that INSPECT ...
REPLACING will work (in a defined way) with FUNCTION REVERSE

I believe (but am not positive of this) that the REPLACING action would
impact the "temporary data item" created by the function and NOT the
original item itself - if it were allowed at all. I think (but am still
uncertain about this) that SR(1) on page 90 of the 2002 Standard makes this
non-conforming when it says,

"1) A function-identifier shall not be specified as a receiving operand."

Notice that SR(8) on page 464 ONLY applies to Format 1 (no REPLACING phrase)
and that GR(1) does NOT say that identifier-1 *is* a sending operand, only
that it is treated as one FOR PURPOSES of determining the length.

It seems to me that the MOST common request is for "tallying" trailing
"spaces" (or whatever) but the ability to also REPLACE such characters is -
at least - questionable with the current FUNCTION REVERSE technique.

[Howard Brazee]

Post by William M. Klein
Although I agree with you for INSPECT ... TALLYING, I am *not* certain
that in a "strictly conforming" '85 or '02 compiler that INSPECT ...
REPLACING will work (in a defined way) with FUNCTION REVERSE

However, once you know the tally, you can use reference modification to do a
move.

[Tom Morrison]

Post by Chuck Stevens

inspect value-work tallying LEN for trailing spaces

^^^^^^^^
This was removed in the COBOL 85 standard. I'm not sure why - though
"function reverse" works well too.

[snip]

Post by Chuck Stevens
and, unless the implementor provides some sort of "backwards compare"
in the hardware, I don't see the potential for much of a performance
difference either.

Chuck, when you consider Bill's response to this post, you can see one
difference.

Quite obviously, one can generate reasonably good code for doing a "backward
compare" if the source language conveys the intent of the programmer;
hardware is not the problem. Now one could optimize INSPECT FUNCTION
REVERSE as if it implied a mere reversal of the comparison/replacement
operations, but as Bill has pointed out, this has some danger. I think that
a straightforward TRAILING makes a lot of sense, is sought by a lot of
programmers, is readable, and is not in the language because....well, I dare
not speculate. ;-)

Consider the similarity of a MOVE with overlapping source and destination.
Now, if we assume that a programmer really wants to have a MOVE with
overlapping operands, then it should behave 'correctly' rather than
arbitrarily. While not within the standard, a reasonable implementor will
determine in which 'direction' the operand has to be moved and adjust the
code generation accordingly.

--
Best regards,
Tom Morrison
Liant Software Corporation

[LX-i]

What do you think was removed in the '85 Standard?
Inspect ... TALLYING is definitely part of the '85 Standard. INSPECT ...
"for trailing" has never been a part of any ANSI/ISO COBOL Standard. See my
separate note on what has and has not been "selected" for the next Standard
(trailing was CONSIDERED but not selected)

I guess I mis-assumed. I could have sworn I saw it in our COBOL 74
compiler, but didn't in COBOL 85. However, I just looked it up in the
COBOL 74 compiler, and it's not in there either. My apologies to all...

(and why was trailing rejected? It would be very handy, especially if
you could say something like "Inspect data-name tallying count-var for
characters before trailing space" :> )
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~ / \ / ~ Live from Montgomery, AL! ~
~ / \/ o ~ ~
~ / /\ - | ~ AIM: LXi0007 ~
~ _____ / \ | ~ E-mail: ***@Netscape.net ~
~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
~ I do not read e-mail at the above address ~
~ Please post if you wish to be contacted privately ~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[Frank Swarbrick]

Post by LX-i

What do you think was removed in the '85 Standard?
Inspect ... TALLYING is definitely part of the '85 Standard. INSPECT ...
"for trailing" has never been a part of any ANSI/ISO COBOL Standard. See my
separate note on what has and has not been "selected" for the next Standard
(trailing was CONSIDERED but not selected)

I guess I mis-assumed. I could have sworn I saw it in our COBOL 74
compiler, but didn't in COBOL 85. However, I just looked it up in the
COBOL 74 compiler, and it's not in there either. My apologies to all...
(and why was trailing rejected? It would be very handy, especially if
you could say something like "Inspect data-name tallying count-var for
characters before trailing space" :> )

Hey, I already mentioned that one! :-)

I guess the solution, sans the 'trailing' modifier, is to use something like
this:
INSPECT FUNCTION REVERSE(MY-STRING) FOR CHARACTERS AFTER LEADING SPACES

So given a MY-STRING PIC X(20) VALUE 'FRANK SWARBRICK ' it would
interrogate ' KCIRBRAWS KNARF' and return a value of 15. Wouldn't it?
I didn't try it. We only recently started using COBOL for VSE/ESA, which is
the VSE compiler than implements intrinsic functions, so I have not had
occasion to try this out yet. Seems like it should work, though. I think
it will be useful for my current project, in any case (which is why I had
mentioned the desire for 'before trailing spaces').

TTYL,



---
Frank Swarbrick
Senior Developer/Analyst - Mainframe Applications Development
FirstBank Data Corporation

[LX-i]

Post by Frank Swarbrick
I guess the solution, sans the 'trailing' modifier, is to use something like
INSPECT FUNCTION REVERSE(MY-STRING) FOR CHARACTERS AFTER LEADING SPACES

That's a darn good idea - I'm going to try it. I'll let you know what I
find... :)
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~ / \ / ~ Live from Montgomery, AL! ~
~ / \/ o ~ ~
~ / /\ - | ~ AIM: LXi0007 ~
~ _____ / \ | ~ E-mail: ***@Netscape.net ~
~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
~ I do not read e-mail at the above address ~
~ Please post if you wish to be contacted privately ~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

[Chuck Stevens]

Perahps what you'd really want is..........
01 FILLER
05 in-work USAGE STRING.
.....

I believe at least part of this functionality is planned for the next
revision to the COBOL standard, though the current proposals do not
reflect the syntax suggested above. Related, and also planned for the
next revision, is the ability to declare a true variable-size table
embedded in a record.

.. for variable-length data. Implementors could use any mechanism they
desire to, well, "implement" this.
MOVE FUNCTION STRING-LENGTH (usage-string-data-item) TO foo....

If USAGE STRING were added to the standard (and/or WHEN similar or
equivalent functionality, regardless of what the syntax is, is added
to the standard), I'd expect FUNCTION LENGTH to reflect the current
length of such an item. I'm not sure what having a *separate*
function for this would accomplish, given that FUNCTION LENGTH already
reflects the number of character positions the item named as argument
occupies. Am I missing something?

-Chuck Stevens

[hhinman]

Here is an example of using .NET XML and streaming Classes in a Fujitsu
NetCOBOL for .NET that creates xml into a text file and then reads it
back in and formats it to display to the console:
-Howard

IDENTIFICATION DIVISION.
CLASS-ID. COBOLXML AS "COBOLXML.COBOLXML".
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
REPOSITORY.
CLASS XmlTextReader AS "System.Xml.XmlTextReader"
CLASS XmlTextWriter AS "System.Xml.XmlTextWriter"
ENUM FORMATTING AS "System.Xml.Formatting"
PROPERTY PROP-FORMATTING AS "Formatting"
PROPERTY PROP-INDENTED AS "Indented"
PROPERTY PROP-NAME AS "Name"
PROPERTY PROP-VALUE AS "Value"
ENUM XmlNodeType AS "System.Xml.XmlNodeType"
PROPERTY PROP-READ AS "Read"
PROPERTY PROP-DEPTH AS "Depth"
PROPERTY PROP-PREFIX AS "Prefix"
PROPERTY PROP-ATTRIBUTECOUNT AS "AttributeCount"
PROPERTY Attribute AS "Attribute"
PROPERTY ProcessingInstruction AS "ProcessingInstruction"
PROPERTY MoveToNextAttribute AS "MoveToNextAttribute"
PROPERTY PROP-HASATTRIBUTES AS "HasAttributes"
PROPERTY Element AS "Element"
PROPERTY Whitespace AS "Whitespace"
PROPERTY PROP-TEXT AS "Text".


STATIC.
DATA DIVISION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.
METHOD-ID. MAIN.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 COBOLXMLOBJ OBJECT REFERENCE COBOLXML.
01 DOCUMENT PIC X(15) VALUE "newbooks.xml".
01 JUNK PIC X VALUE SPACE.
PROCEDURE DIVISION.
INVOKE COBOLXML "NEW" RETURNING COBOLXMLOBJ.
INVOKE COBOLXMLOBJ "Run" USING DOCUMENT.
DISPLAY "Hit Enter To Quit".
ACCEPT JUNK FROM CONSOLE.
END METHOD MAIN.
END STATIC.
OBJECT.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
PROCEDURE DIVISION.

METHOD-ID. Run.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 MyXmlTextWriter OBJECT REFERENCE XmlTextWriter.
01 MyXmlTextReader OBJECT REFERENCE XmlTextReader.
01 BOOLEAN-TRUE PIC 1 USAGE BIT VALUE B"1".
01 BOOLEAN-FALSE PIC 1 USAGE BIT VALUE B"0".
LINKAGE SECTION.
01 args PIC X(15).
PROCEDURE DIVISION USING args.
INVOKE XmlTextWriter "NEW" USING args NULL RETURNING
MyXmlTextWriter.

SET PROP-FORMATTING OF MyXmlTextWriter TO PROP-INDENTED OF
FORMATTING.
INVOKE MyXmlTextWriter "WriteStartDocument" USING
BOOLEAN-FALSE.
INVOKE MyXmlTextWriter "WriteDocType" USING "bookstore",
NULL, "books.dtd", NULL.
INVOKE MyXmlTextWriter "WriteComment" USING "This file
represents another fragment of a book store inventory
database".
INVOKE MyXmlTextWriter "WriteStartElement" USING "bookstore".
INVOKE MyXmlTextWriter "WriteStartElement" USING
"book", NULL.
INVOKE MyXmlTextWriter "WriteAttributeString" USING "genre",
"autobiography".
INVOKE MyXmlTextWriter "WriteAttributeString" USING
"publicationdate", "1979".
INVOKE MyXmlTextWriter "WriteAttributeString" USING "ISBN",
"0-7356-0562-9".
INVOKE MyXmlTextWriter "WriteElementString" USING "title",
NULL, "The Autobiography of Mark Twain".
INVOKE MyXmlTextWriter "WriteStartElement" USING
"Author", NULL.
INVOKE MyXmlTextWriter "WriteElementString" USING
"first-name", "Mark".
INVOKE MyXmlTextWriter "WriteElementString" USING
"last-name", "Twain".
INVOKE MyXmlTextWriter "WriteEndElement".
INVOKE MyXmlTextWriter "WriteElementString" USING
"price", "7.99".
INVOKE MyXmlTextWriter "WriteEndElement".
INVOKE MyXmlTextWriter "WriteEndElement".

INVOKE MyXmlTextWriter "Flush".
INVOKE MyXmlTextWriter "Close".

INVOKE XmlTextReader "NEW" USING args RETURNING
MyXmlTextReader.
INVOKE SELF "FormatXml" USING MyXmlTextReader args.
DISPLAY SPACES.
DISPLAY "Processing of the file ", args, " complete.".
INVOKE MyXmlTextReader "Close".


END METHOD Run.

METHOD-ID. FormatXml.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 piCount PIC 99 VALUE ZERO.
01 docCount PIC 99 VALUE ZERO.
01 commentCount PIC 99 VALUE ZERO.
01 elementCount PIC 99 VALUE ZERO.
01 attributeCount PIC 99 VALUE ZERO.
01 textCount PIC 99 VALUE ZERO.
01 whitespaceCount PIC 99 VALUE ZERO.
01 BOOLEAN-TRUE PIC 1 USAGE BIT VALUE B"1".
01 BOOLEAN-FALSE PIC 1 USAGE BIT VALUE B"0".
01 BOOLEAN-RESULT PIC 1 USAGE BIT VALUE B"0".
01 BOOLEAN-RESULT2 PIC 1 USAGE BIT VALUE B"0".
LINKAGE SECTION.
01 reader OBJECT REFERENCE XmlTextReader.
01 filename PIC X(15).
PROCEDURE DIVISION USING reader filename.
INVOKE reader "Read" RETURNING BOOLEAN-RESULT2

PERFORM WITH TEST BEFORE UNTIL BOOLEAN-RESULT2 =
BOOLEAN-FALSE
EVALUATE NodeType OF reader
WHEN ProcessingInstruction OF XmlNodeType
INVOKE SELF "CobFormat" USING reader
"ProcessingInstruction"
ADD 1 TO piCount

WHEN DocumentType OF XmlNodeType
INVOKE SELF "CobFormat" USING reader
"DocumentType"
ADD 1 TO docCount

WHEN Comment OF XmlNodeType
INVOKE SELF "CobFormat" USING reader "Comment"
ADD 1 TO commentCount

WHEN Element OF XmlNodeType
INVOKE SELF "CobFormat" USING reader "Element"
ADD 1 TO elementCount
MOVE BOOLEAN-TRUE TO BOOLEAN-RESULT
INVOKE reader "MoveToNextAttribute" RETURNING
BOOLEAN-RESULT
PERFORM UNTIL BOOLEAN-RESULT = BOOLEAN-FALSE
INVOKE SELF "CobFormat" USING reader
"Attribute"
INVOKE reader "MoveToNextAttribute" RETURNING
BOOLEAN-RESULT
END-PERFORM

SET BOOLEAN-RESULT TO PROP-HASATTRIBUTES OF
reader
IF BOOLEAN-RESULT = BOOLEAN-TRUE
ADD PROP-ATTRIBUTECOUNT OF reader TO
attributeCount
END-IF

WHEN PROP-TEXT OF XmlNodeType
INVOKE SELF "CobFormat" USING reader "Text"
ADD 1 TO textCount

WHEN Whitespace OF XmlNodeType
ADD 1 TO whitespaceCount

END-EVALUATE
INVOKE reader "Read" RETURNING BOOLEAN-RESULT2
END-PERFORM.

DISPLAY SPACES.
DISPLAY "Statistics for {0} file", filename.
DISPLAY SPACES.
DISPLAY "ProcessingInstruction: ", piCount.
DISPLAY "DocumentType: ", docCount.
DISPLAY "Comment: ", commentCount.
DISPLAY "Element: ", elementCount.
DISPLAY "Attribute: ", attributeCount.
DISPLAY "Text: ", textCount.
DISPLAY "Whitespace: ", whitespaceCount.
EXIT METHOD.
END METHOD FormatXml.

METHOD-ID. CobFormat.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 MY-COUNT PIC S9(9) COMP-5 VALUE 0.
01 NUM1 PIC 9 VALUE ZERO.
01 NUM2 PIC 9 VALUE ZERO.
01 pPREFIX PIC X(255) VALUE SPACES.
01 pNAME PIC X(255) VALUE SPACES.
01 pVALUE PIC X(255) VALUE SPACES.
01 DISPLAY-STRING PIC X(81) VALUE SPACES.
LINKAGE SECTION.
01 reader OBJECT REFERENCE XmlTextReader.
01 NodeType PIC X(65).
PROCEDURE DIVISION USING reader NodeType.
MOVE PROP-DEPTH OF reader TO NUM1.
MOVE PROP-ATTRIBUTECOUNT OF reader TO NUM2.
DISPLAY NUM1, " ", NUM2, " " WITH NO ADVANCING.
MOVE PROP-DEPTH OF reader TO MY-COUNT.
PERFORM MY-COUNT TIMES
DISPLAY X"09" WITH NO ADVANCING
END-PERFORM.
SET pPREFIX TO PROP-PREFIX OF reader.
SET pNAME TO PROP-NAME OF reader.
SET pVALUE TO PROP-VALUE OF reader.
MOVE ALL SPACES TO DISPLAY-STRING.
STRING pPREFIX DELIMITED BY " ",
NodeType DELIMITED BY SPACE,
"<",
pNAME DELIMITED BY " ",
">",
pVALUE DELIMITED BY " "
INTO DISPLAY-STRING.
DISPLAY DISPLAY-STRING.
EXIT METHOD.
END METHOD CobFormat.
END OBJECT.
END CLASS COBOLXML.

Here is the text file it creates:

<?xml version="1.0" standalone="no" ?>
<!DOCTYPE bookstore (View Source for full doctype...)>
- <!-- This file represents another fragment of a book store
inventory database
-->
- <bookstore>
- <book genre="autobiography" publicationdate="1979"
ISBN="0-7356-0562-9">
<title>The Autobiography of Mark Twain</title>
- <Author>
<first-name>Mark</first-name>
<last-name>Twain</last-name>
</Author>
<price>7.99</price>
</book>
</bookstore>

--
Posted via http://dbforums.com

[Chris Richardson]

Hi,
How can i generate Xml strings in Cobol in an adequate
format for load in Recordsets (ADO 2.6) ? Do i have to do
that manually or there is some easier way to create the
Xml ?
We are using CICS (Cobol) and Db2 database. We intend to
consume the Xml in ASP 3.0 with ADO recordsets.
[]'s
Felipe Cembranelli

Felipe, Since you are using ADO (2.6), I thought it to be appropriate
to also show you an ADO.NET approach to working with XML.

This ADO.NET approach to working with XML is not in contradiction to
the System.XML classes approach shown in Howards great post (found in
this same thread). It is simply another choice. There are some
situations where one or the other is a better fit. It's good to know
that .NET exposes many choices. I must mention that you can go "much
further" with XML using the System.XML classes (demonstrated in
Howard's post). Yet, at the same time, it does depend on how "far" you
need to go. There are times when the ADO.NET Dataset XML features will
take you "far enough" <grin>

Notice in the code sample below that the data is first loaded into a
ADO.NET Dataset. Then, the XML friendly functions exposed by the
ADO.NET Dataset are used. For those new to .NET, a Dataset is
basically a collection of Data Tables. A Data Table is much like the
ADO Recordset that you are using. An ADO.NET Dataset is both a
relational and a Hierarchical view of data - both at the same time.

000010* Sample Code demonstrating ADO.NET's support for XML Technology
000020 IDENTIFICATION DIVISION.
000030 PROGRAM-ID. MAIN.
000040 ENVIRONMENT DIVISION.
000050 CONFIGURATION SECTION.
000060 REPOSITORY.
000070* .NET Framework Classes
000080 CLASS SqlConnection AS
"System.Data.SqlClient.SqlConnection"
000090 CLASS SqlDataAdapter As
"System.Data.SqlClient.SqlDataAdapter"
000100 CLASS SqlCommand As "System.Data.SqlClient.SqlCommand"
000110 CLASS DataSet As "System.Data.DataSet"
000120 CLASS DataTable AS "System.Data.DataTable"
000130 CLASS DataRow As "System.Data.DataRow"
000140 CLASS DataColumn AS "System.Data.DataColumn"
000150 CLASS SystemType AS "System.Type"
000160 CLASS DataColumnArray AS "System.Data.DataColumn[]"
000170
000180 CLASS Sys-Integer AS "System.Int32"
000190 CLASS Sys-String AS "System.String"
000200 CLASS Sys-Object AS "System.Object"
000210
000220* .NET Framework Properties
000230 PROPERTY PROP-ConnectionString AS "ConnectionString"
000240 PROPERTY PROP-Connection AS "Connection"
000250 PROPERTY PROP-CommandText AS "CommandText"
000260 PROPERTY PROP-SelectCommand AS "SelectCommand"
000270 PROPERTY PROP-Columns AS "Columns"
000280 PROPERTY PROP-Tables AS "Tables"
000290 PROPERTY PROP-DataType AS "DataType"
000300 PROPERTY PROP-ColumnName AS "ColumnName"
000310 PROPERTY PROP-Item AS "Item"
000320 PROPERTY PROP-PrimaryKey AS "PrimaryKey"
000330 PROPERTY PROP-Unique AS "Unique"
000340 PROPERTY PROP-IgnoreSchema AS "IgnoreSchema"
000350
000360* .NET Framework Enumerations
000370 ENUM ENUM-XmlWriteMode AS
"System.Data.XmlWriteMode".
000380
000390 DATA DIVISION.
000400 WORKING-STORAGE SECTION.
000410 77 mySqlConnection OBJECT REFERENCE SqlConnection.
000420 77 mySqlDataAdapter OBJECT REFERENCE SqlDataAdapter.
000430 77 mySqlCommand OBJECT REFERENCE SqlCommand.
000440 77 myDataSet1 OBJECT REFERENCE DataSet.
000450 77 myDataSet2 OBJECT REFERENCE DataSet.
000460 77 myDataTable OBJECT REFERENCE DataTable.
000470 77 myDataColumn OBJECT REFERENCE DataColumn.
000480 77 myPrimaryKeyColumn OBJECT REFERENCE DataColumn.
000490 77 myPrimaryKeyColumns OBJECT REFERENCE DataColumnArray.
000500 77 myENUM-XmlWriteMode OBJECT REFERENCE ENUM-XmlWriteMode.
000510
000520 77 mySys-String OBJECT REFERENCE Sys-String.
000530 77 mySys-Integer OBJECT REFERENCE Sys-Integer.
000540 77 mySys-Object OBJECT REFERENCE Sys-Object.
000550 77 myXmlFile OBJECT REFERENCE Sys-String.
000560 77 myDisplayString PIC x(38550).
000570 77 myInt PIC S9(9) COMP-5.
000580 77 myOtherInt PIC S9(9) COMP-5.
000590 01 NULL-X PIC X(1).
000600 PROCEDURE DIVISION.
000610
000620 Perform 0000-OptionalPreTableBuild.
000630 Perform 1000-UseSqlDataAdapter.
000640 Perform 2000-ReadWriteXML.
000650 DISPLAY " "
000660
000670 DISPLAY "Enter X and Press Enter to Exit.".
000680 ACCEPT NULL-X.
000690 Stop Run.
000700
000710************************************************
000720 0000-OptionalPreTableBuild.
000730* It is possible to obtain the "schema" or table structure
000740* directly/automatically from the SQL Server Database
000750* This section is added for training purposes.
000760* The information found in this section would be critical
000770* in the case of building a disconnected .NET dataset
000780* that may have a non-SQL Server Data Source.
000790
000800* Create a new DataTable.
000810 INVOKE DataTable "NEW" USING BY VALUE "myCustomers"
000820 RETURNING myDataTable.
000830
000840* Create 1st myDataColumn.
000850 INVOKE DataColumn "NEW" RETURNING myDataColumn.
000860 SET PROP-DataType OF myDataColumn TO
000870 SystemType::"GetType"("System.String").
000880 SET PROP-ColumnName OF myDataColumn TO "CustomerID".
000890 SET PROP-Unique OF myDataColumn TO B"1".
000900 INVOKE PROP-Columns OF myDataTable "Add"
000910 USING BY VALUE myDataColumn.
000920
000930* Create 2nd myDataColumn.
000940 INVOKE DataColumn "NEW" RETURNING myDataColumn.
000950 SET PROP-DataType OF myDataColumn TO
000960 SystemType::"GetType"("System.String").
000970 SET PROP-ColumnName OF myDataColumn TO "CompanyName".
000980 INVOKE PROP-Columns OF myDataTable "Add"
000990 USING BY VALUE myDataColumn.
001000
001010* Create 3rd myDataColumn.
001020 INVOKE DataColumn "NEW" RETURNING myDataColumn.
001030 SET PROP-DataType OF myDataColumn TO
001040 SystemType::"GetType"("System.String").
001050 SET PROP-ColumnName OF myDataColumn TO "ContactName".
001060 INVOKE PROP-Columns OF myDataTable "Add"
001070 USING BY VALUE myDataColumn.
001080
001090* Create 4th myDataColumn.
001100 INVOKE DataColumn "NEW" RETURNING myDataColumn.
001110 SET PROP-DataType OF myDataColumn TO
001120 SystemType::"GetType"("System.String").
001130 SET PROP-ColumnName OF myDataColumn TO "ContactTitle".
001140 INVOKE PROP-Columns OF myDataTable "Add"
001150 USING BY VALUE myDataColumn.
001160
001170* Create 5th myDataColumn.
001180 INVOKE DataColumn "NEW" RETURNING myDataColumn.
001190 SET PROP-DataType OF myDataColumn TO
001200 SystemType::"GetType"("System.String").
001210 SET PROP-ColumnName OF myDataColumn TO "Address".
001220 INVOKE PROP-Columns OF myDataTable "Add"
001230 USING BY VALUE myDataColumn.
001240
001250* Create 6th myDataColumn.
001260 INVOKE DataColumn "NEW" RETURNING myDataColumn.
001270 SET PROP-DataType OF myDataColumn TO
001280 SystemType::"GetType"("System.String").
001290 SET PROP-ColumnName OF myDataColumn TO "City".
001300 INVOKE PROP-Columns OF myDataTable "Add"
001310 USING BY VALUE myDataColumn.
001320
001330* Create 7th myDataColumn.
001340 INVOKE DataColumn "NEW" RETURNING myDataColumn.
001350 SET PROP-DataType OF myDataColumn TO
001360 SystemType::"GetType"("System.String").
001370 SET PROP-ColumnName OF myDataColumn TO "Region".
001380 INVOKE PROP-Columns OF myDataTable "Add"
001390 USING BY VALUE myDataColumn.
001400
001410* Create 8th myDataColumn.
001420 INVOKE DataColumn "NEW" RETURNING myDataColumn.
001430 SET PROP-DataType OF myDataColumn TO
001440 SystemType::"GetType"("System.String").
001450 SET PROP-ColumnName OF myDataColumn TO "PostalCode".
001460 INVOKE PROP-Columns OF myDataTable "Add"
001470 USING BY VALUE myDataColumn.
001480
001490* Create 9th myDataColumn.
001500 INVOKE DataColumn "NEW" RETURNING myDataColumn.
001510 SET PROP-DataType OF myDataColumn TO
001520 SystemType::"GetType"("System.String").
001530 SET PROP-ColumnName OF myDataColumn TO "Country".
001540 INVOKE PROP-Columns OF myDataTable "Add"
001550 USING BY VALUE myDataColumn.
001560
001570* Create 10th myDataColumn.
001580 INVOKE DataColumn "NEW" RETURNING myDataColumn.
001590 SET PROP-DataType OF myDataColumn TO
001600 SystemType::"GetType"("System.String").
001610 SET PROP-ColumnName OF myDataColumn TO "Phone".
001620 INVOKE PROP-Columns OF myDataTable "Add"
001630 USING BY VALUE myDataColumn.
001640
001650* Create 11th myDataColumn.
001660 INVOKE DataColumn "NEW" RETURNING myDataColumn.
001670 SET PROP-DataType OF myDataColumn TO
001680 SystemType::"GetType"("System.String").
001690 SET PROP-ColumnName OF myDataColumn TO "Fax".
001700 INVOKE PROP-Columns OF myDataTable "Add"
001710 USING BY VALUE myDataColumn.
001720
001730* Assign primary key column to "CustomerID" column.
001740 INVOKE DataColumnArray "NEW" USING BY VALUE 1
001750 RETURNING myPrimaryKeyColumns.
001760 INVOKE PROP-Columns OF myDataTable "get_Item"
001770 USING BY VALUE "CustomerID"
001780 RETURNING myPrimaryKeyColumn.
001790 INVOKE myPrimaryKeyColumns "Set"
001800 USING BY VALUE 0 myPrimaryKeyColumn.
001810 SET PROP-PrimaryKey OF myDataTable TO myPrimaryKeyColumns.
001820
001830* Reference the DataSet.
001840 INVOKE DataSet "NEW" RETURNING myDataSet1.
001850* Associate the Table with the Dataset.
001860 INVOKE PROP-Tables OF myDataSet1 "Add"
001870 USING BY VALUE myDataTable.
001880
001890************************************************
001900 1000-UseSqlDataAdapter.
001910
001920* Reference Data Provider Objects
001930 INVOKE SqlConnection "NEW" RETURNING mySqlConnection
001940 INVOKE SqlDataAdapter "NEW" RETURNING mySqlDataAdapter
001950 INVOKE SqlCommand "NEW" RETURNING mySqlCommand
001960
001970* Prepare to Connect to SQL Server Database
001980* using Connection String
001990 SET PROP-ConnectionString OF mySqlConnection TO
002000 "user id=sa;pwd=;Database=northwind;Server=(LOCAL)"
002010
002020* Associate the Command Object with the Connection Object
002030 SET PROP-Connection OF mySqlCommand TO mySqlConnection
002040* Associate the Command Object with intended SQL Statement
002050 SET PROP-CommandText OF mySqlCommand TO "Select * from
Customers"
002060* Associate the DataAdapter Object with the Command Object
002070 SET PROP-SelectCommand OF mySqlDataAdapter TO mySqlCommand
002080
002090* Have the DataAdapter Object Execute the SQL Statement and
002100* store the result set in a DataSet DataTable named myCustomers
002110 INVOKE mySqlDataAdapter "Fill"
002120 USING BY VALUE myDataSet1, "myCustomers"
002130
002140* Close the Database Connection
002150 INVOKE mySqlConnection "Close".
002160
002170 SET mySqlConnection TO NULL.
002180 SET mySqlDataAdapter TO NULL.
002190 SET mySqlCommand TO NULL.
002200 SET myDataTable TO NULL.
002210
002220************************************************
002230 2000-ReadWriteXML.
002240
002250* The following XML file will be saved on your harddisk.
002260* You can locate it in the local application BIN folder
002270 SET myXmlFile TO "myCustomers.xml"
002280
002290* Demonstrate the usage of the WriteXml method
002300* Write out an XML file that originated as relational data
002310 SET myENUM-XmlWriteMode
002320 TO PROP-IgnoreSchema OF ENUM-XmlWriteMode
002330 INVOKE myDataSet1 "WriteXml" USING BY VALUE
002340 myXmlFile, myENUM-XmlWriteMode
002350
002360* Demonstrate the usage of the ReadXml method
002370* Load a 2nd Dataset from the saved XML file
002380 INVOKE DataSet "NEW" RETURNING myDataSet2
002390 INVOKE myDataSet2 "ReadXml" USING BY VALUE myXmlFile
002400
002410* Demonstrate the usage of the GETXML method
002420* Extract data from the Dataset in XML format
002430 INVOKE myDataSet2 "GetXml" RETURNING mySys-String
002440 SET myDisplayString TO mySys-String
002450 DISPLAY myDisplayString.
002460
002470 END PROGRAM MAIN.


Note: The code sample above was borrowed from my book ("COBOL and
Visual
Basic on .NET: A Guide for the Reformed Mainframe Programmer".
Chapter 12). By the way, this same source code is downloadable from
the Apress site
(http://www.apress.com/book/supplementDownload.html?bID=112&sID=956).


- regards.